lazarus/examples/imagelist/unit1.pas

unit Unit1; 

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, GraphType, ExtCtrls, StdCtrls,
  ExtDlgs, LazUTF8;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    GroupBox4: TGroupBox;
    GroupBox5: TGroupBox;
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    Image4: TImage;
    Image5: TImage;
    ImageList1: TImageList;
    ListBox1: TListBox;
    OpenPictureDialog1: TOpenPictureDialog;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    function GetImageMap(AEffect: TGraphicsDrawEffect): TImage;
    procedure ListBox1SelectionChange(Sender: TObject; User: boolean);
  private

  public
    procedure ShowImages(AIndex: Integer);
    procedure AddFile(AFileName: String);
    property ImageMap[AEffect: TGraphicsDrawEffect]: TImage read GetImageMap;
  end;

var
  Form1: TForm1; 

implementation

{$R *.lfm}

{ TForm1 }

function LoadBitmapFromFile(AFileName: String): TCustomBitmap;
var
  Stream: TStream;
  GraphicClass: TGraphicClass;
begin
  Result := nil;
  Stream := nil;
  try
    Stream := TFileStream.Create(UTF8ToSys(AFileName), fmOpenRead or fmShareDenyNone);
    GraphicClass := GetGraphicClassForFileExtension(ExtractFileExt(AFileName));
    if (GraphicClass <> nil) and (GraphicClass.InheritsFrom(TCustomBitmap)) then
    begin
      Result := TCustomBitmap(GraphicClass.Create);
      Result.LoadFromStream(Stream);
    end;
  finally
    Stream.Free;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  AddFile(ExtractFilePath(ParamStrUTF8(0)) + SetDirSeparators('images/edit-clear.png'));
  AddFile(ExtractFilePath(ParamStrUTF8(0)) + SetDirSeparators('images/edit-find-replace.png'));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenPictureDialog1.Execute then
    AddFile(OpenPictureDialog1.FileName);
end;

function TForm1.GetImageMap(AEffect: TGraphicsDrawEffect): TImage;
begin
  case AEffect of
    gdeNormal: Result := Image1;
    gdeDisabled: Result := Image2;
    gdeHighlighted: Result := Image3;
    gdeShadowed: Result := Image4;
    gde1Bit: Result := Image5;
  else
    Result := nil;
  end;
end;

procedure TForm1.ListBox1SelectionChange(Sender: TObject; User: boolean);
begin
  if ListBox1.ItemIndex <> -1 then
    ShowImages(ListBox1.ItemIndex);
end;

procedure TForm1.ShowImages(AIndex: Integer);
var
  AEffect: TGraphicsDrawEffect;
  Bmp: TBitmap;
begin
  for AEffect := Low(TGraphicsDrawEffect) to High(TGraphicsDrawEffect) do
  begin
    Bmp := TBitmap.Create;
    ImageList1.GetBitmap(AIndex, Bmp, AEffect);
    if ImageMap[AEffect] <> nil then
      ImageMap[AEffect].Picture.Assign(Bmp);
    Bmp.Free;
  end;
end;

procedure TForm1.AddFile(AFileName: String);
var
  bmp: TCustomBitmap;
begin
  bmp := LoadBitmapFromFile(AFileName);
  if bmp <> nil then
  begin
    ImageList1.Add(bmp, nil);
    ListBox1.Items.Add(ExtractFileName(AFileName));
    if ListBox1.ItemIndex = -1 then
      ListBox1.ItemIndex := 0;
  end;
  bmp.Free;
end;

end.