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

我打电话给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,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.

解决方法

更新对此答案的评论指出您的代码为什么失败的方式. bitmap.Handle和bitmap.Canvas.Handle的评估顺序很重要.由于参数评估顺序未定义,您的程序有未定义的行为.这就解释了为什么x86和x64程序的行为有所不同.

因此,您可以通过以适当的顺序将位图句柄和设备上下文分配给局部变量来解决问题,然后将其作为参数传递给GetDIBits.但是我仍然认为代码远远好于避免VCL TBitmap类并直接使用GDI调用,如下面的代码.

我相信你的错误是传递位图句柄及其画布句柄.相反,您应该传递例如通过调用CreateCompatibleDC(0)获得的设备上下文.或将IconInfo.hbmColor传递给GetDIBits.但是不要传递TBitmap的句柄和其画布的句柄.

我也看不到您创建的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) * abs(bitmap.bmHeight);
    Bits := AllocMem(BitsSize);
    try
      buffer := TMyBitmapInfo.Create(bitmap.bmWidth,abs(bitmap.bmHeight));
      DC := CreateCompatibleDC(0);
      res := GetDIBits(DC,IconInfo.hbmColor,abs(bitmap.bmHeight),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;