2

在网上搜索时，我在 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
4

1 回答 1

4

您发布的是一个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现场的案例陈述。第一种情况是当它为 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 代码对你有用，所以我猜你还有其他的计划来处理它。

如果您正在使用元文件，您是否考虑过在图形单元中使用TMetafile该类？它可能会让你的生活更轻松。

于 2010-06-17T15:14:51.680 回答