lcl: correct TransparentColor and TransparentMode

- 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

View File

@ -1124,6 +1124,7 @@ type
procedure FreeCanvasContext; procedure FreeCanvasContext;
function GetCanvas: TCanvas; function GetCanvas: TCanvas;
function GetRawImage: TRawImage; function GetRawImage: TRawImage;
function GetTransparentColor: TColor;
procedure SetTransparentColor(AValue: TColor); procedure SetTransparentColor(AValue: TColor);
protected protected
FSharedImage: TSharedRasterImage; FSharedImage: TSharedRasterImage;
@ -1166,6 +1167,7 @@ type
procedure SetPixelFormat(AValue: TPixelFormat); virtual; abstract; procedure SetPixelFormat(AValue: TPixelFormat); virtual; abstract;
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;
public public
constructor Create; override; constructor Create; override;
destructor Destroy; override; destructor Destroy; override;
@ -1201,7 +1203,7 @@ type
property PixelFormat: TPixelFormat read GetPixelFormat write SetPixelFormat default pfDevice; 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 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 ScanLine[Row: Integer]: Pointer; -> Use TLazIntfImage for such things
property TransparentColor: TColor read FTransparentColor property TransparentColor: TColor read GetTransparentColor
write SetTransparentColor default clDefault; write SetTransparentColor default clDefault;
property TransparentMode: TTransparentMode read FTransparentMode property TransparentMode: TTransparentMode read FTransparentMode
write SetTransparentMode default tmAuto; write SetTransparentMode default tmAuto;

View File

@ -60,9 +60,9 @@ begin
else UpdateHandles(0, 0); else UpdateHandles(0, 0);
end; end;
FTransparent := SrcImage.Transparent; FTransparent := SrcImage.FTransparent;
FTransparentMode := SrcImage.TransparentMode; FTransparentMode := SrcImage.FTransparentMode;
FTransparentColor := SrcImage.TransparentColor; FTransparentColor := SrcImage.FTransparentColor;
// -> check if already shared // -> check if already shared
if SrcImage.FSharedImage <> FSharedImage if SrcImage.FSharedImage <> FSharedImage
@ -388,9 +388,12 @@ end;
procedure TRasterImage.SetTransparentColor(AValue: TColor); procedure TRasterImage.SetTransparentColor(AValue: TColor);
begin begin
if TransparentColor = AValue then exit; if FTransparentColor = AValue then exit;
FTransparentColor := AValue; FTransparentColor := AValue;
if TransparentMode <> tmFixed then Exit;
if AValue = clDefault
then FTransparentMode := tmAuto
else FTransparentMode := tmFixed;
CreateMask; CreateMask;
end; end;
@ -473,6 +476,13 @@ begin
else Result := p^; else Result := p^;
end; end;
function TRasterImage.GetTransparentColor: TColor;
begin
if FTransparentColor = clDefault
then Result := RequestTransparentColor
else Result := FTransparentColor;
end;
procedure TRasterImage.GetSupportedSourceMimeTypes(List: TStrings); procedure TRasterImage.GetSupportedSourceMimeTypes(List: TStrings);
begin begin
if (ClassType=TBitmap) or (ClassType=TPixmap) or (ClassType=TCustomIcon) then if (ClassType=TBitmap) or (ClassType=TPixmap) or (ClassType=TCustomIcon) then
@ -673,8 +683,8 @@ begin
if (Width = 0) if (Width = 0)
or (Height = 0) or (Height = 0)
or (AColor = clNone) or (AColor = clNone)
or ( (TransparentMode = tmFixed) or ( (FTransparentMode = tmFixed)
and (TransparentColor = clNone) and (FTransparentColor = clNone)
and (AColor = clDefault) and (AColor = clDefault)
) )
then begin then begin
@ -702,8 +712,8 @@ begin
if AColor = clDefault if AColor = clDefault
then begin then begin
if (TransparentMode = tmFixed) and (TransparentColor <> clDefault) if (FTransparentMode = tmFixed) and (FTransparentColor <> clDefault)
then TransColor := ColorToRGB(TransparentColor) then TransColor := ColorToRGB(FTransparentColor)
else TransColor := FPColorToTColor(IntfImage.Colors[0, stopy]); else TransColor := FPColorToTColor(IntfImage.Colors[0, stopy]);
end end
else TransColor := ColorToRGB(AColor); else TransColor := ColorToRGB(AColor);
@ -834,6 +844,26 @@ begin
SaveToStream(Stream); SaveToStream(Stream);
end; 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); procedure TRasterImage.SetWidth(AWidth: Integer);
begin begin
SetSize(AWidth, Height); SetSize(AWidth, Height);
@ -848,7 +878,10 @@ procedure TRasterImage.SetTransparentMode(AValue: TTransparentMode);
begin begin
if AValue = TransparentMode then exit; if AValue = TransparentMode then exit;
FTransparentMode := AValue; FTransparentMode := AValue;
CreateMask;
if AValue = tmAuto
then TransparentColor := clDefault
else TransparentColor := RequestTransparentColor;
end; end;
// included by graphics.pp // included by graphics.pp