path: root/src/corelib/fpg_imagelist.pas

{
    fpGUI  -  Free Pascal GUI Toolkit

    Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this
    distribution, for details of the copyright.

    See the file COPYING.modifiedLGPL, included in this distribution,
    for details about redistributing fpGUI.

    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.

    Description:

      A basic image list component for use by the GUI components like the
      treeview etc.
}

unit fpg_imagelist;

{$mode objfpc}{$H+}

{.$define DEBUG}

interface

uses
  Classes,
  SysUtils,
  fpg_base,
  fpg_main;
  
type

  EItemExists = class(Exception);

  TfpgImageList = class;  // forward declaration
  

  TfpgImageItem = class(TObject)
  private
    FImage: TfpgImage;
    FIndex: integer;
    FImageList: TfpgImageList;
    procedure   SetImageList(AImageList: TfpgImageList);
    procedure   SetIndex(AIndex: integer);
    procedure   SetImage(AImage: TfpgImage);
  public
    constructor Create; overload;
    constructor Create(AImageList: TfpgImageList; AIndex: integer; AImage: TfpgImage); overload;
    constructor Create(AFileName: TfpgString; AIndex: integer); overload;
    destructor  Destroy; override;
    property    Index: integer read FIndex write SetIndex;
    property    Image: TfpgImage read FImage write SetImage;
    property    ImageList: TfpgImageList read FImageList write SetImageList;
    procedure   LoadFromFile(AFileName: TfpgString);
  end;


  TfpgImageList = class(TObject)
  private
    FList: TList;
    function    GetFListIndex(AIndex: Integer): Integer;
    function    GetItem(AIndex: integer): TfpgImageItem;
    procedure   SetItem(AIndex: integer; AItem: TfpgImageItem);
    function    GetCount: integer;
  public
    constructor Create;
    destructor  Destroy; override;
    procedure   AddItemFromFile(AFileName: TfpgString; AIndex: integer = -1);
    procedure   AddImage(AImage: TfpgImage; AIndex: integer = -1);
    procedure   RemoveIndex(AIndex: integer);
    function    GetMaxItem: integer;
    procedure   Clear;
    property    Items[AIndex: integer]: TfpgImageItem read GetItem write SetItem; default;
    property    Count: integer read GetCount;
  end;

  

implementation

uses
  fpg_imgfmt_bmp,
  fpg_utils;

{ TfpgImageList }

function TfpgImageList.GetFListIndex(AIndex: Integer): Integer;
var
  i: integer;
begin
  {$IFDEF DEBUG}
  writeln('TfpgImageList.GetFListIndex');
  {$ENDIF}
  result := -1;
  for i := 0 to FList.Count - 1 do
    if TfpgImageItem(FList[i]).Index = AIndex then
    begin
      result := i;
      Break;  //==>
    end;
end;

function TfpgImageList.GetItem(AIndex: integer): TfpgImageItem;
var
  AFindIndex: integer;
begin
  {$IFDEF DEBUG}
  writeln('TfpgImageList.GetItem');
  {$ENDIF}
  result := nil;
  AFindIndex := GetFListIndex(AIndex);
  if AFindIndex > -1 then
    result := TfpgImageItem(FList[AFindIndex]);
end;

procedure TfpgImageList.SetItem(AIndex: integer; AItem: TfpgImageItem);
begin
  if AItem = nil then
    Exit; //==>
    
  if GetItem(AIndex) = AItem then
    Exit; //==>
    
  RemoveIndex(AIndex);      // delete existing Item
  AItem.Index := AIndex;
  FList.Add(AItem);
end;

function TfpgImageList.GetCount: integer;
begin
  Result := FList.Count;
end;

constructor TfpgImageList.Create;
begin
  FList := TList.Create;
end;

destructor TfpgImageList.Destroy;
var
  i: integer;
begin
  for i := FList.Count-1 downto 0 do
    TfpgImageItem(FList[i]).Destroy;  // frees images
  FList.Destroy;
  inherited Destroy
end;

procedure TfpgImageList.AddItemFromFile(AFileName: TfpgString; AIndex: integer);
var
  AImageItem: TfpgImageItem;
begin
  {$IFDEF DEBUG}
  writeln('TfpgImageList.AddItemFromFile');
  {$ENDIF}
  
  if not fpgFileExists(AFileName) then
    Exit; //==>
  
  AImageItem := TfpgImageItem.Create;
  AImageItem.LoadFromFile(AFileName);
  if AIndex > -1 then
    Items[AIndex] := AImageItem
  else
  begin
    FList.Add(AImageItem);
    AImageItem.Index := GetMaxItem+1;
  end;
end;

procedure TfpgImageList.AddImage(AImage: TfpgImage; AIndex: integer);
var
  AImageItem: TfpgImageItem;
begin
  AImageItem := TfpgImageItem.Create;
  AImageItem.Image := AImage;
  if AIndex > -1 then
    Items[AIndex] := AImageItem
  else
  begin
    FList.Add(AImageItem);
    AImageItem.Index := GetMaxItem+1;
  end;
end;

procedure TfpgImageList.RemoveIndex(AIndex: integer);
begin
  {$IFDEF DEBUG}
  writeln('TfpgImageList.RemoveIndex');
  {$ENDIF}
  AIndex := GetFListIndex(AIndex);
  if AIndex <> -1 then
  begin
    TfpgImageItem(FList[AIndex]).Destroy;
    FList.Delete(AIndex);
  end;
end;

function TfpgImageList.GetMaxItem: integer;
var
  i: integer;
begin
  result := -1;
  for i := 0 to FList.Count - 1 do
    if TfpgImageItem(FList[i]).Index > result then
      result := TfpgImageItem(FList[i]).Index;
end;

procedure TfpgImageList.Clear;
begin
  FList.Clear;
end;

{ TfpgImageItem }

procedure TfpgImageItem.SetImageList(AImageList: TfpgImageList);
begin
  if AImageList = nil then
  begin
    FImageList := nil;
  end
  else
  begin
    if FImageList <> nil then
      FImageList.RemoveIndex(Index);
    FImageList := AImageList;
    FImageList.Items[Index] := self;
  end;
end;

procedure TfpgImageItem.SetIndex(AIndex: integer);
begin
  {$IFDEF DEBUG}
  writeln('TfpgImageItem.SetIndex');
  {$ENDIF}
  if AIndex <> FIndex then
  begin
    if ImageList <> nil then
      ImageList.RemoveIndex(AIndex);
    FIndex := AIndex;
  end;
end;

procedure TfpgImageItem.SetImage(AImage: TfpgImage);
begin
  {$IFDEF DEBUG}
  writeln('TfpgImageItem.SetImage');
  {$ENDIF}
  FImage := AImage;
end;

constructor TfpgImageItem.Create;
begin
  ImageList := nil;
  FIndex    := -1;
  FImage    := nil;
end;

constructor TfpgImageItem.Create(AImageList: TfpgImageList; AIndex: integer;
    AImage: TfpgImage);
begin
  if AImageList = nil then
    Exit; //==>
  FImage      := AImage;
  FIndex      := AIndex;
  FImageList  := nil;
  ImageList   := AImageList;
end;

constructor TfpgImageItem.Create(AFileName: TfpgString; AIndex: integer);
begin
  {$IFDEF DEBUG}
  writeln('TfpgImageItem.Create(', AFileName, ',', AIndex, ')');
  {$ENDIF}
  Index := AIndex;
  LoadFromFile(AFileName);
end;

destructor TfpgImageItem.Destroy;
begin
  if FImage <> nil then
     FImage.Free;
  inherited Destroy;
end;

procedure TfpgImageItem.LoadFromFile(AFileName: TfpgString);
begin
  {$IFDEF DEBUG}
  writeln('TfpgImageItem.LoadFromFile');
  {$ENDIF}
  if FImage <> nil then
    FImage.Destroy;
  FImage := LoadImage_BMP(AFileName);
end;

end.