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