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

Question

While searching in the net i got few lines of code in VB for extracting an image from EMF File.

I tried to convert that into Delphi but doesnt work.

Help me in converting this code to 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

What you've posted is an instance of an EnumMetaFileProc callback function, so we'll start with the signature:

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

It begins by declaring a bunch of variables, but I'll skip that for now since I don't know which ones we'll really need, and VB has a more limited type system than Delphi. I'm going to declare them as we need them; you can move them all to the top of the function yourself.

Next comes a call to PlayEnhMetaFileRecord using most of the same parameters that were passed into the callback function. The function returns a Bool, but then the code ignores it, so let's not bother with lRet .

PlayEnhMetaFileRecord(hdc, lpHtable, lpMFR, nObj);

Next we initialize RecordCount . It's declared static, which means it retains its value from one call to the next. That looks a little dubious; it should probably be passed in as a pointer in the lpClientData parameter, but let's not veer too far from the original code for now. Delphi does static variables with typed constants , and they need to be modifiable, so we'll use the $J directive:

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

Inc(RecordCount);

Next we mcopy some of the meta record into another variable:

var
  PEnhEMR: TEMR;

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

It looks a little strange to copy the TMetaRecord structure onto a TEMR structure since they aren't really similar, but again, I don't want to veer from the original code too much.

Next is a case statement on the iType field. The first case is when it's 1:

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

The next case is that it's emr_StretchDIBits. It copies more of the meta record, and then assigns some other pointers to refer to subsections of the main data structure.

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);

Then comes what seems to be the real meat of the function, where we create a display context and a bitmap to go with it using the DIBits extracted using the previous code.

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

Finally, we assign a return value to the callback function:

Result := 1;

So, there's your translation. Wrap it in a begin - end block, remove my commentary, and move all the variable declarations to the top, and you should have Delphi code that's equivalent to your VB code. However, all this code ultimately does is generate memory leaks. The hBitmap variable is local to the function, so the bitmap handle it holds is leaked as soon as this function returns. I assume the VB code works for you, though, so I guess you have some other plans for what to do with it.

If you're working with metafiles, have you considered using the TMetafile class in the Graphics unit? It might make your life easier.