代码之家 › 专栏 › 技术社区 › Bharat

VB代码到Delphi的转换(它将从EMF文件中提取图像)

metafile bitmap delphi vb.net

2

Bharat · 技术社区 · 14 年前

在网上搜索时,我在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

1 回复 | 直到 12 年前

1

4

Rob Kennedy dkackman 14 年前

你发布的是一个 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 . 它被声明为static,这意味着它在一次调用到下一次调用时保留其值。这看起来有点可疑;它可能应该作为 lpClientData 参数,但现在不要偏离原始代码太远。Delphi使用 类型化常量

{$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\u stretchibits。它复制更多的元记录,然后分配一些其他指针来引用主数据结构的子部分。

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

接下来是这个函数的真正内容,我们创建了一个显示上下文和一个位图,并使用前面代码提取的dibit来执行它。

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 hBitmap 变量是函数的局部变量,因此它所持有的位图句柄在函数返回时立即泄漏。不过,我假设VB代码适合您,所以我猜您对如何使用它还有其他计划。

TMetafile 绘图单位?这可能会让你的生活更轻松。