Die Umwandlung von VB-Code zu Delphi (Es wird extrahieren Bild von EMF-Datei)

Question

Während im Netz suchen Ich habe paar Zeilen Code in VB zum Extrahieren eines Bildes von EMF-Datei.

Ich habe versucht, das in Delphi aber nicht funktioniert zu konvertieren.

Helfen Sie mir in diesen Code zu delphi umgewandelt wird.

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

Was haben Sie geschrieben ist eine Instanz eines EnumMetaFileProc Callback-Funktion, so dass wir mit der Unterschrift beginnen werden:

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

Es beginnt mit einer Reihe von Variablen zu erklären, aber ich werde überspringen, dass jetzt, da ich nicht weiß, welche davon wir wirklich brauchen, und VB hat ein begrenztere Typ-System als Delphi. Ich werde sie erklären, wie wir sie brauchen; Sie können sie alle an der Spitze der Funktion selbst bewegen.

Als nächstes kommt ein Anruf an PlayEnhMetaFileRecord mit den meisten der gleichen Parameter, die in die Callback-Funktion übergeben wurden. Die Funktion gibt einen Bool, aber dann der Code ignoriert, also lassen Sie sich nicht mit lRet stören.

PlayEnhMetaFileRecord(hdc, lpHtable, lpMFR, nObj);

Als nächstes initialisieren wir RecordCount. Es ist statisch deklariert, das heißt, es seinen Wert von einem Aufruf zum nächsten behält. Das sieht ein wenig zweifelhaft; es soll wohl in als Zeiger im lpClientData Parameter übergeben werden, aber lass sie nicht veer zu weit vom ursprünglichen Code für jetzt. Delphi hat statische Variablen mit typisierten Konstanten , und sie müssen modifizierbar sein, so dass wir die $ J Richtlinie verwenden werden:

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

Inc(RecordCount);

Als nächstes mcopy wir einige des Meta-Datensatz in einer anderen Variable:

var
  PEnhEMR: TEMR;

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

Es sieht ein wenig seltsam, die TMetaRecord Struktur auf eine TEMR Struktur zu kopieren, da sie nicht wirklich ähnlich sind, aber wieder, ich will nicht zu veer aus dem ursprünglichen Code zu viel.

Als nächstes ist ein Fall, Aussage über das iType Feld. Der erste Fall ist, wenn es 1:

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

Der nächste Fall ist, dass es emr_StretchDIBits ist. Es kopiert mehr der Meta-Datensatz und dann einige andere Zeiger zuordnet Teilabschnitte der Hauptdatenstruktur zu verweisen.

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

Dann kommt, was das eigentliche Fleisch der Funktion zu sein scheint, wo wir eine Anzeigekontext und eine Bitmap erstellen, um mit ihm zu gehen, den Di-Bits mit dem vorherigen Code extrahiert werden.

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

Schließlich haben wir einen Rückgabewert an die Callback-Funktion zuweisen:

Result := 1;

Es gibt also Ihre Übersetzung. Wickeln Sie es in einem begin-end Block, entfernen Sie meinen Kommentar, und bewegen Sie die alle Variablendeklarationen nach oben, und Sie sollten Delphi-Code haben, die Ihrem VB-Code äquivalent ist. Doch all dieser Code letztlich tut, ist Speicherverluste zu erzeugen. Die hBitmap Variable ist lokal auf die Funktion, so dass das Bitmap-Handle wird, sobald diese Funktion zurückgibt durchgesickert hält. Ich gehe davon aus, die VB-Code für Sie arbeitet, obwohl, so dass ich denke, Sie haben einige andere Pläne für das, was mit ihm zu tun.

Wenn Sie mit Metadateien arbeiten, haben Sie mit als der TMetafile Klasse im Grafiken Einheit? Es könnte Ihr Leben leichter machen.