We help IT Professionals succeed at work.

possible? Loading a Timagelist at runtime and save it

pka4916
pka4916 used Ask the Experts™
on
I have a
Timagelist, and loading 4000 png files in it.. which takes about 5 seconds or more.
is it possible to load them and save it as 1 item  so that the reloading doesn't take 5 or more
seconds everytime?

i've been reading about saving it as 1 and then load it,  but i don't know how.

also  the png files are 32x32  but wants them in 24x24,  but i can't find the crop/resize option. in the control.

procedure Tdsmainform.loadcovers;
var
  SL: TStringList;
  Png: TPngObject;
  Bmp: TBitmap;
//  List: TImageList;
  Start: Cardinal;
  i: Integer;
begin
  SL := TStringList.Create;
  Png := TPngObject.Create;
  Bmp := TBitmap.Create;
  iconList := TImageList.CreateSize(24, 24);
  try
    SL.LoadFromFile('d:\List.txt');
    Start := GetTickCount;
    Bmp.Width := SL.Count * 24;
    Bmp.Height := 24;
    for i := 0 to SL.Count - 1 do
    begin
      Png.LoadFromFile('d:\pics\'+SL[i]);
      Bmp.Canvas.Draw(i * 24, 0, Png);
    end;
    iconList.AllocBy := 4000;
    iconList.Masked := False;
    iconList.Add(Bmp, nil);
    Caption := IntToStr(GetTickCount - Start);
    for i := 0 to iconList.Count - 1 do
      iconList.Draw(Canvas, i * iconList.Width mod ClientWidth,
        (i * iconList.Width div ClientWidth) * iconList.Height, i);
  finally
 
    Bmp.Free;
    Png.Free;
    SL.Free;
  end;
end;

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Eddie ShipmanAll-around developer

Commented:
In order to get them as 32x32, set the Height and Width properties to 32. They ALL have to be the same size, too.
You can save it using WriteComponentRes and read it back in using ReadComponentRes.
Let me see if I can find an example of both for you.
Geert GOracle dba
Top Expert 2009

Commented:
there is no crop/resize option
load in the images as 32x32 and then use StretchBlt when drawing the images

Author

Commented:
the images are 32x32   and in the new format  i want them 24x24

can I use StretchBlt to make them smaller?
Eddie ShipmanAll-around developer

Commented:
Use StretchBlt instead of
  Bmp.Canvas.Draw(i * 24, 0, Png);
Geert GOracle dba
Top Expert 2009

Commented:
like in this sample:

unit Unit4;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ImgList, ComCtrls, ToolWin;
 
type
  TForm4 = class(TForm)
    Button1: TButton;
    ilLoad: TImageList;
    ilChanged: TImageList;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolBar2: TToolBar;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    ToolButton12: TToolButton;
    procedure Button1Click(Sender: TObject);
  private
    procedure LoadImages(aDir, aExt: string; aHeight: Integer = 16; aWidth: Integer = 16);
    procedure ConvertImages(ilStart, ilEnd: TImageList; NewHeight: integer = 16; NewWidth: integer = 16);
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form4: TForm4;
 
implementation
 
{$R *.dfm}
 
procedure TForm4.LoadImages(aDir, aExt: string; aHeight: Integer = 16; aWidth: Integer = 16);
var sr: TSearchRec;
  bm: TBitmap;
  procedure AddFile;
  begin
    if (sr.Name <> '.') and (sr.Name <> '..') and (sr.Attr and faDirectory = 0) and
      SameText(ExtractFileExt(sr.Name), '.' + aExt) then
    begin
      bm.LoadFromFile(aDir + '\' + sr.Name);
      ilLoad.Add(bm, nil);
    end;
  end;
begin
  ilLoad.Clear;
  ilLoad.Height := aHeight;
  ilLoad.Width := aWidth;
  bm := TBitmap.Create;
  try
    if FindFirst(Format('%s\*.%s', [aDir, aExt]), faArchive, sr) = 0 then
    try
      AddFile;
      while FindNext(sr) = 0 do
        AddFile;
    finally
      FindClose(sr);
    end;
  finally
    FreeAndNil(bm);
  end;
end;
 
procedure TForm4.ConvertImages(ilStart, ilEnd: TImageList; NewHeight: integer = 16; NewWidth: integer = 16);
var I: Integer;
  bm, bm2: TBitmap;
begin
  ilEnd.Clear;
  ilEnd.Height := NewHeight;
  ilEnd.Width := NewWidth;
  bm := TBitmap.Create;
  try
    bm2 := TBitmap.Create;
    try
      bm2.Height := NewHeight;
      bm2.Width := NewWidth;
      for I := 0 to ilStart.Count - 1 do
        if ilStart.GetBitmap(I, bm) then
        begin
          bm2.Assign(bm);
          bm2.Height := NewHeight;
          bm2.Width := NewWidth;
          StretchBlt(bm2.Canvas.Handle, 0, 0, 24, 24, bm.Canvas.Handle, 0, 0, 32, 32, SRCCOPY);
          ilChanged.Add(bm2, nil);
        end;
    finally
      bm2.Free;
    end;
  finally
    bm.Free;
  end;
end;
 
procedure TForm4.Button1Click(Sender: TObject);
begin
  LoadImages('C:\Program Files\Common Files\CodeGear Shared\Images\GlyFX\Icons\BMP\32x32', 'BMP', 32, 32);
  ConvertImages(ilLoad, ilChanged, 24, 24);
end;
 
end.
 
--dfm--
object Form4: TForm4
  Left = 0
  Top = 0
  Caption = 'Form4'
  ClientHeight = 301
  ClientWidth = 467
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 96
    Top = 160
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 0
    OnClick = Button1Click
  end
  object ToolBar1: TToolBar
    Left = 0
    Top = 0
    Width = 467
    Height = 40
    ButtonHeight = 40
    ButtonWidth = 40
    Caption = 'ToolBar1'
    Images = ilLoad
    TabOrder = 1
    object ToolButton1: TToolButton
      Left = 0
      Top = 0
      Caption = 'ToolButton1'
      ImageIndex = 0
    end
    object ToolButton2: TToolButton
      Left = 40
      Top = 0
      Caption = 'ToolButton2'
      ImageIndex = 1
    end
    object ToolButton3: TToolButton
      Left = 80
      Top = 0
      Caption = 'ToolButton3'
      ImageIndex = 2
    end
    object ToolButton4: TToolButton
      Left = 120
      Top = 0
      Caption = 'ToolButton4'
      ImageIndex = 3
    end
    object ToolButton5: TToolButton
      Left = 160
      Top = 0
      Caption = 'ToolButton5'
      ImageIndex = 4
    end
    object ToolButton6: TToolButton
      Left = 200
      Top = 0
      Caption = 'ToolButton6'
      ImageIndex = 5
    end
  end
  object ToolBar2: TToolBar
    Left = 0
    Top = 40
    Width = 467
    Height = 40
    ButtonHeight = 40
    ButtonWidth = 40
    Caption = 'ToolBar1'
    Images = ilChanged
    TabOrder = 2
    object ToolButton7: TToolButton
      Left = 0
      Top = 0
      Caption = 'ToolButton1'
      ImageIndex = 0
    end
    object ToolButton8: TToolButton
      Left = 40
      Top = 0
      Caption = 'ToolButton2'
      ImageIndex = 1
    end
    object ToolButton9: TToolButton
      Left = 80
      Top = 0
      Caption = 'ToolButton3'
      ImageIndex = 2
    end
    object ToolButton10: TToolButton
      Left = 120
      Top = 0
      Caption = 'ToolButton4'
      ImageIndex = 3
    end
    object ToolButton11: TToolButton
      Left = 160
      Top = 0
      Caption = 'ToolButton5'
      ImageIndex = 4
    end
    object ToolButton12: TToolButton
      Left = 200
      Top = 0
      Caption = 'ToolButton6'
      ImageIndex = 5
    end
  end
  object ilLoad: TImageList
    Left = 88
    Top = 112
  end
  object ilChanged: TImageList
    Left = 48
    Top = 112
  end
end

Open in new window

Oracle dba
Top Expert 2009
Commented:
o cool, i found the save and load too ...
unit Unit4;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ImgList, ComCtrls, ToolWin, CommCtrl;
 
type
  TForm4 = class(TForm)
    Button1: TButton;
    ilLoad: TImageList;
    ilChanged: TImageList;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolBar2: TToolBar;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    ToolButton12: TToolButton;
    procedure Button1Click(Sender: TObject);
  private
    procedure LoadImages(aDir, aExt: string; aHeight: Integer = 16; aWidth: Integer = 16);
    procedure ConvertImages(ilStart, ilEnd: TImageList; NewHeight: integer = 16; NewWidth: integer = 16);
    procedure SaveImageList;
    function LoadImageList: Boolean;
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form4: TForm4;
 
implementation
 
{$R *.dfm}
 
type
  TMagicImageList = class(TImageList);
 
procedure TForm4.LoadImages(aDir, aExt: string; aHeight: Integer = 16; aWidth: Integer = 16);
var sr: TSearchRec;
  bm: TBitmap;
  procedure AddFile;
  begin
    if (sr.Name <> '.') and (sr.Name <> '..') and (sr.Attr and faDirectory = 0) and
      SameText(ExtractFileExt(sr.Name), '.' + aExt) then
    begin
      bm.LoadFromFile(aDir + '\' + sr.Name);
      ilLoad.Add(bm, nil);
    end;
  end;
begin
  ilLoad.Clear;
  ilLoad.Height := aHeight;
  ilLoad.Width := aWidth;
  bm := TBitmap.Create;
  try
    if FindFirst(Format('%s\*.%s', [aDir, aExt]), faArchive, sr) = 0 then
    try
      AddFile;
      while FindNext(sr) = 0 do
        AddFile;
    finally
      FindClose(sr);
    end;
  finally
    FreeAndNil(bm);
  end;
end;
 
procedure TForm4.ConvertImages(ilStart, ilEnd: TImageList; NewHeight: integer = 16; NewWidth: integer = 16);
var I: Integer;
  bm, bm2: TBitmap;
begin
  ilEnd.Clear;
  ilEnd.Height := NewHeight;
  ilEnd.Width := NewWidth;
  bm := TBitmap.Create;
  try
    bm2 := TBitmap.Create;
    try
      bm2.Height := NewHeight;
      bm2.Width := NewWidth;
      for I := 0 to ilStart.Count - 1 do
        if ilStart.GetBitmap(I, bm) then
        begin
          bm2.Assign(bm);
          bm2.Height := NewHeight;
          bm2.Width := NewWidth;
          StretchBlt(bm2.Canvas.Handle, 0, 0, 24, 24, bm.Canvas.Handle, 0, 0, 32, 32, SRCCOPY);
          ilChanged.Add(bm2, nil);
        end;
    finally
      bm2.Free;
    end;
  finally
    bm.Free;
  end;
end;
 
function TForm4.LoadImageList: Boolean;
var aFile: string;
  s: TFileStream;
begin
  Result := False;
  aFile := ChangeFileExt(Application.ExeName, '.ims');
  if FileExists(aFile) then
  begin
    s := TFileStream.Create(aFile, fmOpenRead);
    try
      TMagicImageList(ilChanged).ReadData(s);
      Result := True;
    finally
      s.Free;
    end;
  end;
end;
 
procedure TForm4.Button1Click(Sender: TObject);
begin
  if not LoadImageList then
  begin
    LoadImages('C:\Program Files\Common Files\CodeGear Shared\Images\GlyFX\Icons\BMP\32x32', 'BMP', 32, 32);
    ConvertImages(ilLoad, ilChanged, 24, 24);
    SaveImageList;
  end;
end;
 
procedure TForm4.SaveImageList;
var s: TFileStream;
begin
  s := TFileStream.Create(ChangeFileExt(Application.ExeName, '.ims'), fmCreate);
  try
    TMagicImageList(ilChanged).WriteData(s);
  finally
    s.Free;
  end;
  ShowMEssage('File Saved ');
end;
 
end.

Open in new window