diff --git a/packages/vcl-compat/fpmake.pp b/packages/vcl-compat/fpmake.pp
index 1e89a36285..af7a26541d 100644
--- a/packages/vcl-compat/fpmake.pp
+++ b/packages/vcl-compat/fpmake.pp
@@ -46,6 +46,7 @@ begin
T:=P.Targets.AddUnit('system.devices.pp');
T:=P.Targets.AddUnit('system.analytics.pp');
T:=P.Targets.AddUnit('system.ansistrings.pp');
+ T:=P.Targets.AddUnit('system.imagelist.pp');
{$ifndef ALLPACKAGES}
diff --git a/packages/vcl-compat/src/system.imagelist.pp b/packages/vcl-compat/src/system.imagelist.pp
new file mode 100755
index 0000000000..bdbfd53f94
--- /dev/null
+++ b/packages/vcl-compat/src/system.imagelist.pp
@@ -0,0 +1,257 @@
+{$mode objfpc}
+{$h+}
+unit System.ImageList;
+
+interface
+
+{$IFDEF FPC_DOTTEDUNITS}
+uses
+ System.Classes, System.UITypes;
+{$ELSE}
+uses
+ Classes, System.UITypes;
+{$ENDIF}
+
+type
+ TImageLink = class;
+
+ { TBaseImageList }
+
+ TBaseImageList = class(TComponent)
+ private
+ FUpdateCount: Integer;
+ FList: TFPList;
+ FChanged: Boolean;
+ function GetLinkCount: Integer;
+ function GetLinks(const aIndex: Integer): TImageLink;
+ Procedure ClearList;
+ protected
+ procedure AddLink(aLink: TImageLink);
+ procedure DeleteLink(aLink: TImageLink);
+ function LinkContains(const aLink: TImageLink; const aStartIndex: Integer = -1): Boolean;
+ procedure DoChange; virtual; abstract;
+ function GetCount: Integer; virtual; abstract;
+ procedure Updated; override;
+ procedure Loaded; override;
+ property LinkCount: Integer read GetLinkCount;
+ property Links[aIndex: Integer]: TImageLink read GetLinks;
+ public
+ constructor Create(aOwner : TComponent); override;
+ destructor Destroy; override;
+ procedure Change; virtual;
+ procedure BeginUpdate;
+ procedure EndUpdate;
+ property Count: Integer read GetCount;
+ end;
+
+ { TImageLink }
+
+ TImageLink = class
+ private
+ FImages: TBaseImageList;
+ FImageIndex: TImageIndex;
+ FIgnoreIndex: Boolean;
+ FOnChange: TNotifyEvent;
+ FIgnoreImages: Boolean;
+ procedure SetImageList(aValue: TBaseImageList);
+ procedure SetImageIndex(aValue: TImageIndex);
+ public
+ constructor Create; virtual;
+ destructor Destroy; override;
+ procedure Change; virtual;
+ property Images: TBaseImageList read FImages write SetImageList;
+ property ImageIndex: TImageIndex read FImageIndex write SetImageIndex;
+ property IgnoreIndex: Boolean read FIgnoreIndex write FIgnoreIndex;
+ property IgnoreImages: Boolean read FIgnoreImages write FIgnoreImages;
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ end;
+
+implementation
+
+uses
+{$IFDEF FPC_DOTTEDUNITS}
+ System.SysUtils;
+{$ELSE}
+ SysUtils;
+{$ENDIF}
+
+{ TBaseImageList }
+
+function TBaseImageList.GetLinkCount: Integer;
+begin
+ Result:=FList.Count;
+end;
+
+
+function TBaseImageList.GetLinks(const aIndex: Integer): TImageLink;
+
+begin
+ Result:=TImageLink(FList[aIndex]);
+end;
+
+
+procedure TBaseImageList.AddLink(aLink: TImageLink);
+
+begin
+ if Not assigned(aLink) then
+ exit;
+ FList.Add(aLink);
+end;
+
+procedure TBaseImageList.DeleteLink(aLink: TImageLink);
+
+begin
+ if not Assigned(aLink) then
+ exit;
+ FList.Remove(aLink);
+ aLink.FImages:=Nil;
+end;
+
+
+function TBaseImageList.LinkContains(const aLink: TImageLink; const aStartIndex: Integer): Boolean;
+
+begin
+ Result:=False;
+ if (aStartIndex<0) or (aStartIndex>=LinkCount) then
+ exit;
+ Result:=FList.IndexOf(aLink)>=aStartIndex;
+end;
+
+
+procedure TBaseImageList.Updated;
+
+begin
+ inherited Updated;
+ if FChanged then
+ Change;
+end;
+
+
+procedure TBaseImageList.Loaded;
+
+begin
+ inherited Loaded;
+ if FChanged then
+ Change;
+end;
+
+
+procedure TBaseImageList.ClearList;
+
+var
+ aCount : integer;
+
+begin
+ aCount:=FList.Count-1;
+ While aCount>=0 do
+ begin
+ TImageLink(FList[aCount]).FImages:=Nil;
+ FList.Delete(aCount);
+ aCount:=FList.Count-1;
+ end;
+end;
+
+
+constructor TBaseImageList.Create(aOwner: TComponent);
+
+begin
+ inherited Create(aOwner);
+ FList:=TFPList.Create;
+end;
+
+
+destructor TBaseImageList.Destroy;
+
+begin
+ ClearList;
+ FreeAndNil(FList);
+ inherited Destroy;
+end;
+
+
+procedure TBaseImageList.Change;
+
+const
+ NoChangeStates = [csLoading,csDestroying,csUpdating];
+
+begin
+ FChanged:=True;
+ if ((ComponentState*NoChangeStates)=[]) then
+ begin
+ DoChange;
+ FChanged:=False;
+ end;
+end;
+
+
+procedure TBaseImageList.BeginUpdate;
+
+begin
+ if FUpdateCount = 0 then
+ Updating;
+ Inc(FUpdateCount);
+end;
+
+
+procedure TBaseImageList.EndUpdate;
+
+begin
+ if FUpdateCount<=0 then
+ exit;
+ Dec(FUpdateCount);
+ if FUpdateCount=0 then
+ Updated;
+end;
+
+{ TImageLink }
+
+procedure TImageLink.SetImageList(aValue: TBaseImageList);
+
+begin
+ if aValue=FImages then
+ exit;
+ if Assigned(FImages) then
+ FImages.DeleteLink(Self);
+ FImages:=aValue;
+ if Assigned(FImages) then
+ FImages.AddLink(Self);
+ if not FIgnoreImages then
+ Change;
+end;
+
+
+procedure TImageLink.SetImageIndex(aValue: TImageIndex);
+
+begin
+ if aValue=FImageIndex then
+ exit;
+ FImageIndex:=aValue;
+ If not IgnoreIndex then
+ Change;
+end;
+
+
+constructor TImageLink.Create;
+
+begin
+ FImageIndex:=-1;
+end;
+
+
+destructor TImageLink.Destroy;
+
+begin
+ Images:=Nil;
+ inherited Destroy;
+end;
+
+
+procedure TImageLink.Change;
+
+begin
+ if Assigned(FOnChange) then
+ FOnChange(FImages);
+end;
+
+
+end.
diff --git a/packages/vcl-compat/tests/testcompat.lpi b/packages/vcl-compat/tests/testcompat.lpi
index 261899dd4f..a20a97d52c 100644
--- a/packages/vcl-compat/tests/testcompat.lpi
+++ b/packages/vcl-compat/tests/testcompat.lpi
@@ -48,6 +48,10 @@
+
+
+
+
diff --git a/packages/vcl-compat/tests/testcompat.lpr b/packages/vcl-compat/tests/testcompat.lpr
index fdb42100e0..85ef5c60a6 100644
--- a/packages/vcl-compat/tests/testcompat.lpr
+++ b/packages/vcl-compat/tests/testcompat.lpr
@@ -4,7 +4,7 @@ program testcompat;
uses
{$IFDEF UNIX}cwstring,{$ENDIF}
- Classes, consoletestrunner, tcnetencoding, tciotuils, utmessagemanager, utcdevices, utcanalytics;
+ Classes, consoletestrunner, tcnetencoding, tciotuils, utmessagemanager, utcdevices, utcanalytics, utcimagelist;
type
diff --git a/packages/vcl-compat/tests/utcimagelist.pas b/packages/vcl-compat/tests/utcimagelist.pas
new file mode 100644
index 0000000000..dd1e4f78eb
--- /dev/null
+++ b/packages/vcl-compat/tests/utcimagelist.pas
@@ -0,0 +1,190 @@
+unit utcImagelist;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, fpcunit, testutils, testregistry, system.imagelist;
+
+type
+
+ { TMyImageList }
+
+ TMyImageList = class(TBaseImageList)
+ private
+ FDidChange: Boolean;
+ protected
+ procedure DoChange; override;
+ function GetCount: Integer; override;
+ Property DidChange : Boolean Read FDidChange;
+ property LinkCount;
+ property Links;
+ end;
+
+ { TestBaseImageList }
+
+ TestBaseImageList= class(TTestCase)
+ private
+ FLink1: TImageLink;
+ FLink2: TImageLink;
+ FList1: TBaseImageList;
+ FList2: TBaseImageList;
+ FLink1Change : TObject;
+ procedure FreeLink1;
+ procedure FreeLink2;
+ procedure Link1Changed(Sender: TObject);
+ protected
+ procedure SetUp; override;
+ procedure TearDown; override;
+ Property List1 : TBaseImageList Read FList1;
+ Property List2 : TBaseImageList Read FList2;
+ Property Link1 : TImageLink Read FLink1;
+ Property Link2 : TImageLink Read FLink2;
+ published
+ procedure TestHookUp;
+ procedure TestSetLink;
+ procedure TestChangeLink;
+ procedure TestSetLinkIgnoreChange;
+ procedure TestFreeList;
+ procedure TestFreeLink;
+ procedure TestSetImageIndex;
+ end;
+
+implementation
+
+{ TMyImageList }
+
+procedure TMyImageList.DoChange;
+begin
+ FDidchange:=True;
+end;
+
+function TMyImageList.GetCount: Integer;
+begin
+ Result:=0;
+end;
+
+procedure TestBaseImageList.TestHookUp;
+
+begin
+ AssertNull('No change in link 1',FLink1Change);
+ AssertNotNull('Link 1',Link1);
+ AssertNotNull('Link 2',Link2);
+ AssertNotNull('List 1',List1);
+ AssertNotNull('List 2',List1);
+end;
+
+procedure TestBaseImageList.TestSetLink;
+begin
+ Link1.Images:=List1;
+ AssertSame('Assigned link 1', List1,Link1.Images);
+ AssertEquals('Count list 1', 1, TMyImageList(List1).LinkCount);
+ AssertFalse('changed list 1', TMyImageList(List1).DidChange);
+ AssertSame('Link 1 changed',List1,FLink1Change);
+ Link2.Images:=List2;
+ AssertSame('Assigned link 2', List2,Link2.Images);
+ AssertEquals('Count list 2', 1, TMyImageList(List2).LinkCount);
+ AssertFalse('changed list 2', TMyImageList(List2).DidChange);
+end;
+
+procedure TestBaseImageList.TestChangeLink;
+begin
+ Link1.Images:=List1;
+ AssertSame('Assigned link 1', List1,Link1.Images);
+ AssertEquals('Count list 1', 1, TMyImageList(List1).LinkCount);
+ AssertFalse('changed list 1', TMyImageList(List1).DidChange);
+ Link2.Images:=List2;
+ AssertSame('Assigned link 2', List2,Link2.Images);
+ AssertEquals('Count list 2', 1, TMyImageList(List2).LinkCount);
+ AssertFalse('changed list 2', TMyImageList(List2).DidChange);
+ Link2.Images:=List1;
+ AssertSame('Assigned link 1', List1,Link1.Images);
+ AssertEquals('Count list 1', 2, TMyImageList(List1).LinkCount);
+ AssertFalse('changed list 1', TMyImageList(List1).DidChange);
+ AssertEquals('Count list 2', 0, TMyImageList(List2).LinkCount);
+ AssertFalse('changed list 2', TMyImageList(List2).DidChange);
+end;
+
+procedure TestBaseImageList.TestSetLinkIgnoreChange;
+begin
+ Link1.IgnoreImages:=True;
+ Link1.Images:=List1;
+ AssertSame('Assigned link 1', List1,Link1.Images);
+ AssertEquals('Count list 1', 1, TMyImageList(List1).LinkCount);
+ AssertFalse('changed list 1', TMyImageList(List1).DidChange);
+ AssertNull('Link 1 not changed',FLink1Change);
+end;
+
+procedure TestBaseImageList.TestFreeList;
+begin
+ Link1.Images:=List1;
+ Link2.Images:=List1;
+ FreeAndNil(Flist1);
+ AssertNull('Link 1 no images',Link1.Images);
+ AssertNull('Link 2 no images',Link2.Images);
+end;
+
+procedure TestBaseImageList.TestFreeLink;
+begin
+ Link1.Images:=List1;
+ Link2.Images:=List1;
+ FreeLink1;
+ AssertEquals('Link 1 image count',1,TMyImageList(List1).LinkCount);
+end;
+
+procedure TestBaseImageList.TestSetImageIndex;
+begin
+ Link1.Images:=List1;
+ Link1.ImageIndex:=1;
+ AssertSame('Changed',List1,FLink1Change);
+ FLink1Change:=Nil;
+ Link1.ImageIndex:=1;
+ AssertNull('Not Changed',FLink1Change);
+ Link1.IgnoreIndex:=True;
+ Link1.ImageIndex:=2;
+ AssertNull('Not Changed',FLink1Change);
+end;
+
+procedure TestBaseImageList.SetUp;
+begin
+ FList1:=TMyImageList.Create(Nil);
+ FList2:=TMyImageList.Create(Nil);
+ FLink1:=TImageLink.Create;
+ FLink1.OnChange:=@Link1Changed;
+ FLink2:=TImageLink.Create;
+ FLink1Change:=Nil;
+end;
+
+procedure TestBaseImageList.FreeLink1;
+
+begin
+ FreeAndNil(FLink1);
+end;
+
+procedure TestBaseImageList.FreeLink2;
+
+begin
+ FreeAndNil(FLink2);
+end;
+
+procedure TestBaseImageList.Link1Changed(Sender: TObject);
+begin
+ FLink1Change:=Sender;
+end;
+
+procedure TestBaseImageList.TearDown;
+begin
+ FreeLink1;
+ FreeLink2;
+ FreeAndNil(FList1);
+ FreeAndNil(FList2);
+ inherited TearDown;
+end;
+
+
+initialization
+
+ RegisterTest(TestBaseImageList);
+end.
+