随笔 - 2146  文章 - 19 评论 - 11846 阅读 - 1267万

//增强图元文件的头文件结构 TEnhMetaHeader:
tagENHMETAHEADER = packed record
  iType: DWORD;          {记录类型}
  nSize: DWORD;          {结构大小}
  rclBounds: TRect;      {外接矩形(单位是像素)}
  rclFrame: TRect;       {图片矩形(单位是 0.1 毫米)}
  dSignature: DWORD;     {文件签名}
  nVersion: DWORD;       {文件版本}
  nBytes: DWORD;         {文件尺寸}
  nRecords: DWORD;       {记录数}
  nHandles: Word;        {句柄数}
  sReserved: Word;       {保留}
  nDescription: DWORD;   {说明文本的长度}
  offDescription: DWORD; {说明文本的偏移量}
  nPalEntries: DWORD;    {调色板的元素数}
  szlDevice: TSize;      {分辨率(像素)}
  szlMillimeters: TSize; {分辨率(毫米)}
  cbPixelFormat: DWORD;  {}
  offPixelFormat: DWORD; {}
  bOpenGL: DWORD;        {}
end;

本例效果图:


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);
const
  n = #13#10;
var
  MetaHeaderSize: Integer;    {文件头大小}
  MetaHeader: PEnhMetaHeader; {文件头结构的指针}
  str: string;
  buf: array[Word] of Char;
begin
  MetaHeaderSize := GetEnhMetaFileHeader(HMetaFile, 0, nil);
  GetMem(MetaHeader, MetaHeaderSize);
  GetEnhMetaFileHeader(HMetaFile, MetaHeaderSize, MetaHeader);

  str := 'iType:          %d' + n +
         'nSize:          %d' + n +
         'rclBounds:      %d,%d,%d,%d' + n +
         'rclFrame:       %d,%d,%d,%d' + n +
         'dSignature:     %d' + n +
         'nVersion:       %d' + n +
         'nBytes:         %d' + n +
         'nRecords:       %d' + n +
         'nHandles:       %d' + n +
         //'sReserved:      %d' + n +
         'nDescription:   %d' + n +
         'offDescription: %d' + n +
         'nPalEntries:    %d' + n +
         'szlDevice:      %d,%d' + n +
         'szlMillimeters: %d,%d' + n +
         'cbPixelFormat:  %d' + n +
         'offPixelFormat: %d' + n +
         'bOpenGL:        %d';

  wvsprintf(buf, PChar(str), PChar(MetaHeader));
  ShowMessage(buf);
  FreeMem(MetaHeader);
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.

posted on   万一  阅读(3895)  评论(0编辑  收藏  举报
编辑推荐:
· 开发者必知的日志记录最佳实践
· SQL Server 2025 AI相关能力初探
· Linux系列:如何用 C#调用 C方法造成内存泄露
· AI与.NET技术实操系列(二):开始使用ML.NET
· 记一次.NET内存居高不下排查解决与启示
阅读排行:
· 阿里最新开源QwQ-32B,效果媲美deepseek-r1满血版,部署成本又又又降低了!
· 开源Multi-agent AI智能体框架aevatar.ai,欢迎大家贡献代码
· Manus重磅发布:全球首款通用AI代理技术深度解析与实战指南
· 被坑几百块钱后,我竟然真的恢复了删除的微信聊天记录!
· 没有Manus邀请码?试试免邀请码的MGX或者开源的OpenManus吧


点击右上角即可分享
微信分享提示