paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-26 20:40:36 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed bug #9501

Browse Source 
git-svn-id: trunk@11865 -
This commit is contained in:
marc 2007-08-26 18:12:06 +00:00
parent 0e9fa04c48
commit 8626b3e091
1 changed files with 1 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
lcl/interfaces/win32/win32winapi.inc
View File

@ -671,33 +671,10 @@ end;
and color format (color planes and bits per pixel).
------------------------------------------------------------------------------}
function TWin32WidgetSet.CreateBitmap(Width, Height: Integer; Planes, BitCount: LongInt; BitmapBits: Pointer): HBITMAP;
var
AInfo: Windows.TBitmapInfo;
Data: PByte;
DC: HDC;
dataSize: Integer;
begin
Assert(False, Format('Trace:> [TWin32WidgetSet.CreateBitmap] Width: %d, Height: %d, Planes: %d, BitCount: %d, BitmapBits: 0x%x', [Width, Height, Planes, BitCount, PtrInt(BitmapBits)]));
FillChar(AInfo, SizeOf(AInfo), 0);
with AInfo do
begin
bmiHeader.biSize := SizeOf(bmiHeader);
bmiHeader.biWidth := Width;
bmiHeader.biHeight := -Height;
bmiHeader.biPlanes := Planes;
bmiHeader.biBitCount := Min(24, BitCount); // we dont want 32bpp bitmaps
bmiHeader.biCompression := BI_RGB;
end;
DC := CreateCompatibleDC(0);
Result := Windows.CreateDIBSection(0, AInfo, DIB_RGB_COLORS, Data, 0, 0);
if BitmapBits <> nil then
begin
dataSize := ((Width * AInfo.bmiHeader.biBitCount + 3) and not 3) * Height;
Move(BitmapBits^, Data^, dataSize);
end;
DeleteDC(DC);
Result := Windows.CreateBitmap(Width, Height, Planes, BitCount, BitmapBits);
Assert(False, Format('Trace:< [TWin32WidgetSet.CreateBitmap] --> 0x%x', [Integer(Result)]));
end;