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

lcl: correct TransparentColor and TransparentMode

Browse Source 
- add RequestTransparentColor method which retrieves default transparent color from the rasterimage
 - change TransparentMode setter. If mode = tmAuto then TransparentColor is changed to clDefault otherwise it requested from the rasterimage
- change TransparentColor getter. It should return real color (not clDefault) which will be used as transparent
- change TransparentColor setter. It will change TransparentMode to apropriate value depends on value of the passed color.

This all to be delphi compatible and to fix #0011903

git-svn-id: trunk@16154 -
This commit is contained in:
paul 2008-08-20 05:28:40 +00:00
parent e8d24d2a59
commit d90075d403
2 changed files with 46 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lcl/graphics.pp
View File

@ -1124,6 +1124,7 @@ type
procedure FreeCanvasContext;
function GetCanvas: TCanvas;
function GetRawImage: TRawImage;
function GetTransparentColor: TColor;
procedure SetTransparentColor(AValue: TColor);
protected
FSharedImage: TSharedRasterImage;
@ -1166,6 +1167,7 @@ type
procedure SetPixelFormat(AValue: TPixelFormat); virtual; abstract;
procedure WriteData(Stream: TStream); override;
procedure WriteStream(AStream: TMemoryStream); virtual; abstract;
function RequestTransparentColor: TColor;
public
constructor Create; override;
destructor Destroy; override;
@ -1201,7 +1203,7 @@ type
property PixelFormat: TPixelFormat read GetPixelFormat write SetPixelFormat default pfDevice;
property RawImage: TRawImage read GetRawImage; // be carefull with this, modify only within a begin/endupdate
// property ScanLine[Row: Integer]: Pointer; -> Use TLazIntfImage for such things
property TransparentColor: TColor read FTransparentColor
property TransparentColor: TColor read GetTransparentColor
write SetTransparentColor default clDefault;
property TransparentMode: TTransparentMode read FTransparentMode
write SetTransparentMode default tmAuto;

53
lcl/include/rasterimage.inc
View File

@ -60,9 +60,9 @@ begin
else UpdateHandles(0, 0);
end;
FTransparent := SrcImage.Transparent;
FTransparentMode := SrcImage.TransparentMode;
FTransparentColor := SrcImage.TransparentColor;
FTransparent := SrcImage.FTransparent;
FTransparentMode := SrcImage.FTransparentMode;
FTransparentColor := SrcImage.FTransparentColor;
// -> check if already shared
if SrcImage.FSharedImage <> FSharedImage
@ -388,9 +388,12 @@ end;
procedure TRasterImage.SetTransparentColor(AValue: TColor);
begin
if TransparentColor = AValue then exit;
if FTransparentColor = AValue then exit;
FTransparentColor := AValue;
if TransparentMode <> tmFixed then Exit;
if AValue = clDefault
then FTransparentMode := tmAuto
else FTransparentMode := tmFixed;
CreateMask;
end;
@ -473,6 +476,13 @@ begin
else Result := p^;
end;
function TRasterImage.GetTransparentColor: TColor;
begin
if FTransparentColor = clDefault
then Result := RequestTransparentColor
else Result := FTransparentColor;
end;
procedure TRasterImage.GetSupportedSourceMimeTypes(List: TStrings);
begin
if (ClassType=TBitmap) or (ClassType=TPixmap) or (ClassType=TCustomIcon) then
@ -673,8 +683,8 @@ begin
if (Width = 0)
or (Height = 0)
or (AColor = clNone)
or ( (TransparentMode = tmFixed)
and (TransparentColor = clNone)
or ( (FTransparentMode = tmFixed)
and (FTransparentColor = clNone)
and (AColor = clDefault)
)
then begin
@ -702,8 +712,8 @@ begin
if AColor = clDefault
then begin
if (TransparentMode = tmFixed) and (TransparentColor <> clDefault)
then TransColor := ColorToRGB(TransparentColor)
if (FTransparentMode = tmFixed) and (FTransparentColor <> clDefault)
then TransColor := ColorToRGB(FTransparentColor)
else TransColor := FPColorToTColor(IntfImage.Colors[0, stopy]);
end
else TransColor := ColorToRGB(AColor);
@ -834,6 +844,26 @@ begin
SaveToStream(Stream);
end;
function TRasterImage.RequestTransparentColor: TColor;
var
RawImagePtr: PRawImage;
IntfImage: TLazIntfImage;
begin
// if RawImage exits then use it to get pixel overwise get it from the canvas
RawImagePtr := GetRawImagePtr;
if RawImagePtr <> nil then
begin
IntfImage := TLazIntfImage.Create(RawImagePtr^, False);
try
Result := FPColorToTColor(IntfImage.Colors[0, Height - 1]);
finally
IntfImage.Free;
end;
end
else
Result := Canvas.GetPixel(0, Height - 1);
end;
procedure TRasterImage.SetWidth(AWidth: Integer);
begin
SetSize(AWidth, Height);
@ -848,7 +878,10 @@ procedure TRasterImage.SetTransparentMode(AValue: TTransparentMode);
begin
if AValue = TransparentMode then exit;
FTransparentMode := AValue;
CreateMask;
if AValue = tmAuto
then TransparentColor := clDefault
else TransparentColor := RequestTransparentColor;
end;
// included by graphics.pp