ExCtrls: Add unit ExImgList containing routines for creating a disabled imagelist for TToolbar.DisabledImages, and for recoloring monochrome outline icons. Based on patch by Roland Hahn.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8587 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/exctrls/source/exctrlsreg.pas

@@ -22,7 +22,7 @@ implementation
 {$R exctrlsreg.res}
 
 uses
-  ExButtons, ExCheckCtrls, ExEditCtrls, ExCombo, ExCheckCombo, ExShape; //, ExImgList;
+  ExButtons, ExCheckCtrls, ExEditCtrls, ExCombo, ExCheckCombo, ExShape;
 
 function TFloatSIPropertyEditor.GetValue: ansistring;
 begin

components/exctrls/source/eximglist.pas

@@ -0,0 +1,171 @@
+unit ExImgList;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  LCLVersion, Classes, SysUtils, Graphics, GraphUtil, Controls, ImgList;
+
+{$IF LCL_FullVersion < 2030000}
+procedure BitmapGrayscale(ABitmap: TCustomBitmap; RedFilter, GreenFilter, BlueFilter: Single);
+{$IFEND}
+
+function CreateDisabledImageList(AImageList: TCustomImageList; AOwner: TComponent): TImageList;
+
+function CreateRecoloredImageList(AImageList: TCustomImageList; ANewColor: TColor;
+  AOwner: TComponent): TImageList;
+procedure SetImageListColor(AImageList: TCustomImageList; ANewColor: TColor);
+
+implementation
+
+uses
+  fpImage, fpCanvas, IntfGraphics;
+
+{$IF LCL_FullVersion < 2030000}
+procedure BitmapGrayscale(ABitmap: TCustomBitmap; RedFilter, GreenFilter, BlueFilter: Single);
+var
+  IntfImg: TLazIntfImage = nil;
+  x, y: Integer;
+  TempColor: TFPColor;
+  Gray: Word;
+  sum: Single;
+begin
+  // Normalize filter factors to avoid word overflow.
+  sum := RedFilter + GreenFilter + BlueFilter;
+  if sum = 0.0 then
+    exit;
+  RedFilter := RedFilter / sum;
+  GreenFilter := GreenFilter / sum;
+  BlueFilter := BlueFilter / sum;
+
+  IntfImg := ABitmap.CreateIntfImage;
+  try
+    IntfImg.BeginUpdate;
+    try
+      for y := 0 to IntfImg.Height - 1 do
+        for x := 0 to IntfImg.Width - 1 do
+        begin
+          TempColor := IntfImg.Colors[x, y];
+          Gray := word(Round(TempColor.Red * RedFilter + TempColor.Green * GreenFilter + TempColor.Blue * BlueFilter));
+          TempColor.Red := Gray;
+          TempColor.Green := Gray;
+          TempColor.Blue := Gray;
+          IntfImg.Colors[x, y] := TempColor;
+        end;
+    finally
+      IntfImg.EndUpdate;
+    end;
+    ABitmap.LoadFromIntfImage(IntfImg);
+  finally
+    IntfImg.Free;
+  end;
+end;
+{$IFEND}
+
+{ Creates a new image list as copy of AImageList and converts its images to
+  grayscale. Intended to be used by TToolbar.DisabledImages. Avoids some
+  drawing artefacts in the auto-generated disabled images due to poorly
+  supported alpha channel in the built-in routines. }
+function CreateDisabledImageList(AImageList: TCustomImageList; AOwner: TComponent): TImageList;
+var
+  i: Integer;
+  bmp: TCustomBitmap;
+  Resolution: TCustomImageListResolution;
+begin
+  if AImageList = nil then
+  begin
+    Result := nil;
+    exit;
+  end;
+
+  Result := TImageList.Create(AOwner);
+  AImageList.AssignTo(Result);
+  Result.Scaled := AImageList.Scaled;
+
+  bmp := TBitmap.Create;
+  Result.BeginUpdate;
+  try
+    for i := 0 to Result.Count - 1 do
+    begin
+      for Resolution in Result.Resolutions do
+      begin
+        Resolution.GetBitmap(i, bmp);
+        BitmapGrayScale(bmp, 0.30, 0.59, 0.11);
+        Resolution.ImageList.Replace(i, bmp, nil, False);
+      end;
+    end;
+  finally
+    Result.EndUpdate;
+    bmp.Free;
+  end;
+end;
+
+{ Creates a new images list as copy of AImagelist and changes all non-transparent
+  pixels to the specified new color. Primarily useful for monochrome outline icons. }
+function CreateRecoloredImageList(AImageList: TCustomImageList; ANewColor: TColor;
+  AOwner: TComponent): TImageList;
+begin
+  Result := TImageList.Create(AOwner);
+  AImageList.AssignTo(Result);
+  Result.Scaled := AImageList.Scaled;
+  SetImagelistColor(Result, ANewColor);
+end;
+
+{ Replaces the color of all non-transparent pixels by the given new color.
+  Intended to change the color of monochrome outline icons. }
+procedure SetImageListColor(AImageList: TCustomImageList; ANewColor: TColor);
+var
+  i, x, y: Integer;
+  IntfImg: TLazIntfImage = nil;
+  newColor: TFPColor;
+  tmpColor: TFPColor;
+  bmp: TCustomBitmap;
+  Resolution: TCustomImageListResolution;
+begin
+  if AImageList = nil then
+    exit;
+
+  bmp := TBitmap.Create;
+  AImageList.BeginUpdate;
+  try
+    newColor := TColorToFPColor(ANewColor);
+    for i := 0 to AImageList.Count - 1 do
+    begin
+      for Resolution in AImageList.Resolutions do
+      begin
+        Resolution.GetBitmap(i, bmp);
+        IntfImg := bmp.CreateIntfImage;
+        try
+          IntfImg.BeginUpdate;
+          try
+            for y := 0 to IntfImg.Height - 1 do
+              for x := 0 to IntfImg.Width - 1 do
+              begin
+                tmpColor := IntfImg.Colors[x, y];
+                if tmpColor.Alpha > 0 then
+                begin
+                  tmpColor.Red := newColor.Red;
+                  tmpColor.Green := newColor.Green;
+                  tmpColor.Blue := newColor.Blue;
+                  IntfImg.Colors[x, y] := tmpColor;
+                end;
+              end;
+          finally
+            IntfImg.EndUpdate;
+          end;
+          bmp.LoadFromIntfImage(IntfImg);
+          Resolution.ImageList.Replace(i, bmp, nil, False);
+        finally
+          IntfImg.Free;
+        end;
+      end;
+    end;
+  finally
+    AImageList.EndUpdate;
+    bmp.Free;
+  end;
+end;
+
+end.
+