Browse Source

BGRAImageList Added Indexed image reading/writing and Load/SaveFile

Massimo Magnano 10 months ago
parent
commit
32667ec980

+ 230 - 9
bgraimagelist.pas

@@ -8,10 +8,13 @@
 - Edivando S. Santos Brasil | [email protected]
 - Edivando S. Santos Brasil | [email protected]
   (Compatibility with delphi VCL 11/2018)   { #note -oMaxM : VCL Compatibility? }
   (Compatibility with delphi VCL 11/2018)   { #note -oMaxM : VCL Compatibility? }
 
 
-- Massimo Magnano 2024/12
-  Added Before/AfterDraw events (don't works with Widgetsets)
-  Added UseBGRADraw             ( " )
-  Added Proportionally add methods
+- Massimo Magnano
+ 2024/12
+   Added Before/AfterDraw events (don't works with Widgetsets)
+   Added UseBGRADraw             ( " )
+   Added Proportionally add methods
+ 2025/01
+   Added Indexed image reading/writing and Load/SaveFile
 
 
 ***************************** END CONTRIBUTOR(S) *****************************)
 ***************************** END CONTRIBUTOR(S) *****************************)
 unit BGRAImageList;
 unit BGRAImageList;
@@ -21,7 +24,7 @@ unit BGRAImageList;
 interface
 interface
 
 
 uses
 uses
-  Classes, SysUtils, {$IFDEF FPC}LResources, {$ENDIF} Controls, Graphics,
+  Classes, SysUtils, {$IFDEF FPC}LResources, LCLVersion, {$ENDIF} Controls, Graphics,
   GraphType, BGRABitmap, BGRABitmapTypes, {%H-}ImgList;
   GraphType, BGRABitmap, BGRABitmapTypes, {%H-}ImgList;
 
 
 {$IFDEF LCLgtk}
 {$IFDEF LCLgtk}
@@ -32,10 +35,32 @@ uses
   {$ENDIF}
   {$ENDIF}
 {$ENDIF}
 {$ENDIF}
 
 
+
+const
+  { #note -oMaxM : redeclared because are not public consts }
+  SIG_LAZ1 = #1#0;
+  SIG_LAZ2 = 'li';
+  SIG_LAZ3 = 'Li';
+  SIG_LAZ4 = 'Lz';
+  SIG_D3   = 'IL';
+
+  sInvalidIndex = 'Invalid ImageList Index';
+  sInvalidFormat ='Invalid Stream Format Signature';
+
 type
 type
+  TImageListSignature = array[0..1] of char; { #note -oMaxM : redeclared because is not a public type }
+
   { TBGRAImageListResolution }
   { TBGRAImageListResolution }
 
 
   TBGRAImageListResolution = class(TDragImageListResolution)
   TBGRAImageListResolution = class(TDragImageListResolution)
+  protected
+    {$if lcl_fullversion>=4990000}
+    procedure ReadData(AStream: TStream; AIndex: Integer;
+                       StartStreamPos: Int64=0; CalcPos: Boolean=True); virtual; overload;
+    procedure WriteData(AStream: TStream; AIndex: Integer;
+                       StartStreamPos: Int64=0; CalcPos: Boolean=True); virtual; overload;
+    {$endif}
+
   public
   public
     procedure BGRADraw(ACanvas: TCanvas; ARect: TRect; AIndex: Integer; AOverlay: TOverlay;
     procedure BGRADraw(ACanvas: TCanvas; ARect: TRect; AIndex: Integer; AOverlay: TOverlay;
       ADrawingStyle: TDrawingStyle; AImageType: TImageType;
       ADrawingStyle: TDrawingStyle; AImageType: TImageType;
@@ -67,7 +92,9 @@ type
     ADrawOverlay: Boolean; AOverlay: TOverlay;
     ADrawOverlay: Boolean; AOverlay: TOverlay;
     ADrawEffect: TGraphicsDrawEffect) of object;
     ADrawEffect: TGraphicsDrawEffect) of object;
 
 
+  {$if lcl_fullversion < 4990000}
   TOverlaysArray = array[TOverlay] of Integer;
   TOverlaysArray = array[TOverlay] of Integer;
+  {$endif}
 
 
   TBGRAImageList = class(TImageList)
   TBGRAImageList = class(TImageList)
   private
   private
@@ -81,9 +108,13 @@ type
     FOnBeforeDraw: TCustomImageListBeforeDraw;
     FOnBeforeDraw: TCustomImageListBeforeDraw;
     FOnAfterDraw: TCustomImageListAfterDraw;
     FOnAfterDraw: TCustomImageListAfterDraw;
 
 
+    {$if lcl_fullversion<4990000}
     { #note -oMaxM : we keep our copy of the FOverlays array since it is declared private without any logic,
     { #note -oMaxM : we keep our copy of the FOverlays array since it is declared private without any logic,
-                     so derived classes cannot use it in any way also because there is no property to read them}
+                     so derived classes cannot use it in any way also because there is no property to read them
+                     see merged code freepascal.org/lazarus/lazarus!429
+                     }
     rOverlays: TOverlaysArray;
     rOverlays: TOverlaysArray;
+    {$endif}
 
 
     function GetResolution(AImageWidth: Integer): TBGRAImageListResolution;
     function GetResolution(AImageWidth: Integer): TBGRAImageListResolution;
 
 
@@ -97,8 +128,33 @@ type
 
 
     function GetResolutionClass: TCustomImageListResolutionClass; override;
     function GetResolutionClass: TCustomImageListResolutionClass; override;
 
 
+    {$if lcl_fullversion>=4990000}
+    //Read AIndex image from Stream without read all the images
+    procedure ReadData(AStream: TStream; AIndex: Integer;
+                       StartStreamPos: Int64=0; CalcPos: Boolean=True); virtual; overload;
+    procedure WriteData(AStream: TStream); override; overload;
+    procedure WriteData(AStream: TStream; AIndex: Integer;
+                       StartStreamPos: Int64=0; CalcPos: Boolean=True); virtual; overload;
+
+    procedure LoadFromFile(const AFilename: string; AIndex: Integer;
+                       StartStreamPos: Int64=0; CalcPos: Boolean=True); overload;
+    procedure LoadFromFileUTF8(const AFilenameUTF8: string; AIndex: Integer;
+                       StartStreamPos: Int64=0; CalcPos: Boolean=True); overload;
+    procedure SaveToFile(const AFilename: string; AIndex: Integer;
+                       StartStreamPos: Int64=0; CalcPos: Boolean=True); overload;
+    procedure SaveToFileUTF8(const AFilenameUTF8: string; AIndex: Integer;
+                       StartStreamPos: Int64=0; CalcPos: Boolean=True); overload;
+    {$else}
     procedure Overlay(AIndex: Integer; AOverlay: TOverlay);
     procedure Overlay(AIndex: Integer; AOverlay: TOverlay);
 
 
+    property Overlays: TOverlaysArray read rOverlays;
+    {$endif}
+
+    procedure LoadFromFile(const AFilename: string); overload;
+    procedure LoadFromFileUTF8(const AFilenameUTF8: string); overload;
+    procedure SaveToFile(const AFilename: string); overload;
+    procedure SaveToFileUTF8(const AFilenameUTF8: string); overload;
+
     function CreateProportionalImage(AImage: TCustomBitmap;
     function CreateProportionalImage(AImage: TCustomBitmap;
                                      AHorizAlign: TAlignment; AVertAlign: TTextLayout): TBitmap; overload;
                                      AHorizAlign: TAlignment; AVertAlign: TTextLayout): TBitmap; overload;
     function CreateProportionalImage(AImageFileName: String;
     function CreateProportionalImage(AImageFileName: String;
@@ -148,7 +204,6 @@ type
                                const AllResolutions: Boolean = True;
                                const AllResolutions: Boolean = True;
                                AHorizAlign: TAlignment=taCenter; AVertAlign: TTextLayout=tlCenter); overload;
                                AHorizAlign: TAlignment=taCenter; AVertAlign: TTextLayout=tlCenter); overload;
 
 
-    property Overlays: TOverlaysArray read rOverlays;
 
 
   published
   published
     property UseBGRADraw: Boolean read rUseBGRADraw write SetUseBGRADraw;
     property UseBGRADraw: Boolean read rUseBGRADraw write SetUseBGRADraw;
@@ -163,6 +218,8 @@ type
 
 
 implementation
 implementation
 
 
+uses BGRAUTF8, WSImgList;
+
 const
 const
   EffectMap: array[Boolean] of TGraphicsDrawEffect = (
   EffectMap: array[Boolean] of TGraphicsDrawEffect = (
     gdeDisabled,
     gdeDisabled,
@@ -178,6 +235,74 @@ end;
 
 
 { TBGRAImageListResolution }
 { TBGRAImageListResolution }
 
 
+{$if lcl_fullversion>=4990000}
+procedure TBGRAImageListResolution.ReadData(AStream: TStream; AIndex: Integer;
+  StartStreamPos: Int64; CalcPos: Boolean);
+var
+   oStreamPos: Int64;
+   Signature: TImageListSignature;
+   datPos: Integer;
+
+begin
+  if (AIndex<0) or (AIndex>=Count) then raise EInvalidOperation.Create(SInvalidIndex);
+
+  oStreamPos:= AStream.Position;
+  try
+     AStream.Position:= StartStreamPos;
+     datPos:= AIndex * Width * Height;
+     if CalcPos
+     then begin
+            AStream.Read(Signature, SizeOf(Signature));
+            if Signature = SIG_LAZ3
+            then begin
+                   AStream.Position:= oStreamPos+SizeOf(Signature)+(3*4)+(datPos*SizeOf(FData[0]));
+                   AStream.Read(FData[datPos], Width * Height * SizeOf(FData[0]));
+                 end
+            else raise Exception.Create(sInvalidFormat+' '+Signature);
+          end
+     else AStream.Read(FData[datPos], Width * Height * SizeOf(FData[0]));
+
+     if HandleAllocated
+     then TWSCustomImageListResolutionClass(WidgetSetClass).Replace(Self, AIndex, @FData[datPos]);
+
+   finally
+     AStream.Position:= oStreamPos;
+   end;
+end;
+
+procedure TBGRAImageListResolution.WriteData(AStream: TStream; AIndex: Integer;
+  StartStreamPos: Int64; CalcPos: Boolean);
+var
+   oStreamPos: Int64;
+   Signature: TImageListSignature;
+   datPos: Integer;
+
+begin
+  if (AIndex<0) or (AIndex>=Count) then raise EInvalidOperation.Create(SInvalidIndex);
+
+  oStreamPos:= AStream.Position;
+  try
+     AStream.Position:= StartStreamPos;
+     datPos:= AIndex * Width * Height;
+     if CalcPos
+     then begin
+            AStream.Read(Signature, SizeOf(Signature));
+            if Signature = SIG_LAZ3
+            then begin
+                   WriteLRSInteger(AStream, Count);
+                   AStream.Position:= oStreamPos+SizeOf(Signature)+(3*4)+(datPos*SizeOf(FData[0]));
+                   AStream.Write(FData[datPos], Width * Height * SizeOf(FData[0]));
+                 end
+            else raise Exception.Create(sInvalidFormat+' '+Signature);
+          end
+     else AStream.Write(FData[datPos], Width * Height * SizeOf(FData[0]));
+
+   finally
+     AStream.Position:= oStreamPos;
+   end;
+end;
+{$endif}
+
 { Problem with no alpha is only on GTK so on Windows we use default drawing }
 { Problem with no alpha is only on GTK so on Windows we use default drawing }
 procedure TBGRAImageListResolution.BGRADraw(ACanvas: TCanvas; ARect: TRect; AIndex: Integer; AOverlay: TOverlay;
 procedure TBGRAImageListResolution.BGRADraw(ACanvas: TCanvas; ARect: TRect; AIndex: Integer; AOverlay: TOverlay;
                            ADrawingStyle: TDrawingStyle; AImageType: TImageType;
                            ADrawingStyle: TDrawingStyle; AImageType: TImageType;
@@ -209,7 +334,7 @@ begin
 
 
     if (AOverlay > 0) then
     if (AOverlay > 0) then
     begin
     begin
-      OverlayI := rOverlays[AOverlay];
+      OverlayI := Overlays[AOverlay];
       if (OverlayI in [0..Count-1]) then
       if (OverlayI in [0..Count-1]) then
       begin
       begin
        {$IFDEF FPC}
        {$IFDEF FPC}
@@ -392,7 +517,7 @@ begin
 
 
                   if vDrawOverlay and (vOverlay > 0) then
                   if vDrawOverlay and (vOverlay > 0) then
                   begin
                   begin
-                    OverlayI := rImageList.rOverlays[vOverlay];
+                    OverlayI := rImageList.Overlays[vOverlay];
                     {$IFDEF FPC}
                     {$IFDEF FPC}
                       GetBitmap(OverlayI, Bmp, vDrawEffect);
                       GetBitmap(OverlayI, Bmp, vDrawEffect);
                     {$ELSE}
                     {$ELSE}
@@ -601,11 +726,107 @@ begin
   Result := TBGRAImageListResolution;
   Result := TBGRAImageListResolution;
 end;
 end;
 
 
+procedure TBGRAImageList.LoadFromFile(const AFilename: string);
+begin
+  LoadFromFileUTF8(SysToUtf8(AFilename));
+end;
+
+procedure TBGRAImageList.LoadFromFileUTF8(const AFilenameUTF8: string);
+var
+   stream: TFileStreamUTF8;
+
+begin
+  stream := TFileStreamUTF8.Create(AFilenameUTF8, fmOpenRead or fmShareDenyWrite);
+  try
+     ReadData(stream);
+  finally
+    stream.Free;
+  end;
+end;
+
+procedure TBGRAImageList.SaveToFile(const AFilename: string);
+begin
+  SaveToFileUTF8(SysToUtf8(AFilename));
+end;
+
+procedure TBGRAImageList.SaveToFileUTF8(const AFilenameUTF8: string);
+var
+  stream: TFileStreamUTF8;
+begin
+   stream := TFileStreamUTF8.Create(AFilenameUTF8, fmCreate);
+   try
+     WriteData(stream);
+   finally
+     stream.Free;
+   end;
+end;
+
+{$if lcl_fullversion>=4990000}
+procedure TBGRAImageList.ReadData(AStream: TStream; AIndex: Integer;
+  StartStreamPos: Int64; CalcPos: Boolean);
+begin
+  GetResolution(Width).ReadData(AStream, AIndex, StartStreamPos, CalcPos);
+end;
+
+procedure TBGRAImageList.WriteData(AStream: TStream);
+begin
+  if (csDesigning in ComponentState)
+  then inherited WriteData(AStream)
+  else GetResolution(Width).WriteData(AStream, False); // don't compress data so we can write the image n without rewriting everything.
+end;
+
+procedure TBGRAImageList.WriteData(AStream: TStream; AIndex: Integer;
+  StartStreamPos: Int64; CalcPos: Boolean);
+begin
+  GetResolution(Width).WriteData(AStream, AIndex, StartStreamPos, CalcPos);
+end;
+
+procedure TBGRAImageList.LoadFromFile(const AFilename: string; AIndex: Integer;
+  StartStreamPos: Int64; CalcPos: Boolean);
+begin
+  LoadFromFileUTF8(SysToUtf8(AFilename), AIndex, StartStreamPos, CalcPos);
+end;
+
+procedure TBGRAImageList.LoadFromFileUTF8(const AFilenameUTF8: string; AIndex: Integer;
+  StartStreamPos: Int64; CalcPos: Boolean);
+var
+   stream: TFileStreamUTF8;
+
+begin
+  stream := TFileStreamUTF8.Create(AFilenameUTF8, fmOpenRead or fmShareDenyWrite);
+  try
+     ReadData(stream, AIndex, StartStreamPos, CalcPos);
+  finally
+    stream.Free;
+  end;
+end;
+
+procedure TBGRAImageList.SaveToFile(const AFilename: string; AIndex: Integer;
+  StartStreamPos: Int64; CalcPos: Boolean);
+begin
+  SaveToFileUTF8(SysToUtf8(AFilename), AIndex, StartStreamPos, CalcPos);
+end;
+
+procedure TBGRAImageList.SaveToFileUTF8(const AFilenameUTF8: string; AIndex: Integer;
+  StartStreamPos: Int64; CalcPos: Boolean);
+var
+  stream: TFileStreamUTF8;
+begin
+   stream := TFileStreamUTF8.Create(AFilenameUTF8, fmOpenReadWrite);
+   try
+     WriteData(stream, AIndex, StartStreamPos, CalcPos);
+   finally
+     stream.Free;
+   end;
+end;
+
+{$else}
 procedure TBGRAImageList.Overlay(AIndex: Integer; AOverlay: TOverlay);
 procedure TBGRAImageList.Overlay(AIndex: Integer; AOverlay: TOverlay);
 begin
 begin
   TImageList(Self).Overlay(AIndex, AOverlay);
   TImageList(Self).Overlay(AIndex, AOverlay);
   rOverlays[AOverlay] := AIndex;
   rOverlays[AOverlay] := AIndex;
 end;
 end;
+{$endif}
 
 
 procedure TBGRAImageList.StretchDrawOverlay(ACanvas: TCanvas; AIndex: Integer; ARect: TRect; AOverlay: TOverlay;
 procedure TBGRAImageList.StretchDrawOverlay(ACanvas: TCanvas; AIndex: Integer; ARect: TRect; AOverlay: TOverlay;
   AEnabled: Boolean);
   AEnabled: Boolean);

+ 133 - 68
test/test_bgraimagelist/test_BGRAImgList_m.lfm

@@ -1,28 +1,29 @@
 object Form1: TForm1
 object Form1: TForm1
   Left = 336
   Left = 336
-  Height = 420
+  Height = 554
   Top = 157
   Top = 157
-  Width = 711
+  Width = 889
   Caption = 'Form1'
   Caption = 'Form1'
-  ClientHeight = 420
-  ClientWidth = 711
+  ClientHeight = 554
+  ClientWidth = 889
+  DesignTimePPI = 120
   Menu = MainMenu1
   Menu = MainMenu1
-  LCLVersion = '3.99.0.0'
+  LCLVersion = '4.99.0.0'
   OnCreate = FormCreate
   OnCreate = FormCreate
   object btStretchDraw: TButton
   object btStretchDraw: TButton
-    Left = 189
-    Height = 25
+    Left = 236
+    Height = 31
     Top = 0
     Top = 0
-    Width = 75
+    Width = 94
     Caption = 'Stretch Draw'
     Caption = 'Stretch Draw'
     TabOrder = 0
     TabOrder = 0
     OnClick = btStretchDrawClick
     OnClick = btStretchDrawClick
   end
   end
   object DrawGrid1: TDrawGrid
   object DrawGrid1: TDrawGrid
-    Left = 8
-    Height = 120
-    Top = 48
-    Width = 280
+    Left = 10
+    Height = 150
+    Top = 60
+    Width = 350
     ColCount = 4
     ColCount = 4
     Columns = <    
     Columns = <    
       item
       item
@@ -42,37 +43,37 @@ object Form1: TForm1
     TitleImageList = ImageList1
     TitleImageList = ImageList1
   end
   end
   object cbIndexDraw: TCheckBox
   object cbIndexDraw: TCheckBox
-    Left = 104
-    Height = 19
+    Left = 130
+    Height = 24
     Top = 0
     Top = 0
-    Width = 72
+    Width = 89
     Caption = 'Add Index'
     Caption = 'Add Index'
     TabOrder = 2
     TabOrder = 2
     OnChange = cbIndexDrawChange
     OnChange = cbIndexDrawChange
   end
   end
   object Panel1: TPanel
   object Panel1: TPanel
-    Left = 297
-    Height = 160
+    Left = 371
+    Height = 200
     Top = 0
     Top = 0
-    Width = 160
+    Width = 200
     BevelOuter = bvNone
     BevelOuter = bvNone
     Caption = 'Panel1'
     Caption = 'Panel1'
     TabOrder = 3
     TabOrder = 3
   end
   end
   object cbOverlay: TCheckBox
   object cbOverlay: TCheckBox
-    Left = 8
-    Height = 19
+    Left = 10
+    Height = 24
     Top = 0
     Top = 0
-    Width = 83
+    Width = 103
     Caption = 'Add Overlay'
     Caption = 'Add Overlay'
     TabOrder = 4
     TabOrder = 4
     OnChange = cbIndexDrawChange
     OnChange = cbIndexDrawChange
   end
   end
   object cbBGRADraw: TCheckBox
   object cbBGRADraw: TCheckBox
-    Left = 8
-    Height = 19
-    Top = 24
-    Width = 78
+    Left = 10
+    Height = 24
+    Top = 30
+    Width = 98
     Caption = 'BGRA Draw'
     Caption = 'BGRA Draw'
     Checked = True
     Checked = True
     State = cbChecked
     State = cbChecked
@@ -81,9 +82,9 @@ object Form1: TForm1
   end
   end
   object lvCaptured: TListView
   object lvCaptured: TListView
     Left = 0
     Left = 0
-    Height = 178
-    Top = 242
-    Width = 711
+    Height = 222
+    Top = 332
+    Width = 889
     Align = alBottom
     Align = alBottom
     AutoSort = False
     AutoSort = False
     Columns = <>
     Columns = <>
@@ -99,19 +100,19 @@ object Form1: TForm1
     ViewStyle = vsIcon
     ViewStyle = vsIcon
   end
   end
   object btAddThumb: TButton
   object btAddThumb: TButton
-    Left = 189
-    Height = 25
-    Top = 176
-    Width = 123
+    Left = 232
+    Height = 31
+    Top = 220
+    Width = 140
     Caption = 'Add Thumb File'
     Caption = 'Add Thumb File'
     TabOrder = 7
     TabOrder = 7
     OnClick = btAddThumbClick
     OnClick = btAddThumbClick
   end
   end
   object rgHorizontal: TRadioGroup
   object rgHorizontal: TRadioGroup
-    Left = 8
-    Height = 33
-    Top = 168
-    Width = 177
+    Left = 10
+    Height = 41
+    Top = 210
+    Width = 221
     AutoFill = True
     AutoFill = True
     Caption = 'Horizontal Align'
     Caption = 'Horizontal Align'
     ChildSizing.LeftRightSpacing = 6
     ChildSizing.LeftRightSpacing = 6
@@ -121,8 +122,8 @@ object Form1: TForm1
     ChildSizing.ShrinkVertical = crsScaleChilds
     ChildSizing.ShrinkVertical = crsScaleChilds
     ChildSizing.Layout = cclLeftToRightThenTopToBottom
     ChildSizing.Layout = cclLeftToRightThenTopToBottom
     ChildSizing.ControlsPerLine = 3
     ChildSizing.ControlsPerLine = 3
-    ClientHeight = 13
-    ClientWidth = 173
+    ClientHeight = 16
+    ClientWidth = 217
     Columns = 3
     Columns = 3
     ItemIndex = 2
     ItemIndex = 2
     Items.Strings = (
     Items.Strings = (
@@ -133,10 +134,10 @@ object Form1: TForm1
     TabOrder = 8
     TabOrder = 8
   end
   end
   object rgVertical: TRadioGroup
   object rgVertical: TRadioGroup
-    Left = 8
-    Height = 33
-    Top = 202
-    Width = 177
+    Left = 10
+    Height = 41
+    Top = 252
+    Width = 221
     AutoFill = True
     AutoFill = True
     Caption = 'Vertical Align'
     Caption = 'Vertical Align'
     ChildSizing.LeftRightSpacing = 6
     ChildSizing.LeftRightSpacing = 6
@@ -146,8 +147,8 @@ object Form1: TForm1
     ChildSizing.ShrinkVertical = crsScaleChilds
     ChildSizing.ShrinkVertical = crsScaleChilds
     ChildSizing.Layout = cclLeftToRightThenTopToBottom
     ChildSizing.Layout = cclLeftToRightThenTopToBottom
     ChildSizing.ControlsPerLine = 3
     ChildSizing.ControlsPerLine = 3
-    ClientHeight = 13
-    ClientWidth = 173
+    ClientHeight = 16
+    ClientWidth = 217
     Columns = 3
     Columns = 3
     ItemIndex = 1
     ItemIndex = 1
     Items.Strings = (
     Items.Strings = (
@@ -158,34 +159,34 @@ object Form1: TForm1
     TabOrder = 9
     TabOrder = 9
   end
   end
   object btAddThumbCol: TButton
   object btAddThumbCol: TButton
-    Left = 189
-    Height = 25
-    Top = 208
-    Width = 123
+    Left = 376
+    Height = 31
+    Top = 220
+    Width = 176
     Caption = 'Add Thumb File Color'
     Caption = 'Add Thumb File Color'
     TabOrder = 10
     TabOrder = 10
     OnClick = btAddThumbClick
     OnClick = btAddThumbClick
   end
   end
   object ColorBox1: TColorBox
   object ColorBox1: TColorBox
-    Left = 320
-    Height = 22
-    Top = 208
-    Width = 100
+    Left = 376
+    Height = 26
+    Top = 296
+    Width = 125
     Selected = clFuchsia
     Selected = clFuchsia
-    ItemHeight = 16
+    ItemHeight = 20
     TabOrder = 11
     TabOrder = 11
   end
   end
   object Button1: TButton
   object Button1: TButton
-    Left = 320
-    Height = 25
-    Top = 176
-    Width = 75
+    Left = 824
+    Height = 31
+    Top = 208
+    Width = 50
     Caption = 'Tests'
     Caption = 'Tests'
     TabOrder = 12
     TabOrder = 12
     OnClick = Button1Click
     OnClick = Button1Click
   end
   end
   object Image1: TImage
   object Image1: TImage
-    Left = 464
+    Left = 580
     Height = 240
     Height = 240
     Top = 0
     Top = 0
     Width = 240
     Width = 240
@@ -193,12 +194,66 @@ object Form1: TForm1
     Proportional = True
     Proportional = True
     Transparent = True
     Transparent = True
   end
   end
+  object btReadData: TButton
+    Left = 568
+    Height = 31
+    Top = 260
+    Width = 72
+    Caption = 'Read All'
+    TabOrder = 13
+    OnClick = btReadDataClick
+  end
+  object btWriteData: TButton
+    Left = 640
+    Height = 31
+    Top = 260
+    Width = 72
+    Caption = 'Write All'
+    TabOrder = 14
+    OnClick = btWriteDataClick
+  end
+  object btReadSel: TButton
+    Left = 720
+    Height = 31
+    Top = 260
+    Width = 72
+    Caption = 'Read Sel.'
+    TabOrder = 15
+    OnClick = btReadSelClick
+  end
+  object btWriteSel: TButton
+    Left = 792
+    Height = 31
+    Top = 260
+    Width = 72
+    Caption = 'Write Sel.'
+    TabOrder = 16
+    OnClick = btWriteSelClick
+  end
+  object btChangeThumb: TButton
+    Left = 232
+    Height = 31
+    Top = 256
+    Width = 140
+    Caption = 'Change Thumb File'
+    TabOrder = 17
+    OnClick = btChangeThumbClick
+  end
+  object btChangeThumbCol: TButton
+    Left = 376
+    Height = 31
+    Top = 256
+    Width = 176
+    Caption = 'Change Thumb File Color'
+    TabOrder = 18
+    OnClick = btChangeThumbClick
+  end
   object ImageList1: TBGRAImageList
   object ImageList1: TBGRAImageList
     UseBGRADraw = True
     UseBGRADraw = True
     OnBeforeDraw = ImageList1BeforeDraw
     OnBeforeDraw = ImageList1BeforeDraw
     OnAfterDraw = ImageList1AfterDraw
     OnAfterDraw = ImageList1AfterDraw
-    Left = 472
-    Top = 144
+    Left = 590
+    Top = 180
     Bitmap = {
     Bitmap = {
       4C7A070000001000000010000000070C00000000000078DAED970754546716C7
       4C7A070000001000000010000000070C00000000000078DAED970754546716C7
       EF7B0F468A0541372A8A48119881418A4A51A94315446063B06C846862140C12
       EF7B0F468A0541372A8A48119881418A4A51A94315446063B06C846862140C12
@@ -301,8 +356,8 @@ object Form1: TForm1
   end
   end
   object MainMenu1: TMainMenu
   object MainMenu1: TMainMenu
     Images = ImageList1
     Images = ImageList1
-    Left = 428
-    Top = 8
+    Left = 535
+    Top = 10
     object MenuItem1: TMenuItem
     object MenuItem1: TMenuItem
       Caption = 'MenuItem1'
       Caption = 'MenuItem1'
       ImageIndex = 0
       ImageIndex = 0
@@ -321,17 +376,27 @@ object Form1: TForm1
     Height = 132
     Height = 132
     Width = 132
     Width = 132
     UseBGRADraw = False
     UseBGRADraw = False
-    Left = 472
-    Top = 96
+    Left = 590
+    Top = 120
   end
   end
   object OpenPictDialog: TOpenPictureDialog
   object OpenPictDialog: TOpenPictureDialog
-    Left = 472
-    Top = 48
+    Left = 590
+    Top = 60
   end
   end
   object ImageList2: TImageList
   object ImageList2: TImageList
     Height = 132
     Height = 132
     Width = 132
     Width = 132
-    Left = 480
-    Top = 8
+    Left = 600
+    Top = 10
+  end
+  object OpenDialog1: TOpenDialog
+    Filter = 'All Files (*.*)|*.*|Img File (*.img)|*.img'
+    Left = 702
+    Top = 60
+  end
+  object SaveDialog1: TSaveDialog
+    Filter = 'All Files (*.*)|*.*|Img File (*.img)|*.img'
+    Left = 792
+    Top = 64
   end
   end
 end
 end

+ 119 - 1
test/test_bgraimagelist/test_BGRAImgList_m.pas

@@ -6,7 +6,7 @@ interface
 
 
 uses
 uses
   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Menus, ComCtrls, StdCtrls, Grids, ColorBox, CheckLst,
   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Menus, ComCtrls, StdCtrls, Grids, ColorBox, CheckLst,
-  ExtCtrls, GraphType, ImgList, ExtDlgs, BGRAImageList;
+  ExtCtrls, GraphType, ImgList, ExtDlgs, BGRAImageList, LCLVersion;
 
 
 type
 type
 
 
@@ -14,8 +14,14 @@ type
 
 
   TForm1 = class(TForm)
   TForm1 = class(TForm)
     btAddThumb: TButton;
     btAddThumb: TButton;
+    btChangeThumbCol: TButton;
+    btChangeThumb: TButton;
     btAddThumbCol: TButton;
     btAddThumbCol: TButton;
+    btReadSel: TButton;
+    btWriteData: TButton;
+    btWriteSel: TButton;
     Button1: TButton;
     Button1: TButton;
+    btReadData: TButton;
     ColorBox1: TColorBox;
     ColorBox1: TColorBox;
     Image1: TImage;
     Image1: TImage;
     ImageList2: TImageList;
     ImageList2: TImageList;
@@ -31,12 +37,19 @@ type
     MenuItem1: TMenuItem;
     MenuItem1: TMenuItem;
     MenuItem2: TMenuItem;
     MenuItem2: TMenuItem;
     MenuItem3: TMenuItem;
     MenuItem3: TMenuItem;
+    OpenDialog1: TOpenDialog;
     OpenPictDialog: TOpenPictureDialog;
     OpenPictDialog: TOpenPictureDialog;
     Panel1: TPanel;
     Panel1: TPanel;
     rgHorizontal: TRadioGroup;
     rgHorizontal: TRadioGroup;
     rgVertical: TRadioGroup;
     rgVertical: TRadioGroup;
+    SaveDialog1: TSaveDialog;
     procedure btAddThumbClick(Sender: TObject);
     procedure btAddThumbClick(Sender: TObject);
+    procedure btChangeThumbClick(Sender: TObject);
+    procedure btReadDataClick(Sender: TObject);
+    procedure btReadSelClick(Sender: TObject);
     procedure btStretchDrawClick(Sender: TObject);
     procedure btStretchDrawClick(Sender: TObject);
+    procedure btWriteDataClick(Sender: TObject);
+    procedure btWriteSelClick(Sender: TObject);
     procedure Button1Click(Sender: TObject);
     procedure Button1Click(Sender: TObject);
     procedure cbBGRADrawChange(Sender: TObject);
     procedure cbBGRADrawChange(Sender: TObject);
     procedure cbIndexDrawChange(Sender: TObject);
     procedure cbIndexDrawChange(Sender: TObject);
@@ -48,6 +61,7 @@ type
       var ADrawingStyle: TDrawingStyle; var AImageType: TImageType; var ADrawOverlay: Boolean; var AOverlay: TOverlay;
       var ADrawingStyle: TDrawingStyle; var AImageType: TImageType; var ADrawOverlay: Boolean; var AOverlay: TOverlay;
       var ADrawEffect: TGraphicsDrawEffect): Boolean;
       var ADrawEffect: TGraphicsDrawEffect): Boolean;
   private
   private
+     procedure LoadImgList(AFileName: String);
 
 
   public
   public
 
 
@@ -138,6 +152,81 @@ begin
   end;
   end;
 end;
 end;
 
 
+procedure TForm1.btChangeThumbClick(Sender: TObject);
+var
+   newItem: TListItem;
+   newImgI: Integer;
+   newBmp: TBitmap;
+
+begin
+  if (lvCaptured.Selected<>nil) and OpenPictDialog.Execute then
+  try
+    newImgI:= lvCaptured.Selected.ImageIndex;
+
+    if (Sender=btChangeThumbCol)
+    then imgListThumbs.ReplaceMaskedProportionally(newImgI, OpenPictDialog.FileName, ColorBox1.Selected, True,
+                                              TAlignment(rgHorizontal.ItemIndex),
+                                              TTextLayout(rgVertical.ItemIndex))
+    else imgListThumbs.ReplaceProportionally(newImgI, OpenPictDialog.FileName, '', True,
+                                              TAlignment(rgHorizontal.ItemIndex),
+                                              TTextLayout(rgVertical.ItemIndex));
+
+    lvCaptured.Selected.Caption:= ExtractFileName(OpenPictDialog.FileName);
+
+    newBmp:= TBitmap.Create;
+    imgListThumbs.GetBitmap(newImgI, newBmp);
+    Image1.Picture.Assign(newBmp);
+
+  finally
+    newBmp.Free;
+  end;
+end;
+
+procedure TForm1.btReadDataClick(Sender: TObject);
+begin
+  if OpenDialog1.Execute then
+  begin
+    LoadImgList(OpenDialog1.FileName);
+    lvCaptured.Invalidate;
+  end;
+end;
+
+procedure TForm1.btReadSelClick(Sender: TObject);
+var
+   oCap: String;
+
+begin
+  {$if lcl_fullversion>=4990000}
+  if (lvCaptured.Selected<>nil) and OpenDialog1.Execute then
+  begin
+    imgListThumbs.LoadFromFile(OpenDialog1.FileName, lvCaptured.Selected.ImageIndex);
+
+    //Is the only way to Update the Image?
+    oCap:=lvCaptured.Selected.Caption;
+    lvCaptured.Selected.Caption:='';
+    lvCaptured.Selected.Caption:=oCap;
+  end;
+  {$endif}
+end;
+
+procedure TForm1.btWriteDataClick(Sender: TObject);
+begin
+  if SaveDialog1.Execute then
+  begin
+    imgListThumbs.SaveToFile(SaveDialog1.FileName);
+  end;
+end;
+
+procedure TForm1.btWriteSelClick(Sender: TObject);
+begin
+  {$if lcl_fullversion>=4990000}
+  if (lvCaptured.Selected<>nil) and SaveDialog1.Execute then
+  begin
+    imgListThumbs.SaveToFile(SaveDialog1.FileName, lvCaptured.Selected.ImageIndex);
+  end;
+  {$endif}
+end;
+
 procedure TForm1.cbBGRADrawChange(Sender: TObject);
 procedure TForm1.cbBGRADrawChange(Sender: TObject);
 begin
 begin
   ImageList1.UseBGRADraw:= cbBGRADraw.Checked;
   ImageList1.UseBGRADraw:= cbBGRADraw.Checked;
@@ -155,6 +244,7 @@ begin
   ImageList1.Overlay(4, 2);
   ImageList1.Overlay(4, 2);
   ImageList1.Overlay(5, 3);
   ImageList1.Overlay(5, 3);
   ImageList1.Overlay(6, 4);
   ImageList1.Overlay(6, 4);
+  LoadImgList('c:\tmp\imgList_o.img');
 end;
 end;
 
 
 procedure TForm1.ImageList1AfterDraw(Sender: TBGRAImageList; ACanvas: TCanvas; ARect: TRect; AIndex: Integer;
 procedure TForm1.ImageList1AfterDraw(Sender: TBGRAImageList; ACanvas: TCanvas; ARect: TRect; AIndex: Integer;
@@ -187,5 +277,33 @@ begin
   Result:= True;
   Result:= True;
 end;
 end;
 
 
+procedure TForm1.LoadImgList(AFileName: String);
+var
+   newItem: TListItem;
+   i, k, t: Integer;
+
+begin
+//    lvCaptured.BeginUpdate;
+
+    imgListThumbs.LoadFromFile(AFileName);
+
+    if (lvCaptured.Items.Count<imgListThumbs.Count) then
+    begin
+      k:= lvCaptured.Items.Count;
+      t:= imgListThumbs.Count;
+
+      for i:=k to t-1 do
+      begin
+        newItem:= lvCaptured.Items.Add;
+        newItem.Caption:= ExtractFileName(OpenDialog1.FileName+' ('+IntToStr(i)+')');
+        newItem.ImageIndex:= i;
+      end;
+    end;
+
+//    lvCaptured.EndUpdate;
+//    lvCaptured.Invalidate;
+end;
+
+
 end.
 end.