Omskakeling van VB Kode te Delphi (Dit sal die beeld van EMF lêer te onttrek)

Question

Terwyl op soek in die netto ek het n paar reëls van die kode in VB vir die wen 'n beeld van EMF lêer.

Ek het probeer om te sit wat in Delphi maar nie die geval werk.

Help my in die omskakeling van hierdie kode om 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

Wat jy geplaas het is 'n voorbeeld van 'n EnumMetaFileProc terugbelfunksie, so ons sal begin met die ondertekening:

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

Dit begin deur te verklaar 'n klomp van die veranderlikes, maar ek sal slaan dat vir nou, want ek weet nie watter ons regtig nodig het, en VB het 'n meer beperkte tipe stelsel as Delphi. Ek gaan hulle verklaar as ons dit nodig het; jy kan hulle almal beweeg na die top van die funksie self.

Volgende kom 'n oproep om PlayEnhMetaFileRecord met behulp van die meeste van die dieselfde parameters wat geslaag is in die callback funksie. Die funksie gee terug 'n Bool, maar dan die kode ignoreer dit, so laat ons nie die moeite met lRet.

PlayEnhMetaFileRecord(hdc, lpHtable, lpMFR, nObj);

Volgende inisialiseer ons RecordCount. Dit verklaar statiese, wat beteken dat dit sy waarde van een oproep na die volgende behou. Wat lyk 'n bietjie twyfelagtige; dit moet waarskynlik geslaag in as 'n wyser in die parameter lpClientData, maar laat ons nie Veer te ver van die oorspronklike kode vir nou. Delphi doen statiese veranderlikes met getikte konstantes , en wat hulle nodig het modifiable te wees, so ons die $ J richtlijn sal gebruik:

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

Inc(RecordCount);

Volgende mcopy ons 'n paar van die meta rekord in 'n ander veranderlike:

var
  PEnhEMR: TEMR;

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

Dit lyk 'n bietjie vreemd om die TMetaRecord struktuur op 'n TEMR struktuur kopieer omdat hulle nie regtig soortgelyke, maar weer, ek wil nie om Veer van die oorspronklike kode te veel.

Volgende is 'n case-stelling op die veld iType. Die eerste geval is wanneer dit 1:

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

Die volgende geval is dat dit emr_StretchDIBits. Dit afskrifte meer van die meta rekord, en dan ken 'n paar ander wenke om te verwys na die onderafdelings van die belangrikste data struktuur.

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

Dan kom wat lyk na die ware vleis van die funksie, waar ons 'n vertoning konteks en 'n bitmap te gaan met dit met behulp van die DIBits onttrek met behulp van die vorige kode wees.

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

Ten slotte, ons 'n terugkeer waarde toeken aan die callback funksie:

Result := 1;

So, daar is jou vertaling. Draai dit in 'n begin-end blok, verwyder my kommentaar, en beweeg al verklarings die veranderlike aan die bokant, en moet jy Delphi-kode dis gelykstaande aan jou VB-kode hê. Maar al hierdie kode uiteindelik doen, is genereer geheue lekkasies. Die hBitmap veranderlike is plaaslike na die funksie, so die bitmap handvatsel wat dit inhou so gou uitgelek as hierdie funksie gee terug. Ek neem aan die VB-kode werke vir julle, al is, so ek dink jy het 'n paar ander planne vir wat om te doen met dit.

As jy werk met Metafiles, het jy al oorweeg die gebruik van die TMetafile klas in die Grafiese eenheid? Dit mag dalk jou lewe makliker te maak.