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

Мне необходимо нарисовать 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.
 
 

https://delphiworld.narod.ru/

DelphiWorld 6.0