VBコードからDelphiへの変換（EMFファイルから画像が抽出されます）

Question

ネットで検索しているときに、EMFファイルから画像を抽出するためにVBでコードの行がほとんどありませんでした。

私はそれをデルフィに変換しようとしましたが、動作しません。

このコードをDelphiに変換するのを手伝ってください。

Public Function CallBack_ENumMetafile(ByVal hdc As Long, _
                                      ByVal lpHtable As Long, _
                                      ByVal lpMFR As Long, _
                                      ByVal nObj As Long, _
                                      ByVal lpClientData As Long) As Long
  Dim PEnhEMR As EMR
  Dim PEnhStrecthDiBits As EMRSTRETCHDIBITS
  Dim tmpDc As Long
  Dim hBitmap  As Long
  Dim lRet As Long
  Dim BITMAPINFO As BITMAPINFO
  Dim pBitsMem As Long
  Dim pBitmapInfo As Long
  Static RecordCount As Long

  lRet = PlayEnhMetaFileRecord(hdc, ByVal lpHtable, ByVal lpMFR, ByVal nObj)


  RecordCount = RecordCount + 1
  CopyMemory PEnhEMR, ByVal lpMFR, Len(PEnhEMR)
  Select Case PEnhEMR.iType
  Case 1  'header
    RecordCount = 1
  Case EMR_STRETCHDIBITS
    CopyMemory PEnhStrecthDiBits, ByVal lpMFR, Len(PEnhStrecthDiBits)
    pBitmapInfo = lpMFR + PEnhStrecthDiBits.offBmiSrc
    CopyMemory BITMAPINFO, ByVal pBitmapInfo, Len(BITMAPINFO)
    pBitsMem = lpMFR + PEnhStrecthDiBits.offBitsSrc

    tmpDc = CreateDC("DISPLAY", vbNullString, vbNullString, ByVal 0&)
    hBitmap = CreateDIBitmap(tmpDc, _
                            BITMAPINFO.bmiHeader, _
                            CBM_INIT, _
                            ByVal pBitsMem, _
                            BITMAPINFO, _
                            DIB_RGB_COLORS)
    lRet = DeleteDC(tmpDc)

  End Select
  CallBack_ENumMetafile = True

End Function

Answer 1

あなたが投稿したのは、のインスタンスです EnumMetaFileProc コールバック関数なので、署名から始めます。

function Callback_EnumMetafile(
  hdc: HDC;
  lpHTable: PHandleTable;
  lpMFR: PMetaRecord;
  nObj: Integer;
  lpClientData: LParam
): Integer; stdcall;

それは多くの変数を宣言することから始めますが、私たちが本当に必要とするものがわからないので、私は今のところそれをスキップします、そして、VBはDelphiよりもタイプのシステムが限られています。私たちはそれらが必要なのでそれらを宣言するつもりです。それらをすべて自分で関数の上部に移動できます。

次に電話があります PlayEnhMetaFileRecord コールバック関数に渡された同じパラメーターのほとんどを使用します。関数はブールを返しますが、コードはそれを無視するので、気にしないようにしましょう lRet.

PlayEnhMetaFileRecord(hdc, lpHtable, lpMFR, nObj);

次に、初期化します RecordCount. 。それは静的と宣言されています。つまり、ある呼び出しから次の呼び出しまでその値を保持します。それは少し疑わしく見えます。おそらくポインターとして渡されるべきです lpClientData パラメーターですが、今のところ元のコードからそれほど遠くないようにしましょう。 Delphiは静的変数を実行します 入力定数, 、そしてそれらは変更可能である必要があるので、$ Jディレクティブを使用します。

{$J+}
const
  RecordCount: Integer = 0;
{$J}

Inc(RecordCount);

次に、メタレコードのいくつかを別の変数にMcopyにします。

var
  PEnhEMR: TEMR;

CopyMemory(@PEnhEMR, lpMFR, SizeOf(PEnhEMR));

tmetarecord構造をTemr構造にコピーするのは少し奇妙に見えます。なぜなら、それらは実際には似ていないので、繰り返しますが、私は元のコードからあまり誘発したくありません。

次は、のケースステートメントです iType 分野。最初のケースは、1の場合です。

case PEnhEMR.iType of
  1: RecordCount := 1;

次のケースは、それがEMR_STRETCHDIBITSであることです。メタレコードをより多くコピーし、メインデータ構造のサブセクションを参照するために他のポインターを割り当てます。

var
  PEnhStretchDIBits: TEMRStretchDIBits;
  BitmapInfo: TBitmapInfo;
  pBitmapInfo: Pointer;
  pBitsMem: Pointer;

  emr_StretchDIBits: begin
    CopyMemory(@PEnhStrecthDIBits, lpMFR, SizeOf(PEnhStrecthDIBits));
    pBitmapInfo := Pointer(Cardinal(lpMFR) + PEnhStrecthDiBits.offBmiSrc);
    CopyMemory(@BitmapInfo, pBitmapInfo, SizeOf(BitmapInfo));
    pBitsMem := Pointer(Cardinal(lpMFR) + PEnhStrecthDiBits.offBitsSrc);

次に、関数の本物の肉と思われるものがあります。ここでは、以前のコードを使用して抽出されたディビットを使用して表示するディスプレイコンテキストとビットマップを作成します。

var
  tmpDc: HDC;
  hBitmap: HBitmap;

    tmpDc := CreateDC('DISPLAY', nil, nil, nil);
    hBitmap := CreateDIBitmap(tmpDc, @BitmapInfo.bmiHeader, cbm_Init,
      pBitsMem, @BitmapInfo, dib_RGB_Colors);
    DeleteDC(tmpDc);
  end; // emr_StretchDIBits
end; // case

最後に、コールバック関数に戻り値を割り当てます。

Result := 1;

だから、あなたの翻訳があります。 aでラップします begin-end ブロック、コメントを削除し、すべての変数宣言を上部に移動すると、VBコードに相当するDelphiコードが必要です。ただし、このコードは最終的にはメモリリークを生成することです。 hBitmap 変数は関数にローカルであるため、この関数が戻るとすぐに、それが保持するビットマップハンドルが漏れます。しかし、VBコードがあなたのために機能すると仮定しているので、それをどうするかについて他の計画があると思います。

メタファイルを使用している場合、使用することを検討しましたか TMetafile のクラス グラフィックス 単位？それはあなたの人生を楽にするかもしれません。