用 GDI 操作 EMF 文件[5]: GetEnhMetaFileDescription - 获取 EMF 文件的说明文本

再用 CreateEnhMetaFile 函数建立 EMF 文件时可以同时写入描述性说明;

用 GetEnhMetaFileDescription 函数可以读出 EMF 文件的说明文本.

本例给的说明文本非常简单, 不过标准的说明文本的格式应该是: 程序名#0文件标题#0#0

---

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  HMetaFile: HENHMETAFILE; {EMF 文件句柄}

{建立带说明的 EMF 文件}
procedure TForm1.FormCreate(Sender: TObject);
const
  Path = 'C:\Temp\MyMeateFile.emf';
  Description = 'ABCDE'; {当作 EMF 文件的说明}
var
  MetaFileDC: HDC;
begin
  {建立并写入说明}
  MetaFileDC := CreateEnhMetaFile(0, PChar(Path), nil, PChar(Description));
  {绘图}
  Rectangle(MetaFileDC, 11, 11, 111, 111);
  {结束编辑、保存文件, 并返回文件句柄}
  HMetaFile := CloseEnhMetaFile(MetaFileDC);
  {删除 DC}
  DeleteObject(MetaFileDC);
end;

{读取 EMF 文件的说明}
procedure TForm1.Button1Click(Sender: TObject);
var
  DescriptionSize: Integer; {说明段的大小}
  DescriptionBuf: PChar;    {接受说明的内存指针}
begin
  {获取大小}
  DescriptionSize := GetEnhMetaFileDescription(HMetaFile, 0, nil);
  {分配内存}
  GetMem(DescriptionBuf, DescriptionSize);
  {获取说明}
  GetEnhMetaFileDescription(HMetaFile, DescriptionSize, DescriptionBuf);
  {显示说明}
  ShowMessage(DescriptionBuf); {ABCDE}
  {释放内存}
  FreeMem(DescriptionBuf);
end;

{绘制在窗体}
procedure TForm1.Button2Click(Sender: TObject);
begin
  PlayEnhMetaFile(Canvas.Handle, HMetaFile, Rect(11,11,111,111));
end;

{删除 EMF 文件句柄}
procedure TForm1.FormDestroy(Sender: TObject);
begin
  DeleteEnhMetaFile(HMetaFile);
end;

end.