为什么在 Win64 上调用 GetDIBits 会失败？

Question

我调用了 GetDIBits，它在 32 位上运行良好，但在 64 位上运行失败。尽管句柄的值不同，但 bitmapinfo 结构的内容是相同的。

这是我能想出的用于重现错误的最小（至少是结构化的）代码示例。我使用 Delphi 10 Seattle Update 1 进行了测试，但即使使用其他 Delphi 版本似乎也会出现错误。

program Project1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  Winapi.Windows,
  System.SysUtils,
  Vcl.Graphics;

type
  TRGBALine = array[Word] of TRGBQuad;
  PRGBALine = ^TRGBALine;

type
  { same structure as TBitmapInfo, but adds space for two more entries in bmiColors }
  TMyBitmapInfo = record
    bmiHeader: TBitmapInfoHeader;
    bmiColors: array[0..2] of TRGBQuad;
  public
    constructor Create(AWidth, AHeight: Integer);
  end;

constructor TMyBitmapInfo.Create(AWidth, AHeight: Integer);
begin
  FillChar(bmiHeader, Sizeof(bmiHeader), 0);
  bmiHeader.biSize := SizeOf(bmiHeader);
  bmiHeader.biWidth := AWidth;
  bmiHeader.biHeight := -AHeight;  //Otherwise the image is upside down.
  bmiHeader.biPlanes := 1;
  bmiHeader.biBitCount := 32;
  bmiHeader.biCompression := BI_BITFIELDS;
  bmiHeader.biSizeImage := 4*AWidth*AHeight; // 4 = 32 Bits/Pixel div 8 Bits/Byte
  bmiColors[0].rgbRed := 255;
  bmiColors[1].rgbGreen := 255;
  bmiColors[2].rgbBlue := 255;
end;

procedure Main;
var
  bitmap: TBitmap;
  res: Cardinal;
  Bits: PRGBALine;
  buffer: TMyBitmapInfo;
  BitmapInfo: TBitmapInfo absolute buffer;
  BitsSize: Cardinal;
  icon: TIcon;
  IconInfo: TIconInfo;
begin
  bitmap := TBitmap.Create;
  try
    icon := TIcon.Create;
    try
      icon.LoadFromResourceID(0, Integer(IDI_WINLOGO));
      if not GetIconInfo(icon.Handle, IconInfo) then begin
        Writeln('Error GetIconInfo: ', GetLastError);
        Exit;
      end;
      bitmap.PixelFormat := pf32bit;
      bitmap.Handle := IconInfo.hbmColor;
      BitsSize := BytesPerScanline(bitmap.Width, 32, 32) * bitmap.Height;
      Bits := AllocMem(BitsSize);
      try
        ZeroMemory(Bits, BitsSize);
        buffer := TMyBitmapInfo.Create(bitmap.Width, bitmap.Height);
        res := GetDIBits(bitmap.Canvas.Handle, bitmap.Handle, 0, bitmap.Height, Bits, BitmapInfo, DIB_RGB_COLORS);
        if res = 0 then begin
          Writeln('Error GetDIBits: ', GetLastError);
          Exit;
        end;
        Writeln('Succeed');
      finally
        FreeMem(Bits);
      end;
    finally
      icon.Free;
    end;
  finally
    bitmap.Free;
  end;
end;

begin
  try
    Main;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  Readln;
end.

Answer 1

Update 对此答案的评论指出了代码失败的原因。 bitmap.Handle 和 bitmap.Canvas.Handle 的计算顺序很重要。由于参数评估顺序未定义，您的程序具有未定义的行为。这就解释了为什么 x86 和 x64 程序的行为不同。

因此，您可以通过按适当顺序将位图句柄和设备上下文分配给局部变量，然后将它们作为参数传递给 GetDIBits 来解决此问题。但我仍然认为该代码避免 VCL TBitmap class 并直接使用 GDI 调用要好得多，如下面的代码所示。

我认为您的错误在于传递了位图句柄及其 canvas 句柄。相反，您应该传递，例如，通过调用 CreateCompatibleDC(0) 获得的设备上下文。或者将 IconInfo.hbmColor 传递给 GetDIBits。但不要传递 TBitmap 的句柄及其 canvas.

的句柄

我也看不出您创建的 TBitmap 有任何用途。你用它做的就是获得 IconInfo.hbmColor 的宽度和高度。您无需创建 TBitmap 即可。

所以，如果我是你，我会删除 TBitmap，并使用 CreateCompatibleDC(0) 来获取设备上下文。这应该会大大简化代码。

您还需要删除调用 GetIconInfo 返回的位图，但我想您已经知道这一点并为简单起见从问题中删除了该代码。

坦率地说，VCL 对象只是妨碍了这里。其实直接调用GDI函数要简单的多。也许是这样的：

procedure Main;
var
  res: Cardinal;
  Bits: PRGBALine;
  bitmap: Winapi.Windows.TBitmap;
  DC: HDC;
  buffer: TMyBitmapInfo;
  BitmapInfo: TBitmapInfo absolute buffer;
  BitsSize: Cardinal;
  IconInfo: TIconInfo;
begin
  if not GetIconInfo(LoadIcon(0, IDI_WINLOGO), IconInfo) then begin
    Writeln('Error GetIconInfo: ', GetLastError);
    Exit;
  end;
  try
    if GetObject(IconInfo.hbmColor, SizeOf(bitmap), @bitmap) = 0 then begin
      Writeln('Error GetObject');
      Exit;
    end;

    BitsSize := BytesPerScanline(bitmap.bmWidth, 32, 32) * abs(bitmap.bmHeight);
    Bits := AllocMem(BitsSize);
    try
      buffer := TMyBitmapInfo.Create(bitmap.bmWidth, abs(bitmap.bmHeight));
      DC := CreateCompatibleDC(0);
      res := GetDIBits(DC, IconInfo.hbmColor, 0, abs(bitmap.bmHeight), Bits, BitmapInfo,
        DIB_RGB_COLORS);
      DeleteDC(DC);
      if res = 0 then begin
        Writeln('Error GetDIBits: ', GetLastError);
        Exit;
      end;
      Writeln('Succeed');
    finally
      FreeMem(Bits);
    end;
  finally
    DeleteObject(IconInfo.hbmMask);
    DeleteObject(IconInfo.hbmColor);
  end;
end;

为什么在 Win64 上调用 GetDIBits 会失败？

Why does a call to GetDIBits fail on Win64?

delphi

64-bit

getdibits

delphi-10-seattle