pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

* Use the native LCL methods to build bitmap mask in system check images

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1053 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
blikblum
2009-12-13 04:40:44 +00:00
parent 287d58b230
commit d8a5912b7c
1 changed files with 2 additions and 29 deletions
Download Patch File Download Diff File Expand all files Collapse all files

31
components/virtualtreeview-new/trunk/VirtualTrees.pas
View File

@ -5193,31 +5193,6 @@ begin
end;
end;
{$ifdef Windows}
procedure ClearAlphaChannel(Bitmap: HBitmap; PixelCount: Integer);
var
i: Integer;
DIB: TDIBSection;
P: PCardinal;
begin
P := nil;
if Bitmap <> 0 then
begin
if GetObject(Bitmap, SizeOf(DIB), @DIB) = SizeOf(DIB) then
begin
if DIB.dsBm.bmPlanes * DIB.dsBm.bmBitsPixel = 32 then
P := DIB.dsBm.bmBits;
end;
end;
if P = nil then
Exit;
for i:= 0 to PixelCount - 1 do
(P + i)^ := (P + i)^ and $00FFFFFF;
end;
{$endif}
function CalculateScanline(Bits: Pointer; Width, Height, Row: Integer): Pointer;
// Helper function to calculate the start address for the given row.
@ -5424,10 +5399,8 @@ begin
// Add the 20 system checkbox and radiobutton images.
for I := 0 to 19 do
AddSystemImage(I);
//todo: there's a bug in LCL that prevents mask creation of loaded bitmaps in windows
//is necessary to remove the alpha opacity
ClearAlphaChannel(BM.Handle, BM.Height*BM.Width);
BM.MaskHandle := CreateBitmapMask(BM.Canvas.Handle, BM.Width, BM.Height, MaskColor);
BM.TransparentColor := MaskColor;
BM.Transparent := True;
{$endif}
end;