メタファイルを wmf 形式でコピーするときの注意
|
Word 95 などのように旧メタファイル形式にしか対応しないアプリにメタファイルをコピーするときの注意点です。
Windows はクリップボードにエンハンストメタファイルが有って CF_METAFILEPICT 形式のメタファイルを要求されるとメタファイルを自動的に変換(emf->wmf)します。
ところが Windows がメタファイルをエンハンストから旧メタファイルに変換するとき境界枠の大きさやアスペクト比が失われてしまいます。
以下のように、はじめから wmf でクリップボードにコピーしておくといいようです。
procedure SaveToClipAsWMF(mf: TMetafile);
var
hMetafilePict: THandle;
pMFPict: PMetafilePict;
DC: THandle;
Length: Integer;
Bits: Pointer;
h: HMETAFILE;
begin
DC := GetDC(0);
try
Length := GetWinMetaFileBits(mf.Handle, 0, nil,
MM_ANISOTROPIC, DC);
Assert(Length > 0);
GetMem(Bits, Length);
try
GetWinMetaFileBits(mf.Handle, Length, Bits,
MM_ANISOTROPIC, DC);
h := SetMetafileBitsEx(Length, Bits);
Assert(h <> 0);
try
hMetafilePict := GlobalAlloc(GMEM_MOVEABLE or
GMEM_DDESHARE,
Length);
Assert(hMetafilePict <> 0);
try
pMFPict := GlobalLock(hMetafilePict);
pMFPict^.mm := MM_ANISOTROPIC;
pMFPict^.xExt := mf.Width;
pMfPict^.yExt := mf.Height;
pMfPict^.hMF := h;
GlobalUnlock(hMetafilePict);
Clipboard.SetAsHandle(CF_METAFILEPICT, hMetafilePict);
except
GlobalFree(hMetafilePict);
raise;
end;
except
DeleteObject(h);
raise;
end;
finally
FreeMem(Bits);
end;
finally
ReleaseDC(0, DC);
end;
end;
|
|