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字段的案例陈述。第一种情况是它是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类？它可能会让你的生活更轻松。

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

1 个答案: