La conversione del codice VB per Delphi (Sarà estrarre immagini da file EMF)

Question

Durante la ricerca in rete ho ottenuto poche righe di codice in VB per estrarre un'immagine da file EMF.

Ho cercato di convertire in Delphi, ma non funziona.

aiutarmi nella conversione di questo codice per 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

Quello che hai postato è un esempio di un EnumMetaFileProc funzione di callback, quindi inizieremo con la firma:

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

Si inizia dichiarando una serie di variabili, ma salterò che, per ora, poiché non so quali avremo davvero bisogno, e VB ha un sistema di tipo più limitato rispetto Delphi. Ho intenzione di dichiarare loro come abbiamo bisogno di loro; tutti si può spostare nella parte superiore della funzione di se stessi.

Segue una chiamata a PlayEnhMetaFileRecord utilizzando la maggior parte degli stessi parametri passati alla funzione di richiamata. La funzione restituisce un bool, ma poi il codice ignora, quindi cerchiamo di non perdere tempo con lRet.

PlayEnhMetaFileRecord(hdc, lpHtable, lpMFR, nObj);

Il prossimo inizializzare RecordCount. E 'dichiarato statica, il che significa che mantiene il suo valore da una chiamata all'altra. Che sembra un po 'dubbioso; probabilmente dovrebbe essere passato come un puntatore nel parametro lpClientData, ma cerchiamo di non voltare troppo lontano dal codice originale per ora. Delphi fa variabili statiche con tipizzato costanti , e hanno bisogno di essere modificabili, quindi useremo la direttiva J $:

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

Inc(RecordCount);

Il prossimo mcopy alcuni dei meta-record in un'altra variabile:

var
  PEnhEMR: TEMR;

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

Sembra un po 'strano per copiare la struttura TMetaRecord su una struttura TEMR poiché non sono molto simili, ma ancora una volta, non voglio a virare dal codice originale troppo.

Avanti è una dichiarazione caso sul campo iType. Il primo caso è quando si tratta di 1:

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

Il caso successivo è che è emr_StretchDIBits. E 'più copie della meta record e quindi assegna alcuni altri indicatori per indicare sottosezioni della struttura dati principale.

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

Poi arriva quello che sembra essere la vera carne della funzione, dove si crea un contesto di visualizzazione e una bitmap di andare con lui utilizzando i DIBits estratti utilizzando il codice precedente.

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

Infine, si assegna un valore restituito alla funzione di callback:

Result := 1;

Quindi, non c'è la vostra traduzione. Avvolgerlo in un blocco begin-end, rimuovere il mio commento, e spostare tutte le dichiarazioni di variabili verso l'alto, e si dovrebbe avere il codice Delphi che è equivalente al codice VB. Tuttavia, tutto questo codice in definitiva fa è generare perdite di memoria. La variabile hBitmap è locale alla funzione, in modo che il manico bitmap che detiene è trapelato non appena questa funzione restituisce. Presumo le opere di codice VB per voi, però, quindi credo di avere alcuni altri piani su cosa fare con esso.

Se si lavora con metafile, avete considerato utilizzando il TMetafile classe nel em> Grafica unità