procedure ToMF(grfk: TGraphic; mf: string); 
var 
  MetaFile: TMetaFile; 
  MFCnv: TMetaFileCanvas; 
begin 
  MetaFile := TMetaFile.Create; 
  MetaFile.Height := grfk.Height; 
  MetaFile.Width := grfk.Width; 
  MFCnv := TMetafileCanvas.Create(MetaFile, 0); 
  with MFCnv do 
  begin 
    Draw(0, 0, grfk); 
    Free; 
  end; 
  with MetaFile do 
  begin 
    SaveToFile(mf); 
    Free; 
  end; 
end; 
 
// Aufruf
procedure TForm1.Button7Click(Sender: TObject); 
var bm: TBitmap; 
begin 
  bm := TBitmap.create; 
  bm.loadfromfile('c:\haus.bmp'); 
  ToMF(bm, 'c:\test.wmf'); 
  bm.free; 
end;

procedure MakeMeta(Bild: TGraphic; Datei, Autor: string); 
var 
  dc: hDC; 
  mf: TMetafile; 
  cn: TCanvas; 
  enh: boolean; 
begin 
  if extractfileext(datei) = '.wmf' then enh := false else 
    if extractfileext(datei) = '.emf' then enh := true else 
    begin 
      showmessage('Fehlerhafte Extension'); 
      exit; 
    end; 
  cn := TCanvas.Create; 
  dc := CreateEnhMetaFile(0, nil, nil, pchar(autor)); 
  cn.handle := dc; 
  setWindowExtEx(cn.handle, bild.width, bild.height, nil); 
  cn.Draw(0, 0, bild); 
  mf := TMetafile.Create; 
  try 
    mf.enhanced := enh; 
    mf.handle := CloseEnhMetaFile(dc); 
    mf.Inch := 1000; 
    mf.height := bild.height; 
    mf.width := bild.width; 
    mf.SaveToFile(Datei); 
  finally 
    mf.free; 
  end; 
end; 
 
// Aufruf 
procedure TForm1.Button1Click(Sender: TObject); 
var tp: TPicture; 
begin 
  tp := tpicture.create; 
  tp.LoadFromFile('d:\bilder\My.bmp'); 
  MakeMeta(tp.graphic, 'c:\Test.emf', 'DBR'); 
// oder auch ...'Test.wmf'... 
  tp.free; 
end;

uses jpeg;

procedure MakeMetaX(Bild: TGraphic; Datei: string); 
var 
  mf: TMetafile; 
  enh: boolean; 
begin 
  if extractfileext(datei) = '.wmf' then enh := false else 
    if extractfileext(datei) = '.emf' then enh := true else 
    begin 
      showmessage('Fehlerhafte Extension'); 
      exit; 
    end; 
  mf := TMetafile.create; 
  mf.width := bild.width; 
  mf.height := bild.height; 
  mf.enhanced := enh; 
  with TMetafileCanvas.CreateWithComment(mf, 0, 'DBR', 'erstellt 28.6.2002') do 
  try 
    setWindowExtEx(handle, bild.width, bild.height, nil); 
    draw(0, 0, bild); 
  finally 
    free; 
  end; 
  mf.Inch := 1000; 
  mf.height := bild.height; 
  mf.width := bild.width; 
  mf.savetofile(Datei); 
  mf.free; 
end;

// Aufruf 
procedure TForm1.Button3Click(Sender: TObject); 
var tp: TPicture; 
begin 
  tp := tpicture.create; 
  tp.LoadFromFile('d:\bilder\vogel.jpg'); 
  MakeMetaX(tp.graphic, 'c:\Test.wmf'); 
  tp.free; 
end;