WMF Display

You will need a form with a button, an open dialog and a filelist box (which can be invisible)


unit w2eU1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
OpenDialog1: TOpenDialog;
FileListBox1: TFileListBox;
procedure Button1Click(Sender: TObject);


private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

{$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;






procedure TForm1.Button1Click(Sender: TObject);
var
ahdr : apmfileheader;
sta : tmemorystream;
mhdr : metaheader;
mfpic : metafilepict;
llen : longint;
mfh, mdatah, hemf : thandle;
lpmdata : pointer;
drect : trect;
resb : boolean;
i, x, y, x1, y1, wwidth : integer;
sa, spath : string;
emhd : tenhmetaheader;
t, l, b, r , ret : longint;

begin
opendialog1.Filter := 'WMF files ( *.wmf)|*.wmf';
opendialog1.InitialDir := 'MyPath';
resb := opendialog1.execute;
if resb = false then exit;

sa := opendialog1.FileName;
//reduce this to just the path
spath := extractfilepath(sa);

//update the filelistbox
filelistbox1.Directory := spath;
filelistbox1.mask := '*.wmf';
filelistbox1.update;

//wwidth is the size of the square where the metafile is to be displayed
wwidth := 200; //pixels

//set the form into text (pixel) mode
setmapmode(form1.canvas.handle,MM_text);

//process all the files in the list box one by one
for i := 0 to filelistbox1.items.count -1 do
begin
//clear the display area
    form1.canvas.Rectangle(0,0,wwidth,wwidth);

//get the metafile to be displayed
    sa := form1.FileListBox1.Items.Strings[i];

//create stream and load with metafile
    sta := tmemorystream.create;
    sta.LoadFromFile(sa);
    sta.position := 0;

//read the Aldus header
    sta.read(ahdr, sizeof(ahdr));
//read the metaheader
    sta.read(mhdr, sizeof(mhdr));
//move past the Aldus header to start of metaheader
    sta.position := sizeof(ahdr);

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

//read the metafile into memory
    sta.read(lpmdata^,llen);
//stream finished with now
    sta.free;
//make a w31 metafile
    mfh := setmetafilebitsex(llen,lpmdata);

//get the sizes from the Aldus header
    x := 2540 * (ahdr.bbox.right-ahdr.bbox.left) div ahdr.inch;
    y := 2540 * (ahdr.bbox.bottom-ahdr.bbox.top) div ahdr.inch;

//scale sizes depending on aspect ratio to fit display area
    if x >= y then
    begin
        x1 := wwidth;
        y1 := (wwidth * y) div x;
    end 
    else
    begin
        x1 := (wwidth * x) div y;
        y1 := wwidth;
    end; //if x>y

//set up the metafilepict, x1 and y1 are not the obvious values, x and y are
    mfpic.mm := mm_text;
    mfpic.xext := x1;
    mfpic.yext := y1;
    mfpic.hmf := mfh;

//create enhanced metafile
    hemf := setwinmetafilebits(llen,lpmdata,0,mfpic);

//free stuff
    globalunlock(mdatah);
    globalfree(mdatah);

//get some picture dimensions
    ret := getenhmetafileheader(hemf,sizeof(emhd),@emhd);

    t := emhd.rclframe.top;
    b := emhd.rclframe.bottom;
    l := emhd.rclbounds.left;
    r := emhd.rclbounds.right;

//sort out the picture orientation otherwise
// maybe some will be upside down and some mirrored
    if abs(t) < abs(b) then
    begin
        drect.top := 0;
        drect.bottom := y1;
    end
    else
    begin
        drect.top := y1; 
        drect.bottom := 0;
    end; //if abs(t)

    if abs(l) < abs(r) then
    begin
        drect.left := 0;
        drect.right := x1;
    end
    else
    begin
        drect.left := x1;
        drect.right := 0;
    end; //if abs(l)

//display the metafile
    resb := playenhmetafile(form1.canvas.handle,hemf,drect);

//free stuff
    deletemetafile(mfh);
    deleteenhmetafile(hemf);

end; //for i


end; //button1


end.

Go back to main page

last updated 18/06/2008