function bmp2emf(const SourceFileName: TFileName): Boolean;
var
Metafile: TMetafile;
MetaCanvas: TMetafileCanvas;
Bitmap: TBitmap;
begin
Metafile := TMetaFile.Create;
try
Bitmap := TBitmap.Create;
try
Bitmap.LoadFromFile(SourceFileName);
Metafile.Height := Bitmap.Height;
Metafile.Width := Bitmap.Width;
MetaCanvas := TMetafileCanvas.Create(Metafile, 0);
try
MetaCanvas.Draw(0, 0, Bitmap);
finally
MetaCanvas.Free;
end;
finally
Bitmap.Free;
end;
Metafile.SaveToFile(ChangeFileExt(SourceFileName, '.emf'));
finally
Metafile.Free;
end;
end;
Beispiel :
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
try
bmp2emf(OpenDialog1.FileName);
finally
end;
end;
end;
Keine Kommentare:
Kommentar veröffentlichen