VPF::Загрузка превьюшек в потоке - Форум программистов

aktuba

Дата 23.5.2007, 08:56 (ссылка)

(нет голосов)

Загрузка ...

Смышленный

Профиль
Группа: Завсегдатай
Сообщений: 1915
Регистрация: 24.4.2006
Где: Планета Земля

Репутация: нет
Всего: 38

Есть такая задача: на форме 3 ImageList-а (16х16, 48х48, 96х96). Необходимо создать функцию, которая будет загружать из директории изображения (форматы разные: bmp, jpg, png, gif и т.д.), создавать из этих приложений превьюшки и помещать их в ImageList-ы... Если это делать в основном потоке - то форма на время замирает (что и понятно). Например, для каталога, в котором лежит 155 изображений примерно 600х600, весь процесс занимает примерно секунд 5. Долго =(.

Была такая идея - производить все действия в отдельном потоке/потоках и после каждого изображения делать репаинт ListView. Наткнулся на кучу проблем... Например, в потоке не хочет работать TPicture =((( Постоянные ошибки. Код загрузки в потоках приводить не буду, т.к. во-первых, все-равно не работает, во-вторых я его удалил...

Кто-нибудь занимался подобным? Есть идеи, мысли, решения???

--------------------

Snowy

Дата 23.5.2007, 10:54 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 18
Всего: 484

Не вижу, что может помешать TPicture работать в треде...
А добавлять изображения в ListView и имаджлисты нужно просто при синхронизации.
Не вижу проблемы. Вероятно просто ты что-то не так делаешь...

aktuba

Дата 23.5.2007, 11:27 (ссылка)

(нет голосов)

Загрузка ...

Смышленный

Профиль
Группа: Завсегдатай
Сообщений: 1915
Регистрация: 24.4.2006
Где: Планета Земля

Репутация: нет
Всего: 38

Цитата

Вот именно так и делал. Проблема возникает через какое-то время при создании TPicture smile

Если набросаешь рабочий пример - буду очень благодарен...

--------------------

Snowy

Дата 23.5.2007, 12:15 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 18
Всего: 484

Набросал пример.
На форме ListView и 3 ImageList

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, ComCtrls;

type
  TForm1 = class(TForm)
    lv1: TListView;
    ImageList1: TImageList;
    ImageList2: TImageList;
    ImageList3: TImageList;
    procedure FormCreate(Sender: TObject);
  end;

  TImgLoadingThread = class(TThread)
  protected
    img: TPicture;
    FileName: string;
    procedure Execute; override;
    procedure Sync;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses jpeg;

{ TImgLoadingThread }

procedure TImgLoadingThread.Execute;
const dir = 'C:\Pictures\';
var
  sr: TSearchRec;
begin
  if FindFirst(dir + '*.*', faAnyFile, sr) = 0 then
  begin
    repeat
      img := TPicture.Create;
      try
        FileName := sr.Name;
        if FileName[1] = '.' then Continue;
        img.LoadFromFile(dir + FileName); // здесь будут безбожно лететь эксепшены
        Synchronize(Sync);
      finally
        img.Free;
      end;
    until FindNext(sr) <> 0;
    FindClose(sr);
  end;
end;

procedure TImgLoadingThread.Sync;
var
  bmp: TBitmap;
  procedure AddImage(il: TImageList);
  var
    b: TBitmap;
  begin
    b := TBitmap.Create;
    try
      b.Width := il.Width;
      b.Height := il.Height;
      b.Canvas.StretchDraw(b.Canvas.ClipRect, bmp);
      il.Add(b, nil);
    finally
      b.Free;
    end;
  end;
begin
  bmp := TBitmap.Create;
  try
    bmp.Assign(img.Graphic);
    AddImage(Form1.ImageList1);
    AddImage(Form1.ImageList2);
    AddImage(Form1.ImageList3);
    with Form1.lv1.Items.Add do
    begin
      Caption := FileName;
      ImageIndex := Form1.lv1.Items.Count-1;
    end;
  finally
    bmp.Free;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  with TImgLoadingThread.Create(true) do
  begin
    FreeOnTerminate := True;
    Resume;
  end;
end;

end.

Snowy

Дата 23.5.2007, 12:35 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 18
Всего: 484

Поправил код. Оптимизировал - вынес вообще всю нагрузку в тред, а в синке оставил только добавление.
Получилось не очень красиво, т.к. не хотелось делать списки/массивы и перебирать имаджлисты циклом.
Зато быстро и не нагружает основной тред вообще smile

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, ComCtrls;

type
  TForm1 = class(TForm)
    lv1: TListView;
    ImageList1: TImageList;
    ImageList2: TImageList;
    ImageList3: TImageList;
    procedure FormCreate(Sender: TObject);
  end;

  TImgLoadingThread = class(TThread)
  protected
    b1, b2, b3: TBitmap;
    s1, s2, s3: integer;
    FileName: string;
    procedure Execute; override;
    procedure Sync;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses jpeg;

{ TImgLoadingThread }

procedure TImgLoadingThread.Execute;
const dir = 'C:\Pictures\';
var
  sr: TSearchRec;
  img: TPicture;
  bmp: TBitmap;
  procedure CreateTumb(b: TBitmap; sz: integer);
  begin
    b.Width := sz; b.Height := sz;
    b.Canvas.StretchDraw(b.Canvas.ClipRect, bmp);
  end;
begin
  if FindFirst(dir + '*.*', faAnyFile, sr) = 0 then
  begin
    img := TPicture.Create;
    bmp := TBitmap.Create;
    b1 := TBitmap.Create;
    b2 := TBitmap.Create;
    b3 := TBitmap.Create;
    repeat
      try
        FileName := sr.Name;
        if FileName[1] = '.' then Continue;
        img.LoadFromFile(dir + FileName);
        bmp.Assign(img.Graphic);
        CreateTumb(b1, s1); CreateTumb(b2, s2); CreateTumb(b3, s3);
        Synchronize(Sync);
      finally
      end;
    until FindNext(sr) <> 0;
    FindClose(sr);
    b1.Free; b2.Free; b3.Free; bmp.Free; img.Free;
  end;
end;

procedure TImgLoadingThread.Sync;
begin
  Form1.ImageList1.Add(b1, nil);
  Form1.ImageList2.Add(b2, nil);
  Form1.ImageList3.Add(b3, nil);
  with Form1.lv1.Items.Add do
  begin
    Caption := FileName;
    ImageIndex := Form1.lv1.Items.Count-1;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  with TImgLoadingThread.Create(true) do
  begin
    FreeOnTerminate := True;
    s1 := ImageList1.Width;
    s2 := ImageList2.Width;
    s3 := ImageList3.Width;
    Resume;
  end;
end;

end.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »