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. +