From d90075d403d50d81c3eb8a12c754a0a349f80542 Mon Sep 17 00:00:00 2001
From: paul <paul@lazarus-ide.org>
Date: Wed, 20 Aug 2008 05:28:40 +0000
Subject: [PATCH] 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 -
---
 lcl/graphics.pp             |  4 ++-
 lcl/include/rasterimage.inc | 53 ++++++++++++++++++++++++++++++-------
 2 files changed, 46 insertions(+), 11 deletions(-)

diff --git a/lcl/graphics.pp b/lcl/graphics.pp
index 0709ca0fd7..799c160ce9 100644
--- a/lcl/graphics.pp
+++ b/lcl/graphics.pp
@@ -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;
diff --git a/lcl/include/rasterimage.inc b/lcl/include/rasterimage.inc
index 9c2c437dec..081675f483 100644
--- a/lcl/include/rasterimage.inc
+++ b/lcl/include/rasterimage.inc
@@ -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