Delphi Tips 
-----------------------------

0130  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成: 1999/02/08 osamu rev 1.1
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新: 1999/02/08 osamu 編集
メタファイルを 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;

参照: [Delphi-ML:23065] <その他Windows関連> <画像> <Windows>

[新規作成] [最新の情報に更新]

How To
Lounge
KeyWords


Tips
Delphi
Home
Osamu Takeuchi osamu@big.or.jp