Delphi图片上写水印文字函数
https://blog.csdn.net/lqena/article/details/22858847
unit Unit1; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls; type TForm1 = class(TForm) Button1: TButton; OpenDialog1: TOpenDialog; Image1: TImage; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation uses untImagePaintText; {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var sl: TStringList; begin if OpenDialog1.Execute then begin Image1.Picture.LoadFromFile(OpenDialog1.FileName); sl := TStringList.Create; sl.Add(‘你好,彭XX‘); sl.Add(‘你好,习XX‘); if ImagePaintText(OpenDialog1.FileName, 20, 30, sl) then Image1.Picture.LoadFromFile(OpenDialog1.FileName); end; end; end.
unit untImagePaintText; interface uses jpeg, Classes, Graphics, SysUtils; /// <summary> /// 打开一幅图片(jpg,bmp)在上写入文字 /// </summary> /// <param name="FilePath">图片路径</param> /// <param name="X">文字左边距</param> /// <param name="Y">文字上边距</param> /// <param name="Texts">写入文字内容</param> /// <returns>写入是否成功</returns> function ImagePaintText(FilePath: string; X, Y: Integer; Texts: TStringList): Boolean; implementation function JpgToBmp(FilePath: string): string; var MyJPEG: TJPEGImage; MyBMP: TBitmap; s: string; begin Result := ‘‘; s := copy(FilePath, 1, Length(FilePath) - 4) + FormatDateTime(‘YYYYMMDDhhmmsszzz‘, Now) + ‘.bmp‘; MyJPEG := TJPEGImage.Create; with MyJPEG do begin LoadFromFile(FilePath); MyBMP := TBitmap.Create; with MyBMP do begin Width := MyJPEG.Width; Height := MyJPEG.Height; Canvas.Draw(0, 0, MyJPEG); SaveToFile(s); Result := s; Free; end; Free; end; end; function BmpToJpg(FilePath, FilePathJpg: string): string; var Jpg: TJpegImage; BMP: TBitMap; s: string; begin Jpg := TJpegImage.Create; BMP := TBitmap.Create; BMP.LoadFromFile(FilePath); Jpg.Assign(BMP); Jpg.SaveToFile(FilePathJpg); BMP.Free; Jpg.Free; end; function ImagePaintText(FilePath: string; X, Y: Integer; Texts: TStringList): Boolean; var Pic: TPicture; fp: string; i: Integer; begin Result := false; if UpperCase(ExtractFileExt(FilePath)) = UpperCase(‘.jpg‘) then fp := JpgToBmp(FilePath) else fp := FilePath; Pic := TPicture.Create; try Pic.LoadFromFile(fp); with Pic.Bitmap.Canvas do begin Brush.Style := bsClear; Font.Size := 15; Font.Color := clWhite; Font.Name := ‘黑体‘; for i := 0 to Texts.Count - 1 do TextOut(X, Y + (i * 22), Texts[i]) end; if UpperCase(ExtractFileExt(FilePath)) = UpperCase(‘.jpg‘) then begin Pic.SaveToFile(fp); BmpToJpg(fp, FilePath); DeleteFile(fp); end else Pic.SaveToFile(FilePath); finally FreeAndNil(Pic); end; Result := True; end; end.