Delphi图片上写水印文字函数

本文整理自网络，侵删。

 unit untImagePaintText; interfaceuses 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. //首引用单元untImagePaintText//调用//procedure TForm1.btn1Click(Sender: TObject);//var//    sl: TStringList;//begin//    if dlgOpen1.Execute then//    begin//        img1.Picture.LoadFromFile(dlgOpen1.FileName);//        sl := TStringList.Create;//        sl.Add('你好，彭XX');//        sl.Add('你好，习XX');//        if ImagePaintText(dlgOpen1.FileName, 20, 30, sl) then//        img1.Picture.LoadFromFile(dlgOpen1.FileName);//    end;//end;
――――――――――――――――
原文链接：https://blog.csdn.net/lqena/article/details/22858847 

相关阅读 >>

Delphi 全局键盘钩子(wh_keyboard)

Delphi通过窗口标题结束指定进程函数

winapi 字符及字符串函数(2): charlowerbuff - 把缓冲区中指定数目的字符转小写

Delphi tapplication.onexception

Delphi 字符串保存为 txt文件

Delphi 字符串处理单元

Delphi webbrowser 滚动条的去除、边框去除

Delphi 数字分隔

Delphi汉字的拼音简码

Delphi类型转换函数

更多相关阅读请进入《Delphi》频道 >>