用 GDI 操作 EMF 文件[8]: 绘制图元文件时改变画笔与画刷

unit Unit1;

interface

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

type
TForm1 = class(TForm)
ColorBox1: TColorBox;
ColorBox2: TColorBox;
ComboBox1: TComboBox;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure ColorBox1Change(Sender: TObject);
procedure ColorBox2Change(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

var
HMetaFile: HENHMETAFILE; {EMF 文件句柄}
p: TPen;
b: TBrush;

//EnumEnhMetaFile 的回调函数
function MyEnhMetaFunc(DisplaySurface: HDC; var MetafileTable: THandleTable;
var MetafileRecord: TEnhMetaRecord; ObjectCount: Integer; var Data: Longint
): Integer; stdcall;
begin
case MetafileRecord.iType of
EMR_CREATEPEN: SelectObject(DisplaySurface, p.Handle);
EMR_CREATEBRUSHINDIRECT: SelectObject(DisplaySurface, b.Handle);
else
PlayEnhMetaFileRecord(DisplaySurface, MetafileTable, MetafileRecord, ObjectCount);
Result := 1;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
MetaFileDC: HDC;
begin
{文件建立在内存}
MetaFileDC := CreateEnhMetaFile(0, nil, nil, nil);
p := TPen.Create;
b := TBrush.Create;
p.Color := clRed;
b.Style := bsCross;
b.Color := clSilver;

SelectObject(MetaFileDC, p.Handle);
SelectObject(MetaFileDC, b.Handle);

MoveToEx(MetaFileDC, 0, 0, nil);
LineTo(MetaFileDC, 80, 80);
{矩形}
Rectangle(MetaFileDC, 10, 10, 30, 50);
{椭圆}
Ellipse(MetaFileDC, 30, 30, 50, 70);

HMetaFile := CloseEnhMetaFile(MetaFileDC);

DeleteObject(MetaFileDC);

ComboBox1.Items.CommaText :=
'bsSolid,bsClear,bsHorizontal,bsVertical,bsFDiagonal,bsBDiagonal,bsCross,bsDiagCross';
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
EnumEnhMetaFile(Canvas.Handle, HMetaFile, @MyEnhMetaFunc, nil, ClientRect);
end;

procedure TForm1.ColorBox1Change(Sender: TObject);
begin
p.Color := ColorBox1.Selected;
Repaint;
end;

procedure TForm1.ColorBox2Change(Sender: TObject);
begin
b.Color := ColorBox2.Selected;
Repaint;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
b.Color := ColorBox2.Selected;
case ComboBox1.ItemIndex of
0: b.Style := bsSolid;
1: b.Style := bsClear;
2: b.Style := bsHorizontal;
3: b.Style := bsVertical;
4: b.Style := bsFDiagonal;
5: b.Style := bsBDiagonal;
6: b.Style := bsCross;
7: b.Style := bsDiagCross;
end;
Repaint;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
p.Free;
b.Free;
DeleteEnhMetaFile(HMetaFile);
end;

end.

object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 197
ClientWidth = 324
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poDesktopCenter
OnCreate = FormCreate
OnDestroy = FormDestroy
OnPaint = FormPaint
PixelsPerInch = 96
TextHeight = 13
object ColorBox1: TColorBox
Left = 200
Top = 16
Width = 116
Height = 22
ItemHeight = 16
TabOrder = 0
OnChange = ColorBox1Change
end
object ColorBox2: TColorBox
Left = 200
Top = 44
Width = 116
Height = 22
ItemHeight = 16
TabOrder = 1
OnChange = ColorBox2Change
end
object ComboBox1: TComboBox
Left = 200
Top = 72
Width = 116
Height = 21
ItemHeight = 13
TabOrder = 2
Text = 'ComboBox1'
OnChange = ComboBox1Change
end
end