如何在Delphi中嵌入未安装的TTF字体并在Canvas上绘制文本

完全可以实现，无需用户安装字体，通过将TTF文件作为资源嵌入Delphi项目，利用Delphi封装的私有字体集合类即可在Canvas上直接绘制文本。以下是可直接运行的完整示例：

实现步骤 #

1. 添加字体资源到项目

   • 将你的TTF字体文件（如CustomFont.ttf）放到项目目录下
   • 新建一个.rc资源脚本文件，写入以下内容：

     MYFONT RCDATA "CustomFont.ttf"
     

   • 通过Delphi菜单栏的Project > Add to Project，将这个.rc文件加入项目

2. 完整代码实现
   替换原Form单元代码为以下内容：

   unit Unit1;
   
   interface
   
   uses
     Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
     Vcl.Controls, Vcl.Forms, Vcl.Dialogs;
   
   type
     TForm1 = class(TForm)
       procedure FormPaint(Sender: TObject);
       procedure FormCreate(Sender: TObject);
       procedure FormDestroy(Sender: TObject);
     private
       FPrivateFonts: TPrivateFontCollection;
       FLoadedFontName: string;
     public
     end;
   
   var
     Form1: TForm1;
   
   implementation
   
   {$R *.dfm}
   {$R fontres.rc} // 替换为你的资源脚本文件名
   
   procedure TForm1.FormCreate(Sender: TObject);
   var
     ResStream: TResourceStream;
     FontData: array of Byte;
   begin
     FPrivateFonts := TPrivateFontCollection.Create;
     // 从资源中读取TTF二进制数据
     ResStream := TResourceStream.Create(HInstance, 'MYFONT', RT_RCDATA);
     try
       SetLength(FontData, ResStream.Size);
       ResStream.ReadBuffer(FontData[0], ResStream.Size);
       // 将内存中的字体数据加入私有集合
       FPrivateFonts.AddMemoryFont(@FontData[0], Length(FontData));
     finally
       ResStream.Free;
     end;
     // 获取加载后的字体真实名称（可能与文件名不同）
     if FPrivateFonts.Fonts.Count > 0 then
       FLoadedFontName := FPrivateFonts.Fonts[0].Name;
   end;
   
   procedure TForm1.FormDestroy(Sender: TObject);
   begin
     FPrivateFonts.Free;
   end;
   
   procedure TForm1.FormPaint(Sender: TObject);
   begin
     Canvas.MoveTo(20, 100);
     // 使用加载的私有字体绘制文本
     if FLoadedFontName <> '' then
     begin
       Canvas.Font.Name := FLoadedFontName;
       Canvas.Font.Color := clMaroon;
       Canvas.Font.Style := [];
       Canvas.Font.Height := 64;
       Canvas.TextOut(Canvas.PenPos.X, Canvas.PenPos.Y, '测试文本');
     end
     else
     begin
       Canvas.Font.Name := 'Arial';
       Canvas.TextOut(20, 100, '字体加载失败');
     end;
   end;
   
   end.
   

关键说明 #

• TPrivateFontCollection：Delphi封装的Windows私有字体集合类，加载的字体仅当前程序可用，不会写入系统注册表
• 资源读取：通过TResourceStream直接从项目资源中提取字体数据，无需依赖外部文件
• 字体名称注意：加载后需通过Fonts[0].Name获取字体的真实名称，不要直接使用TTF文件名（两者可能不一致）

额外注意 #

• 如果字体包含多字重（如粗体、斜体），需要在资源脚本中添加对应TTF文件的条目，分别加载到私有集合
• 字体资源仅在程序运行期间有效，退出后自动释放，不会残留系统影响

内容的提问来源于stack exchange，提问作者gene b.