paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-09 15:28:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Implemented missing TBimap.Mask function

Browse Source 
git-svn-id: trunk@12721 -
This commit is contained in:
marc 2007-11-03 17:30:24 +00:00
parent dce6093a4d
commit e2a52c1ccb
2 changed files with 16 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/graphics.pp
View File

@ -1126,7 +1126,7 @@ type
procedure FreeCanvasContext;
function GetCanvas: TCanvas;
procedure CreateCanvas;
procedure CreateMask;
procedure CreateMask(AColor: TColor = clDefault);
function GetMonochrome: Boolean;
procedure SetHandle(Value: HBITMAP);
procedure SetMaskHandle(NewMaskHandle: HBITMAP);

23
lcl/include/bitmap.inc
View File

@ -265,7 +265,7 @@ end;
procedure TBitMap.Mask(ATransparentColor: TColor);
begin
DebugLn('TBitMap.Mask not implemented');
CreateMask(ATransparentColor);
end;
function TBitmap.GetHandle: HBITMAP;
@ -1167,17 +1167,20 @@ begin
CreateIntfImage(Result);
end;
procedure TBitmap.CreateMask;
procedure TBitmap.CreateMask(AColor: TColor);
var
IntfImage: TLazIntfImage;
x, y, stopx, stopy: Integer;
TransColor: TColor;
ImgHandle, MskHandle: HBitmap;
Desc: TRawImageDescription;
TransColor: TColor;
begin
if (Width = 0)
or (Height = 0)
or ((FTransparentMode = tmFixed) and(FTransparentColor = clNone))
or (AColor = clNone)
or ( (FTransparentMode = tmFixed)
and (FTransparentColor = clNone)
and (AColor = clDefault)
)
then begin
SetHandles(FImage.FHandle, 0);
Exit;
@ -1198,9 +1201,13 @@ begin
stopx := IntfImage.Width - 1;
stopy := IntfImage.Height - 1;
if (FTransparentMode = tmFixed) and (FTransparentColor <> clDefault)
then TransColor := ColorToRGB(FTransparentColor)
else TransColor := FPColorToTColor(IntfImage.Colors[0, stopy]);
if AColor = clDefault
then begin
if (FTransparentMode = tmFixed) and (FTransparentColor <> clDefault)
then TransColor := ColorToRGB(FTransparentColor)
else TransColor := FPColorToTColor(IntfImage.Colors[0, stopy]);
end
else TransColor := ColorToRGB(AColor);
for y := 0 to stopy do
for x := 0 to stopx do