Канва для метафайлов

Мне необходимо нарисовать Windows-метафайл. Delphi непосредственно это не поддерживает, поэтому для создания нового метафайла я использую функции Windows API. При создании метафайла мне возвращается его THandle, являющийся дескриптором контекста устройства Windows (DC).
Как мне в Delphi использовать возвращаемый THandle для получения или создания канвы (Canvas) для рисования?
unit Metaform;
interface
uses
 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
 Forms, Dialogs, StdCtrls, Buttons, ExtCtrls;
type
 TForm1 = class(TForm)
 Panel1: TPanel;
 BitBtn1: TBitBtn;
 Image1: TImage;
 procedure BitBtn1Click(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
type
 TMetafileCanvas = class(TCanvas)
 private
 FClipboardHandle: THandle;
 FMetafileHandle: HMetafile;
 FRect: TRect;
 protected
 procedure CreateHandle; override;
 function GetMetafileHandle: HMetafile;
 public
 constructor Create;
 destructor Destroy; override;
 property Rect: TRect read FRect write FRect;
 property MetafileHandle: HMetafile read GetMetafileHandle;
 end;
constructor TMetafileCanvas.Create;
begin
 inherited Create;
 FClipboardHandle := GlobalAlloc(
 GMEM_SHARE or GMEM_ZEROINIT, SizeOf(TMetafilePict));
end;
destructor TMetafileCanvas.Destroy;
begin
 DeleteMetafile(CloseMetafile(Handle));
 if Bool(FClipboardHandle) then
 GlobalFree(FClipboardHandle);
 if Bool(FMetafileHandle) then
 DeleteMetafile(FMetafileHandle);
 inherited Destroy;
end;
procedure TMetafileCanvas.CreateHandle;
var
 MetafileDC: HDC;
begin
 { Создаем в памяти DC метафайла }
 MetafileDC := CreateMetaFile(nil);
 if Bool(MetafileDC) then
 begin
 { Совмещаем верхний левый угол отображаемого прямоугольника с левым верхним углом
 контекста устройства. Создаем границу шириной 10 логических единиц вокруг изображения. }
 with FRect do
 SetWindowOrg(MetafileDC, Left - 10, Top - 10);
 { Устанавливаем размер изображения с бордюром, имеющим ширину 10 логических единиц. }
 with FRect do
 SetWindowExt(MetafileDC, Right - Left + 20, Bottom - Top + 20);
 { Задаем корректное содержание данному метафайлу. }
 if Bool(FMetafileHandle) then
 begin
 PlayMetafile(MetafileDC, FMetafileHandle);
 end;
 end;
 Handle := MetafileDC;
end;
function TMetafileCanvas.GetMetafileHandle: HMetafile;
var
 MetafilePict: PMetafilePict;
 IC: HDC;
 ExtRect: TRect;
begin
 if Bool(FMetafileHandle) then
 DeleteMetafile(FMetafileHandle);
 FMetafileHandle := CloseMetafile(Handle);
 Handle := 0;
 { Подготавливаем метафайл для показа в буфере обмена. }
 MetafilePict := GlobalLock(FClipboardHandle);
 MetafilePict^.mm := mm_AnIsoTropic;
 IC := CreateIC('DISPLAY', nil, nil, nil);
 SetMapMode(IC, mm_HiMetric);
 ExtRect := FRect;
 DPtoLP(IC, ExtRect, 2);
 DeleteDC(IC);
 MetafilePict^.xExt := ExtRect.Right - ExtRect.Left;
 MetafilePict^.yExt := ExtRect.Top - ExtRect.Bottom;
 MetafilePict^.HMF := FMetafileHandle;
 GlobalUnlock(FClipboardHandle);
 { Передаем дескриптор в качестве результата выполнения функции. }
 Result := FClipboardHandle;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var
 MetafileCanvas: TMetafileCanvas;
begin
 MetafileCanvas := TMetafileCanvas.Create;
 MetafileCanvas.Rect := Rect(0, 0, 500, 500);
 MetafileCanvas.Ellipse(10, 10, 400, 400);
 Image1.Picture.Metafile.LoadFromClipboardFormat(
 cf_MetafilePict, MetafileCanvas.MetafileHandle, 0);
 MetafileCanvas.Free;
end;
end.
Source: http://delphiworld.narod.ru/
ID: 03816
Category:Графика