asked on

possible? Loading a Timagelist at runtime and save it

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

Eddie Shipman

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 G

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

pka4916

ASKER

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

can I use StretchBlt to make them smaller?

Eddie Shipman

Use StretchBlt instead of
Bmp.Canvas.Draw(i * 24, 0, Png);

Geert G

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

ASKER CERTIFIED SOLUTION

Geert G

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial