我有一个调用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.
更新对此答案的注释指出了代码失败的原因。bitmap.Handle和的评估顺序很bitmap.Canvas.Handle重要。由于参数评估顺序是不确定的，因此您的程序具有不确定的行为。这就解释了为什么x86和x64程序的行为不同。
因此，您可以通过以适当的顺序将位图句柄和设备上下文分配给局部变量，然后将它们作为参数传递来解决此问题GetDIBits。但是我仍然认为，避免使用VCLTBitmap类并直接使用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, 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;
本文收集自互联网，转载请注明来源。
如有侵权，请联系[email protected] 删除。
我来说两句