Conversion of VB Code to Delphi (It will extract image from EMF File) - vb.net

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.