Conversion du code VB à Delphi (Il extraira l'image à partir du fichier EMF)

Question

Alors que la recherche dans le filet je suis arrivé quelques lignes de code en VB pour extraire une image à partir du fichier EMF.

J'ai essayé de convertir en Delphi, mais ne fonctionne pas.

Aidez-moi à convertir ce code 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

Qu'est-ce que vous avez posté est une instance d'un EnumMetaFileProc fonction de rappel, donc nous allons commencer par la signature:

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

Il commence en déclarant un tas de variables, mais je vais passer que pour l'instant puisque je ne sais pas lesquels nous avons besoin, et VB dispose d'un système de type plus limité que Delphi. Je vais les déclarer comme nous en avons besoin; vous pouvez les déplacer vers le haut de la fonction vous.

Vient ensuite un appel à PlayEnhMetaFileRecord utilisant la plupart du même les paramètres qui ont été passés dans la fonction de rappel. La fonction retourne un Bool, mais le code ne tient pas compte, donc nous allons vous embêtez pas avec lRet.

PlayEnhMetaFileRecord(hdc, lpHtable, lpMFR, nObj);

Ensuite, nous initialize RecordCount. Il est déclaré statique, ce qui signifie qu'il conserve sa valeur d'un appel à l'autre. Cela semble un peu douteux; il devrait probablement être transmis comme un pointeur dans le paramètre lpClientData, mais ne soyons pas Veer trop loin du code d'origine pour l'instant. Delphi fait les variables statiques avec dactylographiée constantes , et ils doivent être modifiables, donc nous allons utiliser la directive J $:

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

Inc(RecordCount);

Ensuite, nous mcopy certains du dossier méta dans une autre variable:

var
  PEnhEMR: TEMR;

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

Il semble un peu étrange de copier la structure TMetaRecord sur une structure TEMR car ils ne sont pas vraiment semblables, mais encore une fois, je ne veux pas Veer du code original trop.

Ensuite est une déclaration de cas sur le champ iType. Le premier cas est quand il est 1:

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

Le cas suivant est que c'est emr_StretchDIBits. Il copie plus de l'enregistrement de méta, et attribue ensuite d'autres pointeurs se référer aux sous-sections de la structure de données 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);

Alors est ce qui semble être la vraie viande de la fonction, où nous créons un contexte d'affichage et un bitmap pour aller avec elle en utilisant les dibits extraits en utilisant le code précédent.

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

Enfin, nous attribuons une valeur de retour à la fonction de rappel:

Result := 1;

Alors, il y a votre traduction. Enveloppez-le dans un bloc begin-end, retirer mon commentaire, et déplacer toutes les déclarations de variables vers le haut, et vous devriez avoir le code Delphi qui est équivalent à votre code VB. Cependant, tout ce code ne finalement est de générer des fuites de mémoire. La variable hBitmap est locale à la fonction, de sorte que la poignée bitmap qu'elle détient est divulgué dès que cette fonction retourne. Je suppose que les travaux de code VB pour vous, bien, donc je suppose que vous avez d'autres plans pour ce qu'il faut faire avec.

Si vous travaillez avec métafichiers, avez-vous pensé à utiliser le TMetafile classe Graphics unité? Il pourrait vous rendre la vie plus facile.