Why does a call to GetDIBits fail on Win64?

Question

I have a call to GetDIBits that works perfectly in 32-bit, but fails on 64-bit. Despite the different values for the handles the content of the bitmapinfo structure are the same.

Here is the smallest (at least slightly structured) code example I could come up with to reproduce the error. I tested with Delphi 10 Seattle Update 1, but the error seems to occur even with other Delphi versions.

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 A comment to this answer points the way as to why your code is failing. The order of evaluation of bitmap.Handle and bitmap.Canvas.Handle matters. Since parameter evaluation order is undefined, your program has undefined behaviour. And that explains why the x86 and x64 programs differ in behaviour.

So you could resolve the issue by assigning the bitmap handle and device context to local variables in the appropriate order, and then passing these as the arguments to GetDIBits. But I still think that the code is far better to avoid the VCL TBitmap class and use GDI calls directly, as in the code below.

---

I believe that your mistake is to pass the bitmap handle, and its canvas handle. Instead you should pass, for example, a device context obtained by calling CreateCompatibleDC(0). Or pass IconInfo.hbmColor to GetDIBits. But don't pass the handle of the TBitmap and the handle of its canvas.

I also cannot see any purpose to the TBitmap that you create. All you do with it is obtain the width and height of IconInfo.hbmColor. You don't need to create TBitmap to do that.

So if I were you I would remove the TBitmap, and use CreateCompatibleDC(0) to obtain the device context. This should greatly simplify the code.

You will also need to delete the bitmaps returned by the call to GetIconInfo, but I guess that you know this already and removed that code from the question for simplicity.

Frankly, the VCL objects are just getting in the way here. It's actually much simpler to call the GDI functions directly. Perhaps something like this:

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;