freepascal.compiler/packages/vcl-compat/src/system.imagelist.pp

{
    This file is part of the Free Pascal Run Time Library (rtl)
    Copyright (c) 2023 by the Free Pascal development team

    This file provides the base of an image list.

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}

{$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.