VB 代码到 Delphi 的转换（它将从 EMF 文件中提取图像）

Question

在网上搜索时，我在 VB 中获得了几行代码，用于从 EMF 文件中提取图像。

我尝试将其转换为 Delphi 但不起作用。

帮我把这段代码转换成d​​elphi。

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 类？它可能会让您的生活更轻松。