Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Графика и игры
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 18.09.2006, 14:11
Аватар для 4kusNick
4kusNick 4kusNick вне форума
Местный
 
Регистрация: 06.09.2006
Адрес: Россия, Санкт-Петербург
Сообщения: 444
Репутация: 550
Печаль TBitmap и TThread

Итак:
Подскажите пожалуйста, если кто знает, как правильно использовать TThread для того, чтобы вынести функцию наложения фльтра в отдельный поток.

Вот код фильтра Sepia:
Код:
function BmpToSepia(const Bmp: TBitmap; Depth: Integer): Boolean;
var
  Color,Color2: LongInt;
  r,g,b,rr,gg:  Byte;
  h,w:          Integer;
begin

  for h := 0 to Bmp.Height do
  begin
    Filters.ProgressBar.StepIt;
    Filters.ProgressBar.Update;
    for w := 0 to Bmp.Width do
    begin
      //сначала конвертируем bmp в черно-белые цвета
      Color := ColorToRGB(Bmp.Canvas.Pixels[w,h]);
      r := GetRValue(Color);
      g := GetGValue(Color);
      b := GetBValue(Color);
      Color2 := (r + g + b) div 3;
      Bmp.Canvas.Pixels[w,h] := RGB(Color2,Color2,Color2);
      //затем ковертируем в Сепию
      Color := ColorToRGB(Bmp.Canvas.Pixels[w,h]);
      r := GetRValue(Color);
      g := GetGValue(Color);
      b := GetBValue(Color);
      rr := r + (Depth*2);
      gg := g + Depth;
      if rr <= ((Depth*2)-1) then
        rr := 255;
      if gg <= (Depth-1) then
        gg := 255;
      Bmp.Canvas.Pixels[w,h] := RGB(rr,gg,b);
    end;
  end;
  Result := True;

end;

Depth = 20;

Создал потомка от TThread:
Код:
unit SepiaThread;

interface

uses
  Classes, SysUtils, Windows, Graphics;

type
  TSepiaThread = class(TThread)
  private
    EBmp: Graphics.TBitmap
    { Private declarations }
  protected
    procedure UpdatePrb;
    procedure Execute; override;
    function BmpToSepia(const Bmp: TBitmap; Depth: Integer): Boolean;
 public
    constructor Create(bmpBitmap: Graphics.TBitmap);
  end;

implementation

uses MainForm;

constructor TSepiaThread.Create(bmpBitmap: Graphics.TBitmap);
begin
// как правильно:
//EBmp := bmpBitmap;
// или
//EBmp := Graphics.TBitmap.Create();
//EBmp.Assign(bmpBitmap) ?

  EBmp := bmpBitmap;   
  inherited Create(False);

end;

procedure TFirstThread.UpdatePrb;
begin
  Main.ProgressBar.StepIt;
end;

function TFirstThread.BmpToSepia(const Bmp: TBitmap; Depth: Integer): Boolean;
var
  Color,Color2: LongInt;
  r,g,b,rr,gg:  Byte;
  h,w:          Integer;
begin

  for h := 0 to Bmp.Height do
  begin
    Filters.ProgressBar.StepIt;
    Filters.ProgressBar.Update;
    for w := 0 to Bmp.Width do
    begin
      //сначала конвертируем bmp в черно-белые цвета
      Color := ColorToRGB(Bmp.Canvas.Pixels[w,h]);
      r := GetRValue(Color);
      g := GetGValue(Color);
      b := GetBValue(Color);
      Color2 := (r + g + b) div 3;
      Bmp.Canvas.Pixels[w,h] := RGB(Color2,Color2,Color2);
      //затем ковертируем в Сепию
      Color := ColorToRGB(Bmp.Canvas.Pixels[w,h]);
      r := GetRValue(Color);
      g := GetGValue(Color);
      b := GetBValue(Color);
      rr := r + (Depth*2);
      gg := g + Depth;
      if rr <= ((Depth*2)-1) then
        rr := 255;
      if gg <= (Depth-1) then
        gg := 255;
      Bmp.Canvas.Pixels[w,h] := RGB(rr,gg,b);
    end;
  end;
  Result := True;

end;

procedure TFirstThread.Execute;
var
  c: Integer;
begin

  FreeOnTerminate := True;
  BmpToSepia(EBmp,20);


end;
end.

Код писал по памяти, по-этому, могут быть опечатки - не ругайте.

Так вот, в результате таких действий:
Код:
Unit MainForm;
...
...
uses SepiaThread
procedure...
...
var Thread: TSepiaThread;
begin
Thread := TSepiaThread.Create(Image1.Picture.Bitmap);
end;
Картинка исчезает вовсе.
Мне кажется, что все дело в том, что я либо не присваиваю Image1.Picture.Bitmap'у правильное значение либо как-то не так присваиваю внутренней переменной типа TBitmap потока входящую TBitmap...
Помогите пожалуйста разобраться.
__________________
THE CRACKER IS OUT THERE
Ответить с цитированием
  #2  
Старый 18.09.2006, 15:06
Аватар для Decoding
Decoding Decoding вне форума
Местный
 
Регистрация: 03.06.2006
Адрес: Почту найдете на моем сайте
Сообщения: 576
Версия Delphi: D10.2
Репутация: 214
По умолчанию

Частично ришил твою проблему

sepia.zip

Частично, потому, что не всегда прога нормально срабатывает с первого раза. Запусти ее, нажми на кнопку, и если в Image2 не отрисуется преобразованная картинка, нажми кнопку еще раз. Такое случается не всегда (я пока не понял, почему это происходит), и максимум со второго раза (по крайней мере у меня) прога срабатывает как надо.

В общем, поэксперементируй...
Ответить с цитированием
  #3  
Старый 18.09.2006, 15:50
Аватар для 4kusNick
4kusNick 4kusNick вне форума
Местный
 
Регистрация: 06.09.2006
Адрес: Россия, Санкт-Петербург
Сообщения: 444
Репутация: 550
По умолчанию

Спасибо.
Потестил:
После загрузки битмапки надо делаь так:
bm.PixelFormat := pf24bit;
Чтобы фильтр корректно ложился, а то у меня картинка становится черно-белой =)
А вообще, я-то на этом и остановился, о том иречь - что то фильтр применяется, то нет, и в чем проблема- не могу понять, спасибо за помощь, но, м.б. как-то можно все-таки избежать этого бага? =(
__________________
THE CRACKER IS OUT THERE
Ответить с цитированием
  #4  
Старый 19.09.2006, 01:01
AlexZL AlexZL вне форума
Новичок
 
Регистрация: 06.01.2006
Сообщения: 87
Репутация: 20
Стрелка

Цитата:
но, м.б. как-то можно все-таки избежать этого бага? =(
Можно, главное найти причину, почему оно то отрисовывается а то нет.
Итак, по порядку. Дело в том что TImage и TBitmap изначально не ThreadSafe классы и борланд в хелпах говорит что в многопоточной среде возможны баги. Но не стоит отчаиваться, в Канвасе есть специально приготовленные для нас методы Canvas.Lock и Canvas.Unlock (кажется Lock создает семафор, я особо не вдавался в подробности). Так вот, вызывая Lock мы блокируем доступ к канвасу из других thread'ов, а в конце, когда сделали все что хотели, вызываем unlock.

Конкретно по файлу, который выложил Decoding. Внутри TSepiaThread.Execute в самом начале пишем Form1.Image2.Canvas.Lock;
а в конце execut'а Form1.Image2.Canvas.Unlock; Да, еще убираем Synchronize( UpdateBmp ); внутри BmpToSepia, вместо него пишем просто UpdateBmp, иначе получим "DeadLock".
вот, все бы казалось работает, я запустил, отрисовывает, но на попытке 10й я снова увидел "белый" битмап. Баг опять повторялся, хотя теперь очень редко.
Тогда я еще вызвал Bmp.Canvas.Lock; и Bmp.Canvas.unLock; внутри метода BmpToSepia. Вот теперь все работает точно.

p.s. Больше бага не замечал, но кто знает, проверьте у себя.
уфф, чтото я много написал %)
Ответить с цитированием
Этот пользователь сказал Спасибо AlexZL за это полезное сообщение:
SpectraL (07.03.2015)
  #5  
Старый 20.09.2006, 11:09
Аватар для 4kusNick
4kusNick 4kusNick вне форума
Местный
 
Регистрация: 06.09.2006
Адрес: Россия, Санкт-Петербург
Сообщения: 444
Репутация: 550
По умолчанию

Спасибо, AlexZL, вроде бы у меня тоже без ошибок работает.
Бли, и как я сам-то не догадался? =)Совсем недавно как раз читал книгу про семафоры, критические секции и т.д.там как раз методы Lock и Unlock для Canvas'а были разобраны =)
Еще раз спасибо всем большое. Если вновь возникнут ошибки - отпишусь.
__________________
THE CRACKER IS OUT THERE
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 06:19.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter