Copy WMF to clipboard

You will need a form with two buttons, two images and a suitable metafile. Set the images' autosize to true.



unit wmfcopyU1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Image1: TImage;
Image2: TImage;
procedure FormActivate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

uses clipbrd;



{$A-} {This is essential to get the correct sizes for the different integers}



type

arect = record
left : smallint;
top : smallint;
right : smallint;
bottom : smallint;
end;

apmfileheader = record
key : longint;
hmf : smallint;
bbox : arect;
inch : smallint;
reserved : longint;
checksum : smallint;
end;

metaheader = record
mttype : smallint;
mtheadersize : smallint;
mtversion : smallint;
mtsize : longint;
mtnoobjects : smallint;
mtmaxrecord : longint;
mtnoparameters : smallint
end;

metafilepict = record
mm : longint;
xext : longint;
yext : longint;
hmf : longint;
end;




procedure TForm1.FormActivate(Sender: TObject);
begin
image1.picture.metafile.LoadFromFile('MyFile.wmf');
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
clipboard.assign(image1.picture);
image2.picture.assign(clipboard);
end;


procedure TForm1.Button2Click(Sender: TObject);
var
sta : tmemorystream;
ahdr : apmfileheader;
mhdr : metaheader;
mdatah, mfh, cpyh : thandle;
lpmdata, lpcpy : pointer;
llen : longint;
mfpic : metafilepict;

begin

//create stream and load with metafile
sta := tmemorystream.create;
image1.picture.metafile.savetostream(sta);

sta.position := 0;
//read the apm header
sta.read(ahdr, sizeof(ahdr));
//read the metafile header
sta.read(mhdr, sizeof(mhdr));

//get length of metafile and allocate memory for it
llen := mhdr.mtsize * 2;
mdatah := globalalloc(GMEM_SHARE,llen);
lpmdata := globallock(mdatah);

//go back to start of metafile header
sta.position := sizeof(ahdr);
//read the metafile into memory
sta.read(lpmdata^,llen);
//free the stream
sta.free;



//put data into metafile bits
mfh := setmetafilebitsex(llen,lpmdata);
//update some metafile data
mfpic.mm := mm_anisotropic;
mfpic.xext := 2540 * (ahdr.bbox.right-ahdr.bbox.left) div ahdr.inch;
mfpic.yext := 2540 * (ahdr.bbox.bottom-ahdr.bbox.top) div ahdr.inch;
mfpic.hmf := mfh;



// need to copy data for copying to clipboard
cpyh := globalalloc(GMEM_SHARE,sizeof(mfpic));
lpcpy := globallock(cpyh);
move(mfpic,lpcpy^,sizeof(mfpic));



//copy to clipboard
clipboard.open;
clipboard.clear;
setclipboarddata(cf_metafilepict,cpyh);
clipboard.close;

image2.picture.assign(clipboard);

globalunlock(mdatah);
globalfree(mdatah);
globalunlock(cpyh);
globalfree(cpyh);


end;

end.

Go back to main page

last updated 18/06/2008