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
La solution
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.