Преобразование кода VB в Delphi (он извлечет изображение из файла EMF)

Question

При поиске в сети я получил несколько строк кода в VB для извлечения изображения из файла EMF.

Я пытался преобразовать это в Delphi, но не работает.

Помогите мне конвертировать этот код в 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

То, что вы опубликовали, является экземпляром EnumMetaFileProc функция обратного вызова, поэтому мы начнем с подписи:

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

Он начинается с объявления группы переменных, но я пока пропущу это, поскольку не знаю, какие из них нам действительно понадобятся, а VB имеет более ограниченную систему типов, чем Delphi. Я собираюсь объявить их, как они нам нужны; Вы можете переместить их все в начало функции самостоятельно.

Далее идет звонок PlayEnhMetaFileRecord используя большинство тех же параметров, которые были переданы в функцию обратного вызова. Функция возвращает Bool, но затем код игнорирует ее, поэтому давайте не будем беспокоиться о lRet,

PlayEnhMetaFileRecord(hdc, lpHtable, lpMFR, nObj);

Далее мы инициализируем RecordCount, Он объявлен как статический, что означает, что он сохраняет свое значение от одного вызова к другому. Это выглядит немного сомнительно; это, вероятно, следует передать в качестве указателя в lpClientData параметр, но давайте пока не будем слишком далеко отклоняться от исходного кода. Delphi создает статические переменные с типизированными константами, и они должны быть модифицируемыми, поэтому мы будем использовать директиву $J:

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

Inc(RecordCount);

Затем мы скопируем часть мета-записи в другую переменную:

var
  PEnhEMR: TEMR;

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

Скопировать структуру TMetaRecord в структуру TEMR выглядит немного странно, поскольку они не очень похожи, но, опять же, я не хочу слишком сильно отклоняться от исходного кода.

Далее приведено описание случая iType поле. Первый случай, когда это 1:

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

Следующий случай - это emr_StretchDIBits. Он копирует больше мета-записи, а затем назначает некоторые другие указатели для ссылки на подразделы основной структуры данных.

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

Затем следует то, что кажется истинным смыслом функции, где мы создаем контекст отображения и растровое изображение для его использования, используя DIB-биты, извлеченные с использованием предыдущего кода.

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

Наконец, мы присваиваем возвращаемое значение функции обратного вызова:

Result := 1;

Итак, вот ваш перевод. Оберните это в begin - end заблокируйте, удалите мой комментарий и переместите все объявления переменных в верхнюю часть, и у вас должен быть код Delphi, который эквивалентен вашему VB-коду. Однако в конечном итоге весь этот код генерирует утечки памяти. hBitmap переменная является локальной для функции, поэтому дескриптор растрового изображения, который она хранит, просочится, как только эта функция вернется. Я предполагаю, что код VB работает для вас, поэтому, я думаю, у вас есть другие планы относительно того, что с ним делать.

Если вы работаете с метафайлами, рассматривали ли вы возможность использования TMetafile класс в графическом блоке? Это может сделать вашу жизнь проще.