function bmp2emf(const SourceFileName: TFileName): Boolean;
// Converts a Bitmap to a Enhanced Metafile (*.emf)
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;

procedure TForm1.Button1Click(Sender: TObject);
begin
bmp2emf(’C:\TestBitmap.bmp’);
end;

В кои-то веки программер идет домой засветло. Все вокруг красиво, деревья, птички, облачка… Останавливается он и говорит:
- Вот ведь блин, и ведь БЕЗ ВСЯКОГО OpenGL!!!

procedure TForm1.Button1Click(Sender: TObject);
var
m : TmetaFile;
mc : TmetaFileCanvas;
b : tbitmap;
begin
m := TMetaFile.Create;
b := TBitmap.create;
b.LoadFromFile(’C:.bmp’);
m.Height := b.Height;
m.Width := b.Width;
mc := TMetafileCanvas.Create(m, 0);
mc.Draw(0, 0, b);
mc.Free;
b.Free;
m.SaveToFile(’C:.emf’);
m.Free;
Image1.Picture.LoadFromFile(’C:.emf’);
end;

В: Мне необходимо нарисовать Windows-метафайл. Delphi непосредственно это не поддерживает, поэтому для создания нового метафайла я использую функции Windows API. При создании метафайла мне возвращается его THandle, являющийся дескриптором контекста устройства Windows (DC).

Как мне в Delphi использовать возвращаемый THandle для получения или создания канвы (Canvas) для рисования?

О: несколько дней назад я задавал аналогичный вопрос, но не получил ответа, поэтому пришлось искать решение самому. Вот код (надеюсь это то, что нужно):

unit Metaform;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, Buttons, ExtCtrls;

type

TForm1 = class(TForm)
Panel1: TPanel;
BitBtn1: TBitBtn;
Image1: TImage;
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var

Form1: TForm1;

implementation

{$R *.DFM}

type

TMetafileCanvas = class(TCanvas)
private
FClipboardHandle: THandle;
FMetafileHandle: HMetafile;
FRect: TRect;
protected
procedure CreateHandle; override;
function GetMetafileHandle: HMetafile;
public
constructor Create;
destructor Destroy; override;
property Rect: TRect read FRect write FRect;
property MetafileHandle: HMetafile read GetMetafileHandle;
end;

constructor TMetafileCanvas.Create;
begin

inherited Create;
FClipboardHandle := GlobalAlloc(
GMEM_SHARE or GMEM_ZEROINIT, SizeOf(TMetafilePict));
end;

destructor TMetafileCanvas.Destroy;
begin

DeleteMetafile(CloseMetafile(Handle));
if Bool(FClipboardHandle) then
GlobalFree(FClipboardHandle);
if Bool(FMetafileHandle) then
DeleteMetafile(FMetafileHandle);
inherited Destroy;
end;

procedure TMetafileCanvas.CreateHandle;
var

MetafileDC: HDC;
begin

{ Создаем в памяти DC метафайла }
MetafileDC := CreateMetaFile(nil);
if Bool(MetafileDC) then
begin
{ Совмещаем верхний левый угол отображаемого прямоугольника с левым верхним углом
контекста устройства. Создаем границу шириной 10 логических единиц вокруг изображения. }
with FRect do
SetWindowOrg(MetafileDC, Left - 10, Top - 10);
{ Устанавливаем размер изображения с бордюром, имеющим ширину 10 логических единиц. }
with FRect do
SetWindowExt(MetafileDC, Right - Left + 20, Bottom - Top + 20);
{ Задаем корректное содержание данному метафайлу. }
if Bool(FMetafileHandle) then
begin
PlayMetafile(MetafileDC, FMetafileHandle);
end;
end;
Handle := MetafileDC;
end;

function TMetafileCanvas.GetMetafileHandle: HMetafile;
var

MetafilePict: PMetafilePict;
IC: HDC;
ExtRect: TRect;
begin

if Bool(FMetafileHandle) then
DeleteMetafile(FMetafileHandle);
FMetafileHandle := CloseMetafile(Handle);
Handle := 0;
{ Подготавливаем метафайл для показа в буфере обмена. }
MetafilePict := GlobalLock(FClipboardHandle);
MetafilePict^.mm := mm_AnIsoTropic;
IC := CreateIC(’DISPLAY’, nil, nil, nil);
SetMapMode(IC, mm_HiMetric);
ExtRect := FRect;
DPtoLP(IC, ExtRect, 2);
DeleteDC(IC);
MetafilePict^.xExt := ExtRect.Right - ExtRect.Left;
MetafilePict^.yExt := ExtRect.Top - ExtRect.Bottom;
MetafilePict^.HMF := FMetafileHandle;
GlobalUnlock(FClipboardHandle);
{ Передаем дескриптор в качестве результата выполнения функции. }
Result := FClipboardHandle;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var

MetafileCanvas: TMetafileCanvas;
begin

MetafileCanvas := TMetafileCanvas.Create;
MetafileCanvas.Rect := Rect(0, 0, 500, 500);
MetafileCanvas.Ellipse(10, 10, 400, 400);
Image1.Picture.Metafile.LoadFromClipboardFormat(
cf_MetafilePict, MetafileCanvas.MetafileHandle, 0);
MetafileCanvas.Free;
end;

end.

Компьютер - это устройство для упорядочивания, ускорения и автоматизации человеческих ошибок.

Для создания в памяти метафайла, я пытаюсь использовать TMetafile. Чтобы я ни делал, это не работает как надо. Я получаю метафайл или неверного размера, или без возможности масштабирования.

Я долго экспериментировал и пришел к выводу, что все эти ошибки возникают в случае, когда map mode (режим карты) использует не mm_Text. Я трассировал ошибку в TMetafile.SaveToClipboardFormat. Программа неверно использует значение по умолчанию TMetafileImage.FInch = 0. Я думаю что TMetafileImage должен иметь значение по умолчанию FInch = Screen.PixelsPerInch или программа, которая сохраняет его в буфере обмена, должна правильно использовать FInch = 0 (т.е. сделайте значение mm_Text).

Постовой:
moi-style.ru - женский блог “Мой стиль” - все о моде и стиле

procedure ConvertWMF2BMP
(const WMFFileName, BMPFileName: TFileName);
var
MetaFile: TMetafile;
Bitmap: TBitmap;
begin
Metafile := TMetaFile.Create;
Bitmap := TBitmap.Create;
try
MetaFile.LoadFromFile(WMFFileName);
with Bitmap do
begin
Height := Metafile.Height;
Width := Metafile.Width;
Canvas.Draw(0, 0, MetaFile);
SaveToFile(BMPFileName);
end;
finally
Bitmap.Free;
MetaFile.Free;
end;
end;

// Использование:
ConvertWMF2BMP(’c:\mypic.wmf’, ‘c:\mypic.bmp’)