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
 { Create a metafile DC in memory }
 MetafileDC := CreateMetaFile(nil);
 if Bool(MetafileDC) then
 begin
  { Map the top,left corner of the displayed rectangle to the top,left of the
  device context. Leave a border of 10 logical units around the picture. }
  with FRect do
  SetWindowOrg(MetafileDC, Left - 10,  - 10);
  { Set the extent of the picture with a border of 10 logical units.}
  with FRect do
  SetWindowExt(MetafileDC, Right - Left + 20, Bottom -  + 20);
  { Play any valid metafile contents to it. }
  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;
 { Prepair metafile for clipboard display. }
 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. - ExtRect.Bottom;
 MetafilePict^.HMF := FMetafileHandle;
 GlobalUnlock(FClipboardHandle);
 { I'm giving you this handle, but please do NOT eat it. }
 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.