unit Unit1; interface uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls; type
TForm1 = class(TForm)
PaintBox1: TPaintBox;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end; var
Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject);
var
MetaFile : TMetaFile;
MFCanvas : TMetaFileCanvas;
BMP : TBitmap;
LDC : HDC;
begin
try
MetaFile := TMetaFile.Create;
MetaFile.Height := Self.PaintBox1.Height;
MetaFile.Width := Self.PaintBox1.Width;
try
LDC := GetDC();
MFCanvas:=TMetafileCanvas.Create(MetaFile, LDC);
MFCanvas.Pen.Color := clRed;
MFCanvas.Pen.Width := ;
MFCanvas.Brush.Color :=clBlue;
MFCanvas.MoveTo(,);
MFCanvas.Rectangle(,,Self.PaintBox1.Width,Self.PaintBox1.Height);
MFCanvas.LineTo(Self.PaintBox1.Width,Self.PaintBox1.Height);
finally
MFCanvas.Free;
ReleaseDC(,LDC);
end;
Self.PaintBox1.Canvas.Draw(,,MetaFile);
MetaFile.SaveToFile('c:\未命名2.EMF');
finally
MetaFile.Free;
end;
end;
end.
本程序在Delphi 2010上测试过,没有问题。