Source file: /~heha/hs/wmfsave.zip/WIN31/WMFSAVE.PAS

program wmfsave;
{Wie kriege ich "MrEd" und "Microsoft Draw" heraus!?}
{$R wmfsave}
uses WinProcs,WinTypes,Win31,CommDlg,WUtils,Parser;

function EnumProc(dc:HDC; var ht:THandleTable; var mr:TMetaRecord;
  cObj:Integer; lParam:LongInt):Integer; export;
 begin
{  vMBox(0,2,MB_OK,mr^);}
  if mr.rdFunction<>meta_Escape
  then PlayMetaFileRecord(dc,ht,mr,cObj);
  EnumProc:=1;
 end;

type
 TPMF=record	{Placeable Metafile Header, 22 Bytes}
  key: LongInt;
  hmf: THandle;
  bbox: TRect;
  inch: Word;
  reserved: LongInt;
  checksum: Word;
 end;
var
 ofn:TOpenFileName;
 fname: TS255;
 h: THandle;
 clip: THandle;
 mfp: PMetaFilePict;
 hf: HFile;
 pmf: TPMF;
 xorwords: array[0..9] of Word absolute pmf;
 i: Integer;
 dc: HDC;
 s: TS255;
begin
 InitStruct(ofn,sizeof(ofn));
 lstrcpy(fname,CmdLine);
 ofn.lpstrFilter:='Metadateien'#0'*.wmf'#0;
 ofn.lpstrFile:=fname;
 ofn.nMaxFile:=sizeof(fname);
 ofn.Flags:=OFN_PathMustExist or OFN_OverwritePrompt
   or OFN_HideReadOnly or OFN_LongNames;
 while GetSaveFileName(ofn) do begin
  lstrcpy(fname,GetFileNamePtr(fname));	{Verzeichnis macht GetSaveFileName}
  OpenClipboard(0);
  clip:=GetClipboardData(CF_MetafilePict);
  pmf.key:=$9AC6CDD7;
  dc:=CreateIC('DISPLAY',nil,nil,nil);
  pmf.inch:=GetDeviceCaps(dc,LOGPIXELSX);
  DeleteDC(dc);
  if clip<>0 then begin
   mfp:=GlobalLock(clip);
   vMBox(0,1,MB_OK,mfp^);
   dc:=CreateMetaFile(nil);
   EnumMetaFile(dc,mfp^.hMF,@EnumProc,nil);
   h:=GetMetaFileBits(CloseMetaFile(dc));
   pmf.bbox.right:=mfp^.xExt;
   pmf.bbox.bottom:=mfp^.yExt;
   case mfp^.mm of
    MM_LoMetric:  pmf.inch:=254;	{10 Punkte pro mm = 254 pro Zoll}
    MM_HiMetric:  pmf.inch:=2540;	{100 Punkte pro mm = 2540 pro Zoll}
    MM_LoEnglish: pmf.inch:=100;	{100 Punkte pro Zoll}
    MM_HiEnglish: pmf.inch:=1000;	{1000 Punkte pro Zoll}
    MM_Twips:     pmf.inch:=1440;	{1/20 von 1/72 Zoll = 1440 pro Zoll}
    MM_AnIsotropic,			{WinWord...???}
    MM_Isotropic: pmf.inch:=MulDiv(pmf.inch,254,10);
   end;
   pmf.checksum:=0;
   for i:=0 to HIGH(xorwords)
   do pmf.checksum:=pmf.checksum xor xorwords[i];
   GlobalUnlock(clip);
   hf:=_lcreat(fname,0);
   _lwrite(hf,PChar(@pmf),sizeof(pmf));
   _hwrite(hf,GlobalLock(h),GlobalSize(h));
   _lclose(hf);
   GlobalUnlock(h);
   GlobalFree(h);
   if MessageBox(0,'Gespeichert.'#10'Wiederholung?','OK',
     MB_IconQuestion or MB_YesNo)<>IDYes then exit;
  end else begin
   MessageBox(0,'Keine Metadatei in der Zwischenablage!',nil,0)
  end;
  CloseClipboard;
 end;
end.
Detected encoding: ASCII (7 bit)2