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.
GetDIBits requires a buffer from VirtualAlloc
? msdn.microsoft.com/ru-ru/library/windows/desktop/… – Gilded