La conversión de código VB para Delphi (Extraerá imagen de archivo EMF)

Question

Si bien la búsqueda en la red me dieron unas líneas de código en VB para extraer una imagen de archivo EMF.

He intentado convertir eso en Delphi, pero no funciona.

Me ayudan en la conversión de este código para 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

Lo que has publicado es una instancia de un EnumMetaFileProc función de devolución, por lo que vamos a empezar con la firma:

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

Comienza declarando un montón de variables, pero voy a omitir que por ahora ya no sé cuáles vamos a realmente necesitamos, y VB tiene un sistema de tipo más limitado que Delphi. Voy a hacerlo como nosotros a ellos; puede mover a todos a la parte superior de la función de sí mismo.

A continuación viene una llamada a PlayEnhMetaFileRecord utilizando la mayor parte de la misma parámetros que se han pasado a la función de devolución de llamada. La función devuelve un Bool, pero luego el código ignora, así que vamos no se molestan con lRet.

PlayEnhMetaFileRecord(hdc, lpHtable, lpMFR, nObj);

A continuación se inicializa RecordCount. Se declaró estática, lo que significa que conserva su valor de una llamada a la siguiente. Eso parece un poco dudosa; probablemente debería ser pasado como un puntero en el parámetro lpClientData, pero no vamos a virar demasiado lejos del código original por ahora. Delphi hace variables estáticas con mecanografiada constantes , y que necesitan para ser modificables, así que usaremos la directiva J $:

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

Inc(RecordCount);

A continuación algunos de mcopy el registro meta en otra variable:

var
  PEnhEMR: TEMR;

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

Se parece un poco extraño para copiar la estructura TMetaRecord sobre una estructura TEMR ya que no son muy similares, pero de nuevo, no quiero dar un giro desde el código original demasiado.

Lo siguiente es una declaración de caso en el campo iType. El primer caso es cuando es 1:

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

El siguiente caso es que es emr_StretchDIBits. Es más copias del registro meta, y luego asigna algunos otros punteros para referirse a las subsecciones de la estructura de datos principal.

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

Luego viene lo que parece ser la verdadera sustancia de la función, donde creamos un contexto de presentación y un mapa de bits para ir con ella usando los dibits extraídos utilizando el código anterior.

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

Por último, asignamos un valor de retorno a la función de devolución de llamada:

Result := 1;

Por lo tanto, no es su traducción. Envolverlo en un bloque begin-end, eliminar mi comentario, y mover todas las declaraciones de variables a la parte superior, y usted debe tener código de Delphi que es equivalente a su código de VB. Sin embargo, todo este código en última instancia hace es generar pérdidas de memoria. La variable hBitmap es local a la función, por lo que el mango de mapa de bits que posee se filtró tan pronto como sea devuelto por esta función. Asumo que el código funciona VB para usted, sin embargo, así que supongo que tiene otros planes para saber qué hacer con él.

Si está trabajando con metafiles, ¿ha considerado el uso de la TMetafile clase en el em> Gráficos unidad