用 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