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

added implementation for TCustomImageList.ReplaceMasked

Browse Source 
git-svn-id: trunk@13090 -
This commit is contained in:
paul 2007-11-30 18:11:00 +00:00
parent 9d26c55e9a
commit 08608057d5
2 changed files with 37 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/imglist.pp
View File

@ -128,6 +128,7 @@ type
procedure InternalInsert(AIndex: Integer; AImage, AMask: HBitmap;
AWidth, AHeight: Integer);
procedure InternalMove(ACurIndex, ANewIndex: Cardinal; AIgnoreCurrent: Boolean);
procedure InternalReplace(AIndex: Integer; AImage, AMask: HBitmap);
function InternalSetImage(AIndex: Integer; AImage: TRawImage): PRGBAQuad;
procedure NotifyChangeLink;
procedure SetBkColor(const Value: TColor);

54
lcl/include/imglist.inc
View File

@ -768,6 +768,26 @@ begin
end;
end;
procedure TCustomImageList.InternalReplace(AIndex: Integer; AImage,
AMask: HBitmap);
var
RawImage: TRawImage;
R: TRect;
ImgData: PRGBAQuad;
begin
if (AIndex < 0) then AIndex := 0;
CheckIndex(AIndex);
R := Rect(0, 0, FWidth, FHeight);
RawImage_FromBitmap(RawImage, AImage, AMask, R);
ImgData := InternalSetImage(AIndex, RawImage);
if HandleAllocated
then TWSCustomImageListClass(WidgetSetClass).Replace(Self, AIndex, ImgData);
FChanged := true;
Change;
end;
{------------------------------------------------------------------------------
Method: TCustomImageList.InternalSetImage
Params: AIndex: the index of the location where the image should be set
@ -1173,25 +1193,14 @@ end;
------------------------------------------------------------------------------}
procedure TCustomImageList.Replace(AIndex: Integer; AImage, AMask: TBitmap);
var
RawImage: TRawImage;
R: TRect;
ImgData: PRGBAQuad;
msk: THandle;
begin
if (AIndex < 0) then AIndex := 0;
CheckIndex(AIndex);
if AImage = nil then Exit;
if AMask = nil
then msk := 0
else msk := AMask.Handle;
R := Rect(0, 0, FWidth, FHeight);
RawImage_FromBitmap(RawImage, AImage.Handle, msk, R);
ImgData := InternalSetImage(AIndex, RawImage);
if HandleAllocated
then TWSCustomImageListClass(WidgetSetClass).Replace(Self, AIndex, ImgData);
FChanged := true;
Change;
InternalReplace(AIndex, AImage.Handle, msk);
end;
{------------------------------------------------------------------------------
@ -1224,13 +1233,22 @@ end;
Every occurance of MaskColor will be converted to transparent.
------------------------------------------------------------------------------}
procedure TCustomImageList.ReplaceMasked(Index: Integer; NewImage: TBitmap; MaskColor: TColor);
var
AMask: TBitmap;
begin
if (Index >= FCount)
then raise EInvalidOperation.Create(SInvalidIndex);
if NewImage = nil then Exit;
if (Index < 0) then Index := 0;
AMask := TBitmap.Create;
with AMask do
begin
Height := NewImage.Height;
Width := NewImage.Width;
Assign(NewImage);
Mask(MaskColor);
end;
{$note implement}
InternalReplace(Index, NewImage.Handle, AMask.Handle);
AMask.Free;
end;
{------------------------------------------------------------------------------