paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-07-09 13:26:05 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL/Graphics: Fix handling of color transparency in TRasterImage and descendants. Issue #41726.

Browse Source
This commit is contained in:
wp_xyz 2025-06-30 17:09:25 +02:00
parent 5c34fbf059
commit 1661d5ff48
2 changed files with 20 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/graphics.pp
View File

@ -1245,6 +1245,7 @@ type
FUpdateCount: Integer; FUpdateCount: Integer;
FUpdateCanvasOnly: Boolean; FUpdateCanvasOnly: Boolean;
FMasked: Boolean; FMasked: Boolean;
FTransparentPending: Boolean;
procedure CanvasChanging(Sender: TObject); procedure CanvasChanging(Sender: TObject);
procedure CreateCanvas; procedure CreateCanvas;
@ -1300,6 +1301,7 @@ type
procedure WriteData(Stream: TStream); override; procedure WriteData(Stream: TStream); override;
procedure WriteStream(AStream: TMemoryStream); virtual; abstract; procedure WriteStream(AStream: TMemoryStream); virtual; abstract;
function RequestTransparentColor: TColor; function RequestTransparentColor: TColor;
procedure ApplyTransparent;
public public
constructor Create; override; constructor Create; override;
destructor Destroy; override; destructor Destroy; override;

24
lcl/include/rasterimage.inc
View File

@ -379,9 +379,7 @@ begin
then FTransparentMode := tmAuto then FTransparentMode := tmAuto
else FTransparentMode := tmFixed; else FTransparentMode := tmFixed;
if MaskHandleAllocated ApplyTransparent;
then MaskHandle := 0
else Changed(Self);
end; end;
procedure TRasterImage.Changed(Sender: TObject); procedure TRasterImage.Changed(Sender: TObject);
@ -702,9 +700,14 @@ begin
if AValue = TransparentMode then exit; if AValue = TransparentMode then exit;
FTransparentMode := AValue; FTransparentMode := AValue;
if AValue = tmAuto if FTransparentColor = clDefault then
FTransparentMode := tmAuto;
if FTransparentMode = tmAuto
then TransparentColor := clDefault then TransparentColor := clDefault
else TransparentColor := RequestTransparentColor; else TransparentColor := RequestTransparentColor;
ApplyTransparent;
end; end;
procedure TRasterImage.SetTransparent(AValue: Boolean); procedure TRasterImage.SetTransparent(AValue: Boolean);
@ -714,8 +717,8 @@ begin
lTransparent := GetTransparent(); lTransparent := GetTransparent();
if AValue = lTransparent then Exit; if AValue = lTransparent then Exit;
// some delphi compatibility, we can only change transparency through the mask. FTransparentPending := AValue;
Masked := AValue; ApplyTransparent;
end; end;
// release handles without freeing them // release handles without freeing them
@ -976,6 +979,15 @@ begin
SetSize(Width, AHeight); SetSize(Width, AHeight);
end; end;
procedure TRasterImage.ApplyTransparent;
begin
if MaskHandleAllocated then
MaskHandle := 0;
// some delphi compatibility, we can only change transparency through the mask.
SetMasked(FTransparentPending);
end;
// included by graphics.pp // included by graphics.pp