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

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

[000112]

Содержание раздела