Преобразование кода 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);

Далее мы Mcopy некоторые из металлической записи в другую переменную:

var
  PEnhEMR: TEMR;

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

Это выглядит немного странно, чтобы скопировать структуру TMEMETARecord на структуру температуры, поскольку они не очень похожи, но опять же, я не хочу слишком много света из исходного кода.

Далее является заявление о случаях на 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);

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

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 класс в Графика единица измерения? Это может облегчить вашу жизнь.