Conversão de código VB para Delphi (extrairá a imagem do arquivo EMF)

Question

Enquanto pesquisava na net encontrei algumas linhas de código em VB para extrair uma imagem do arquivo EMF.

Tentei converter isso para Delphi, mas não funcionou.

Ajude-me a converter 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

O que você postou é um exemplo de um EnumMetaFileProc função de retorno de chamada, então começaremos com a assinatura:

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

Ele começa declarando um monte de variáveis, mas vou pular isso por enquanto, pois não sei quais realmente precisaremos, e o VB tem um sistema de tipos mais limitado que o Delphi.Vou declará-los conforme precisarmos deles;você mesmo pode movê-los todos para o topo da função.

Em seguida vem uma chamada para PlayEnhMetaFileRecord usando a maioria dos mesmos parâmetros que foram passados ​​para a função de retorno de chamada.A função retorna um Bool, mas o código o ignora, então não vamos nos preocupar com lRet.

PlayEnhMetaFileRecord(hdc, lpHtable, lpMFR, nObj);

Em seguida, inicializamos RecordCount.É declarado estático, o que significa que mantém seu valor de uma chamada para outra.Isso parece um pouco duvidoso;provavelmente deveria ser passado como um ponteiro no lpClientData parâmetro, mas não vamos nos afastar muito do código original por enquanto.Delphi faz variáveis ​​estáticas com constantes digitadas, e eles precisam ser modificáveis, então usaremos a diretiva $J:

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

Inc(RecordCount);

Em seguida, copiamos parte do meta-registro para outra variável:

var
  PEnhEMR: TEMR;

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

Parece um pouco estranho copiar a estrutura TMetaRecord em uma estrutura TEMR, já que elas não são muito semelhantes, mas, novamente, não quero me desviar muito do código original.

A seguir está uma declaração de caso sobre o iType campo.O primeiro caso é quando é 1:

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

O próximo caso é emr_StretchDIBits.Ele copia mais do meta-registro e, em seguida, atribui alguns outros ponteiros para se referir a subseções da estrutura de dados 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);

Em seguida, vem o que parece ser a verdadeira essência da função, onde criamos um contexto de exibição e um bitmap para acompanhá-lo usando os DIBits extraídos usando o 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

Finalmente, atribuímos um valor de retorno à função de retorno de chamada:

Result := 1;

Então, aí está a sua tradução.Enrole-o em um begin-end bloco, remova meu comentário e mova todas as declarações de variáveis ​​​​para o topo, e você deverá ter um código Delphi equivalente ao seu código VB.No entanto, tudo o que esse código faz é gerar vazamentos de memória.O hBitmap variável é local para a função, portanto, o identificador de bitmap que ela contém vaza assim que a função retorna.Presumo que o código VB funcione para você, então acho que você tem outros planos sobre o que fazer com ele.

Se você estiver trabalhando com metarquivos, já pensou em usar o TMetafile aula no Gráficos unidade?Isso pode tornar sua vida mais fácil.