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(0); MFCanvas:=TMetafileCanvas.Create(MetaFile, LDC); MFCanvas.Pen.Color := clRed; MFCanvas.Pen.Width := 5; MFCanvas.Brush.Color :=clBlue; MFCanvas.MoveTo(0,0); MFCanvas.Rectangle(0,0,Self.PaintBox1.Width,Self.PaintBox1.Height); MFCanvas.LineTo(Self.PaintBox1.Width,Self.PaintBox1.Height); finally MFCanvas.Free; ReleaseDC(0,LDC); end; Self.PaintBox1.Canvas.Draw(0,0,MetaFile); MetaFile.SaveToFile('c:\未命名2.EMF'); finally MetaFile.Free; end; end; end.
本程序在Delphi 2010上测试过,没有问题。