تحويل رمز VB إلى Delphi (سيتم استخراج الصورة من ملف EMF)

Question

أثناء البحث في الشبكة ، حصلت على أسطر قليلة من التعليمات البرمجية في VB لاستخراج صورة من ملف EMF.

حاولت تحويل ذلك إلى دلفي ولكن لا يعمل.

ساعدني في تحويل هذا الرمز إلى 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 باستخدام معظم المعلمات نفسها التي تم تمريرها في وظيفة رد الاتصال. تُرجع الوظيفة منطقيًا ، ولكن بعد ذلك يتجاهله الرمز ، لذلك دعونا لا نلتزم به 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);

ثم يأتي ما يبدو أنه اللحوم الحقيقية للوظيفة ، حيث نقوم بإنشاء سياق عرض وقطعة نقطية للذهاب معها باستخدام dibts المستخرجة باستخدام الكود السابق.

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 يعمل من أجلك ، لذلك أعتقد أن لديك بعض الخطط الأخرى لما يجب فعله به.

إذا كنت تعمل مع Metafiles ، هل فكرت في استخدام TMetafile الفصل في الرسومات وحدة؟ قد يجعل حياتك أسهل.