Модераторы: Poseidon, Snowy, bems, MetalFan

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Непонятно ведет себя TPicture в потоке, выдает черный или белый квадрат 
V
    Опции темы
Ne1tr1n0
Дата 31.8.2012, 15:46 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 120
Регистрация: 1.3.2009

Репутация: 6
Всего: 8



Добрый день!

Пытаюсь сделать просмотр миниатюр в ListView в виртуальном режиме. Делаю так: сначала получаю список файлов в каталоге, заношу в TStringList с помощью AddObject(sr.Name, TObject(IconIndex)) где IconIndex - индекс иконки файла в моем ImageList'e, полученный с помощью SHGetFileInfo. Далее запускается поток, в котором происходит следующее:
Код

procedure TThumbThread.Execute;
var i: Integer;
    FBmp: TBitmap;
    Pic: TPicture;
    Ratio: Integer;
    tmp: Integer;
    Rect: TRect;

  function Max(const A, B: Integer): Integer; //чтоб не включать модуль Math из-за одной функции
  begin
    if A > B then Result := A else Result := B;
  end;

begin
  inherited;
  for i:=0 to FFileList.Count - 1 do //FFileList - список имён файлов в папке
  begin
    Pic:=TPicture.Create; //создаем объект TPicture
    FBmp:=TBitmap.Create;
    FBmp.Assign(BmpCanvas); //подготавливаем битмап к рисованию и добавлению в ImageList (BmpCanvas - заранее созданный битмап с нужным размером и выставленной прозрачностью
    try
      Pic.LoadFromFile(FPath + FFileList[i]); //пытаемся загрузить картинку. Причем если загружен черный или белый квадрат ошибки все равно не происходит.
      Ratio:=Max(Pic.Width div ThumbSize, Pic.Height div ThumbSize);
      With Rect do //подгоняем под размеры тумбы (Thumb)
      begin
        tmp:=Pic.Width div Ratio;
        Left:=(ThumbSize - tmp) div 2;
        Right:=Left + tmp;
        tmp:=Pic.Height div Ratio;
        Top:=(ThumbSize - tmp) div 2;
        Bottom:=Top + tmp;
      end;
      FBmp.Canvas.StretchDraw(Rect, Pic.Graphic); //рисуем уменьшенную копию
      FFIleList.Objects[i]:=TObject(FImageList.Add(FBmp, nil)); //добавляем тумбу в ImageList и подменяем у текущего файла индекс иконки на только что индекс только что добавленной тумбы
    finally
      Pic.Free;
      FBmp.Free; //убираем за собой
    end;
  end;
end;


Причем эта ошибка возникает нерегулярно, на одной и той же картинке может нормально отработать, а может и выдать черный или белый квадрат. Если надо - могу полностью скинуть проект.
Заранее спасибо.
PM MAIL   Вверх
Dapo
Дата 31.8.2012, 17:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 417
Регистрация: 18.4.2002

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



Кто такие BmpCanvas, FFileList, FImageList? F каком потоке они создаются? Почему Вы пилите сук на котором сидите: FBmp.Free; //убираем за собой
PM MAIL   Вверх
Ne1tr1n0
Дата 31.8.2012, 18:22 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 120
Регистрация: 1.3.2009

Репутация: 6
Всего: 8



BmpCanvas - заранее созданный битмап с нужным размером и выставленной прозрачностью. Создан в основном потоке программы (Фактически в FormCreate он создается).
FFileList и FImageList - свойства потомка от TThread (это который TThumbThread). Им при создании потока присваиваются ссылки на соответствующие поля формы.
Код

type
  TThumbThread = class(TThread)
  private
    FPath: string;
    FFileList: TStringList;
    FImgList: TImageList;
  protected
    procedure Execute; override;
  public
    property Path: string write FPath;
    property ImageList: TImageList write FImgList;
    property Files: TStringList write FFileList;
  end;
...
//заполнение списка slFiles. В массиве arrExts содержатся допустимые разрешения файлов. На основании этого же массива заполняется иконками ImageList в FormCreate
  if FindFirst(Path + '*.*', faAnyFile - faDirectory, sr) = 0 then
  repeat
    for i:=Low(arrExts) to High(arrExts) do
      if LowerCase(ExtractFileExt(sr.Name)) = arrExts[i] then
        slFiles.AddObject(sr.Name, TObject(i));
  until FindNext(sr) > 0;
  FindClose(sr);

  ListView1.Items.Count:=slFiles.Count;
  ListView1.Invalidate;

  if slFiles.Count > 0 then
  begin
    NewThumbThread:=TThumbThread.Create(True);
    NewThumbThread.Path:=Path; //путь к текущей папке
    NewThumbThread.Files:=slFiles; //список файлов (TStringList), заполняется в основном потоке программы
    NewThumbThread.ImageList:=ImageList1; //ImageList, привязанный к ListView'у. Частично заполняется иконками файлов в основном потоке программы, и в дальнейшем уже заполняется из потока.
    NewThumbThread.Priority:=tpNormal;
    NewThumbThread.FreeOnTerminate:=False;
    NewThumbThread.Resume;
  end;

Цитата(Dapo @  31.8.2012,  15:38 Найти цитируемый пост)
Почему Вы пилите сук на котором сидите: FBmp.Free; //убираем за собой 

Этот момент не совсем понял. Изображение ведь уже в ImageList'e, зачем оно дальше нужно?
PM MAIL   Вверх
Illusion Dolphin
Дата 31.8.2012, 20:33 (ссылка) |    (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 36
Всего: 63



Ошибки тут:
Код

FBmp.Assign(BmpCanvas);

и тут:
Код

FBmp.Canvas.StretchDraw(Rect, Pic.Graphic); 

С объектом Canvas работать из потоков нельзя, только через синхронизацию.


--------------------
В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5
PM MAIL WWW ICQ   Вверх
Ne1tr1n0
Дата 2.9.2012, 01:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 120
Регистрация: 1.3.2009

Репутация: 6
Всего: 8



Вынес работу с Canvas в процедуру синхронизации. Но появились тормоза при прокрутке ListView например. Да и вообще интерфейс стал менее отзывчивым на действия пользователя.
Вот код:
Код

//несколько изменил объявление класса потока
  TThumbThread = class(TThread)
  private
    FPic: TPicture;
    FThumb: TBitmap;
    FSyncIndex: Integer;
...
  protected
    procedure Sync;
...
procedure TThumbThread.Execute;
var i: Integer;
begin
  inherited;
  for i:=0 to FFileList.Count - 1 do
  begin
    FPic:=TPicture.Create;
    try
      FPic.LoadFromFile(FPath + FFileList[i]);
      FSyncIndex:=i;
      Synchronize(Sync);
    finally
      FPic.Free;
    end;
  end;
end;

procedure TThumbThread.Sync;
var b1: TBitmap;

  procedure CreateThumb(bmp: TBitmap; Size: Integer);
  begin
    bmp.SetSize(Size, Size);
    bmp.Canvas.StretchDraw(bmp.Canvas.ClipRect, b1);
  end;

begin
  b1:=TBitmap.Create;
  b1.Assign(FPic.Graphic);
  FThumb:=TBitmap.Create;
  FThumb.Assign(BmpCanvas);
  CreateThumb(FThumb, ThumbSize);
  FFIleList.Objects[FSyncIndex]:=TObject(FImgList.Add(FThumb, nil));
  FThumb.Free;
  b1.Free;
end;
Если же адаптировать код из этого поста: http://forum.vingrad.ru/forum/topic-152623.html (второй вариант), то наблюдается та же картина что и у меня была. 
Как теперь можно сделать?

Добавлено через 3 минуты и 19 секунд
ЗЫ: Я так полагаю основные тормоза создает StretchDraw. Возможно с ним что-нить можно сделать?
PM MAIL   Вверх
Illusion Dolphin
Дата 2.9.2012, 12:01 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 36
Всего: 63



Каждый из этих методов создаёт тормоза.
Assign одного TGraphic к другому везде реализован по-разному, в зависимостиот этого это можно выполнять в потоке или надо писать ручной Assign, который не будет затрагивать Canvas. Это зависит от конкретных типов изображений. 
StretchDraw - тут уже полегче (если не заморачиваться с качеством), есть готовые решения типа http://forum.vingrad.ru/forum/topic-49118/...size/index.html, они не работают с канвой, поэтому это можно делать в потоке без синхронизации.


--------------------
В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5
PM MAIL WWW ICQ   Вверх
Ne1tr1n0
Дата 2.9.2012, 13:58 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 120
Регистрация: 1.3.2009

Репутация: 6
Всего: 8



Поискал ещё насчет канвы и потоков - действительно пишут, что да, класс не Thread-safe, так что могут быть проблемы. Некоторые рекомендуют использовать методы Canvas.Lock и Canvas.Unlock соответственно сразу после того как создали битмап и закончили с ним работать. Вроде как это специальные методы Borland/Embarcadero (не знаю точно когда они появились), позволяющие работать с канвой в многопоточных приложениях. Попробовал у себя использовать - не помогает, хотя ошибок стало заметно меньше. Может быть стоит покопать поглубже в сторону этих Lock/Unlock? Есть смысл?
Вот код с блокированием канвы:
Код

procedure TThumbThread.Execute;
var i: Integer;
    Bmp: TBitmap;
    Pic: TPicture;
    Rect: TRect;
begin
  inherited;
  for i:=0 to FFileList.Count - 1 do
  begin
    Pic:=TPicture.Create;
    Bmp:=TBitmap.Create;
//    Pic.Bitmap.Canvas.Lock;
    Bmp.Canvas.Lock;
    Bmp.Assign(BmpCanvas);
    try
      Pic.LoadFromFile(FPath + FFileList[i]);
      if Pic.Width > Pic.Height then
      begin
        Rect.Right := ThumbSize;
        Rect.Bottom := (ThumbSize * Pic.Height) div Pic.Width;
      end
      else
      begin
        Rect.Bottom := ThumbSize;
        Rect.Right := (ThumbSize * Pic.Width) div Pic.Height;
      end;

      Rect.Left:=(ThumbSize - Rect.Right) div 2;
      Rect.Top:=(ThumbSize - Rect.Bottom) div 2;
      Rect.Right:=Rect.Left + Rect.Right;
      Rect.Bottom:=Rect.Top + Rect.Bottom;

      Bmp.Canvas.StretchDraw(Rect, Pic.Graphic);
      FFileList.Objects[i]:=TObject(FImgList.Add(Bmp, nil));
    finally
//      Pic.Bitmap.Canvas.Unlock;
      Bmp.Canvas.Unlock;
      Pic.Free;
      Bmp.Free;
    end;
  end;
end;


Насчет ресайза без использования канвы - спасибо, тоже посмотрю сейчас

Это сообщение отредактировал(а) Ne1tr1n0 - 2.9.2012, 14:00
PM MAIL   Вверх
MetalFan
Дата 2.9.2012, 14:26 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Аццкий Сотона
****


Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 62
Всего: 128



Я тоже сталкивался с проблемами при работе с TBitmap/TPicture в потоке... На сколько я помню, TBitmap'у не удавалось порой выделять память при использовании его в отдельном потоке. При чем при работе в осн.потоке проблем не возникало.
Как решил проблему уже не помню, возможно свел вероятность ее возникновение к минимуму.


--------------------
There are always someone smarter than you...
PM MAIL   Вверх
Illusion Dolphin
Дата 2.9.2012, 20:32 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 36
Всего: 63



Код

Bmp.Assign(BmpCanvas);

Этот код блокирует все другие операции TBitmap.Assign ра время работы во всех потоках (инфа: исходники VCL)
Цитата

Некоторые рекомендуют использовать методы Canvas.Lock и Canvas.Unlock

Возможно это решит часть проблем, но я это обходил через неиспользование TCanvas в потоках. 


--------------------
В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5
PM MAIL WWW ICQ   Вверх
Ne1tr1n0
Дата 3.9.2012, 11:58 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 120
Регистрация: 1.3.2009

Репутация: 6
Всего: 8



Что-то все равно проскакивают ошибки. Может я что не так делаю?
Код

      Pic.LoadFromFile(FPath + FFileList[i]);
      Bmp.Assign(Pic.Graphic);
      SmoothResize(Bmp, Thumb);
      FFileList.Objects[i]:=TObject(FImgList.Add(Thumb, nil));

PM MAIL   Вверх
MetalFan
Дата 3.9.2012, 13:42 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Аццкий Сотона
****


Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 62
Всего: 128



Ne1tr1n0, А FImgList - эт случайно не ссылка на компонент на форме? может лучше это (добавление картинки в ImageList) делать в основном потоке через Synchronize?


--------------------
There are always someone smarter than you...
PM MAIL   Вверх
Ne1tr1n0
Дата 3.9.2012, 13:45 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 120
Регистрация: 1.3.2009

Репутация: 6
Всего: 8



Так точно, она и есть. Это ImageList, привязанный к ListView'у.
Сейчас попробую вынессти добавление в ImageList в Syncronize.
PM MAIL   Вверх
Ne1tr1n0
Дата 3.9.2012, 15:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 120
Регистрация: 1.3.2009

Репутация: 6
Всего: 8



Да, так работает. И вроде даже не тормозит. Я тут просто решил поизвращаться, создал класс TItemData, в нем одним из полей TMemoryStream, так вот, после SmoothResize я запихивал тумбу в TJPEGImage, сжимал её, и сохранял в этот TMemoryStream. И добавлял каждый экземпляр класса в качестве связанного объекта в список файлов. А в ListView.OnGetImageIndex уже доставал из потока, преобразовывал в битмап и добавлял его в ImageList, назначая индекс только что добавленного элемента каждому ListItem'у. Тоже работало, но вариант MetalFan'a мне как-то поизящней кажется. Пожалуй тему можно закрывать, всем спасибо за обсуждение smile
PM MAIL   Вверх
MetalFan
Дата 3.9.2012, 20:47 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Аццкий Сотона
****


Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 62
Всего: 128



Цитата(Ne1tr1n0 @  3.9.2012,  15:59 Найти цитируемый пост)
я запихивал тумбу в TJPEGImage, сжимал её, и сохранял в этот TMemoryStream.

Ватэто изврат) Типа память экономил?

А проблема скорее всего была в вызове метода TImageList.Add из потока... что вызывало скорее всего Update и выполнение кучи VCL-ного кода в доп.потоке вместо основного... Не зря ж везде советуют НЕ использовать VCL компоненты в доп. потоках без синхронизации или без понимания внутреннего устройства.


--------------------
There are always someone smarter than you...
PM MAIL   Вверх
Ne1tr1n0
Дата 3.9.2012, 22:17 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 120
Регистрация: 1.3.2009

Репутация: 6
Всего: 8



Ну можно и так сказать))) Только все равно тумба потом в ImageList'e оказывалась в виде битмапа, так что толку от такой экономии не особо было. Там просто одна из мыслей была ещё в OnCustomDrawItem самому её отрисовывать, но отказался от этой затеи.
И в каком-то примере видел подобную штуку, но там свой контрол был, внешне напоминающий ListView, но с собственным механизмом отрисовки, там как раз из жпега всё рисовалось.
Тут ещё попутно вопрос возник. Не совсем правда к этой теме относящийся, так что может лучше и в отдельную ветку вынести.
Вот делаю я значит в процедуре синхронизации такую штуку:
Код

procedure TThumbThread.Sync;
var Thumb: TBitmap;
begin
  if Terminated then Exit;

  Thumb:=TBitmap.Create;
  Thumb.Assign(BmpCanvas);
  Thumb.Canvas.Draw((ThumbSize - FBmp.Width) div 2, (ThumbSize - FBmp.Height) div 2, FBmp);
  FFileList.Objects[FSyncIndex]:=TObject(FImgList.Add(Thumb, nil));
  FBmp.Free;
  Thumb.Free;
end;
FBmp - поле класса потока, в него я с помощью SmoothResize заношу пропорционально уменьшенную картинку. Но тумбы-то квадратные, следовательно здесь я выравниваю уменьшенную копию изображения посередине тумбы (с помощью Canvas.Draw и там нужные координаты задаю). BmpCanvas - это подготовленный прозрачный пустой "холст", я на нем с помощью DrawIcon вывожу иконки файлов, которые отображаются пока не сгенерилась тумба для файла. Так вот после DrawIcon изображения с иконками остаются прозрачными, это хорошо заметно при выделении итема в ListView. 
user posted image 
А после приведенного вызова Canvas.Draw видимо из-за того, что для FBmp в SmoothResize явно задается PixelFormat:=pf24bit у меня прозрачность теряется. И никакими TransparentColor/TransparentMode или PixelFormat:=pf32bit вернуть её не удается. В результате в ListView, если выделить элемент, то вокруг изображения образуется белый фон (вместо синего выделения). Выглядит это примерно так (у выделенного итема сверху и снизу относительно широкие белые полосы): 
user posted image
Вот как бы от этого ещё избавиться? Спасибо.

Это сообщение отредактировал(а) Ne1tr1n0 - 3.9.2012, 22:31
PM MAIL   Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи


Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.

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


 




[ Время генерации скрипта: 0.1123 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.