將VB代碼轉換為Delphi（它將從EMF文件中提取圖像）

Question

在網上搜索時，我在VB中有幾行代碼用於從EMF文件中提取圖像。

我試圖將其轉換為Delphi，但不起作用。

幫助我將這段代碼轉換為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 。 該函數返回一個Bool，但是隨后代碼將其忽略，因此我們不必理會lRet 。

PlayEnhMetaFileRecord(hdc, lpHtable, lpMFR, nObj);

接下來，我們初始化RecordCount 。 它被聲明為靜態的，這意味着它保留了從一個調用到下一個調用的值。 看起來有點可疑； 它可能應該作為指針傳入lpClientData參數，但是現在我們不要偏離原始代碼太遠。 Delphi使用類型常量來處理靜態變量，並且它們需要可修改，因此我們將使用$ J指令：

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

Inc(RecordCount);

接下來，我們將一些元記錄復制到另一個變量中：

var
  PEnhEMR: TEMR;

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

將TMetaRecord結構復制到TEMR結構看起來有點奇怪，因為它們實際上並不相似，但是再次，我不想過多地偏離原始代碼。

接下來是iType字段上的case語句。 第一種情況是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);

然后似乎是該功能的實質，在這里我們使用上一代碼提取的DIBits創建一個顯示上下文和一個位圖，將其與之配合使用。

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;

因此，有您的翻譯。 將其包裝在begin - end塊中，刪除我的注釋，然后將所有變量聲明移到頂部，您應該擁有與VB代碼等效的Delphi代碼。 但是，所有這些代碼最終所做的只是生成內存泄漏。 hBitmap變量是該函數的局部變量，因此該函數返回后，它所保存的位圖句柄就會泄漏。 不過，我認為VB代碼適合您，因此我想您還有其他計划來使用它。

如果您正在使用圖元文件，是否考慮過在Graphics單元中使用TMetafile類？ 這可能會使您的生活更輕松。