Форум: "Начинающим";
Текущий архив: 2008.09.21;
Скачать: [xml.tar.bz2];

Вниз

Работа с TCanvas из наследника класса TThread   Найти похожие ветки 

← →
Ябеда   (2008-08-07 16:14) [0]

Уважаемый Игорь Шевченко надеюсь сейчас тема оформлена должным образом?

Здравствуйте. Создаю один поток. Работает, но как-то не так. Этот поток по идее должен рисовать на канве главной формы. Вроде рисует, но стоит пошевелить курсором по форме - он умирает. Повидимому из-за перерисовки формы. Посмотрите плз код - где я ошибся или чего не учел.


unit Unit1;

interface

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

type
TNewThread = class(TThread)
  Text, FontName: string;
  FontSize, Speed, Width, Height, i: Integer;
  ColorText: TColor;
  bitmap, bit: tbitmap;
private
  procedure SetBitmap;
protected
  procedure Execute; override;
end;

type
TForm1 = class(TForm)
procedure StartThread;
  procedure FormCreate(Sender: TObject);
private
  { Private declarations }
public
  { Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

{ TNewThread }

procedure TNewThread.Execute;
var
x, a, b: integer;
begin

bit.Canvas.Font.Name := FontName;
bit.Canvas.Font.Size := FontSize;
bit.Canvas.Font.Color := ColorText;
bit.Canvas.Brush.Style := bsclear;
bit.Width := width;
bit.Height := bit.Canvas.TextHeight("W") + 5;
b := -bit.Canvas.TextWidth(Text);

while 1 = 1 do
begin
  x := width;
  while x > b do
  begin
    bit.canvas.Draw(0, 0, bitmap);
    bit.Canvas.TextOut(x, 0, Text);
    Synchronize(SetBitmap);
    sleep(speed);
    dec(x, 1);
  end;
end;

bitmap.Free;
bit.Free;
end;

procedure TNewThread.SetBitmap;
begin
form1.canvas.Draw(0, 0, bit);
end;

procedure TForm1.StartThread;
var
NewThread: TNewThread;
bitmap:tbitmap;
begin
bitmap:=tbitmap.Create;
bitmap.Width:=Width;
bitmap.Height:=Height;

NewThread := TNewThread.Create(true);
NewThread.FreeOnTerminate := true;
NewThread.Priority := tpLower;
NewThread.Text := "Бла-бла-бла-бла-бла-бла";
NewThread.FontName := "Arial";
NewThread.FontSize := 40;
NewThread.Speed := 40;
NewThread.Width := width;
NewThread.Height := height;
NewThread.ColorText := clred;
NewThread.bitmap := tbitmap.Create;
NewThread.Bit := tbitmap.Create;
NewThread.bitmap.Assign(bitmap);
NewThread.Resume;

bitmap.Free;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
StartThread;
end;

end.

---

← →
Ябеда   (2008-08-07 16:14) [1]

> Palladin ©   (07.08.08 15:54) [1]
> :)

Громозкий? Лишних поля выведены? Знаю. :) Это уже от иногочисленных переделок. Уже заколебался биться над ним. Или бесполезно на канву лезть из потоков?

---

← →
Игорь Шевченко ©   (2008-08-07 16:21) [2]

> Или бесполезно на канву лезть из потоков?


на канву созданного битмапа - вполне полезно лезть

---

← →
Сергей М. ©   (2008-08-07 16:21) [3]

> бесполезно на канву лезть из потоков?


А ты собссно и не лезешь - обращение к канве битмапа на форме у тебя осуществляется в основном потоке.

---

← →
Ябеда   (2008-08-07 16:41) [4]

Чесно говоря я непонял о какой канве битмапа идет речь, когда я пытаюсь рисовать на форме. Но, чтоб убрать непонятки, я чуть изменил код, результат к сожалению тот же (


unit Unit1;

interface

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

type
 TNewThread = class(TThread)
   Text, FontName: string;
   FontSize, Speed, Width, Height, i: Integer;
   ColorText: TColor;
   bitmap, bit: tbitmap;
 private
   procedure SetBitmap;
 protected
   procedure Execute; override;
 end;

type
 TForm1 = class(TForm)
 procedure StartThread;
   procedure FormShow(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.FormShow(Sender: TObject);
begin
 StartThread;
end;

procedure TForm1.StartThread;
var
 NewThread: TNewThread;
 bitmap:tbitmap;
begin

 NewThread := TNewThread.Create(true);
 NewThread.FreeOnTerminate := true;
 NewThread.Priority := tpLower;
 NewThread.Text := "Áëà-áëà-áëà-áëà-áëà-áëà";
 NewThread.FontName := "Arial";
 NewThread.FontSize := 40;
 NewThread.Speed := 40;
 NewThread.Width := width;
 NewThread.Height := height;
 NewThread.ColorText := clred;
 NewThread.Resume;

end;

{ TNewThread }

procedure TNewThread.Execute;
var
 x, a, b: integer;
begin

 bit:=tbitmap.Create;
 bitmap:= tbitmap.Create;
 bitmap.Width:=Width;
 bitmap.Height:=Height;
 bitmap.Canvas.Rectangle(0,0,500,500);
 bit.Canvas.Font.Name := FontName;
 bit.Canvas.Font.Size := FontSize;
 bit.Canvas.Font.Color := ColorText;
 bit.Canvas.Brush.Style := bsclear;
 bit.Width := width;
 bit.Height := bit.Canvas.TextHeight("W") + 5;
 b := -bit.Canvas.TextWidth(Text);

 while 1 = 1 do
 begin
 x := width;
   while x > b do
   begin
     bit.canvas.Draw(0, 0, bitmap);
     bit.Canvas.TextOut(x, 0, Text);
     Synchronize(SetBitmap);
     sleep(speed);
     dec(x, 1);
   end;
 end;

 bitmap.Free;
 bit.Free;
end;

procedure TNewThread.SetBitmap;
begin
 form1.canvas.Draw(0, 0, bit);
end;

end.

---

← →
Сергей М. ©   (2008-08-07 17:11) [5]

> обращение к канве битмапа на форме


Читать как

"обращение к канве формы"

Но суть от этого не меняется - все равно обращение у тебя происходит в основном потоке.

---

← →
Сергей М. ©   (2008-08-07 17:19) [6]

> стоит пошевелить курсором по форме - он умирает


Совсем ? Значит, где-то в коде поточной ф-ции возникло необработанное исключение.

---

← →
Ябеда   (2008-08-07 17:54) [7]

Перенес
bit.canvas.Draw(0, 0, bitmap);
bit.Canvas.TextOut(x, 0, Text);

в SetBitmap вроде усе нормально заработало. Почему там выкидывало так и не понял

---

← →
antonn ©   (2008-08-07 19:52) [8]

пользуясь случаем, спрошу :)
у меня есть класс, в него загружаются некие данные, бывает что долго и это подвешивает поток, в котором он работает (а работает он "рядом" с vcl и из-за этого программа тормозит, в общем как и должно).
Я для этого класса сделал загрузку данных через поток - поток сначала берет некие данные, обрабатывает и уже обработанное одним махом передает классу.

так вот, вообще нормально делать такой конструктор потока?
constructor TModelLoadThread.Create(CreateSuspennded: Boolean; Sender:TDModel);
begin
 inherited Create(true);
 FDModel:=Sender;

а в одном из методов класса вызов:
FModelLoadThread:=TModelLoadThread.Create(false,self);

т.е. передача ссылки в этом случае безопасна? в Synchronize() я могу потом обратиться к FDModel (а таким образом к классу породившему поток) и все будет правильно "разрулено"? С ссылкой ничего не может случиться (просто хендл меняющийся у формы один раз наколол, так вот уже от всего шарахаюсь...)?

---

← →
Тын-Дын ©   (2008-08-07 20:01) [9]

> и все будет правильно "разрулено"?


Если будешь использовать методы синхронизации при доступе к полям из разных потоков, то всё будет правильно.

---

← →
antonn ©   (2008-08-07 20:09) [10]

а еще вопрос, на всякий случай :)
дуструктор этого потока:
destructor TModelLoadThread.Destroy;
begin
FM1.Free;
FM2.Free;

Terminate;
inherited Destroy;
end;

Чет меня смущает это ворот с terminate и inherited :)

(FM1 и 2 - это стримы, создаются в конструкторе, убивается в деструкторе, используется только в execute, в "служебных целях"). Или правильнее такие вещи создавать в самом Execute и убивать там же?
Просто был момент, когда я создвал их в execute
FM1:=TmemoryStream.create;
try
//тра-ля-ля
 Synchronize(Back);
finally
FM1.free;
end;
и иногда при выполнении выскакивала AV при работе с этим стримом (адрес как обычно 000001 :( ). После перезапуска среды я их больше не увидел, но след они оставили :)

---

← →
{RASkov} ©   (2008-08-07 20:12) [11]

> просто хендл меняющийся у формы один раз наколол, так вот
> уже от всего шарахаюсь...)?

хендл и self это разные вещи. Первое свойство, которому не грех и смениться, а второе указатель на данные и если он смениться, то что будет?)

---

← →
antonn ©   (2008-08-07 20:16) [12]

> и если он смениться, то что будет?

армагеддончик? :)

---

← →
Loginov Dmitry ©   (2008-08-07 20:37) [13]

> Посмотрите плз код - где я ошибся или чего не учел.


Не умеешь работать с битмапом в доп. потоке. Попробуй так:


procedure TNewThread.Execute;
var
x, a, b: integer;
begin
 bit.Canvas.Lock;
 try
   bit.Canvas.Font.Name := FontName;
   bit.Canvas.Font.Size := FontSize;
   bit.Canvas.Font.Color := ColorText;
   bit.Canvas.Brush.Style := bsclear;
   bit.Width := width;
   bit.Height := bit.Canvas.TextHeight("W") + 5;
   b := -bit.Canvas.TextWidth(Text);
 finally
   bit.Canvas.Unlock;
 end;

 while 1 = 1 do
 begin
   x := width;
   while x > b do
   begin
     bit.Canvas.Lock;
     bitmap.Canvas.Lock;
     try
       bit.canvas.Draw(0, 0, bitmap);
       bit.Canvas.TextOut(x, 0, Text);
     finally
       bit.Canvas.Unlock;
       bitmap.Canvas.Unlock;
     end;

     Synchronize(SetBitmap);
     sleep(speed);
     dec(x, 1);
   end;
 end;

 bitmap.Free;
 bit.Free;
end;


---

← →
Loginov Dmitry ©   (2008-08-07 20:41) [14]

> Чет меня смущает это ворот с terminate и inherited :)


destructor TThread.Destroy;
begin
 if (FThreadID <> 0) and not FFinished then
 begin
   Terminate;
.............


> (FM1 и 2 - это стримы, создаются в конструкторе, убивается
> в деструкторе, используется только в execute, в "служебных
> целях"). Или правильнее такие вещи создавать в самом Execute
> и убивать там же?


Без разницы


> Просто был момент, когда я создвал их в execute
> FM1:=TmemoryStream.create;
> try
> //тра-ля-ля
> Synchronize(Back);
> finally
> FM1.free;
> end;
> и иногда при выполнении выскакивала AV при работе с этим
> стримом


17-я строка

---

← →
antonn ©   (2008-08-07 20:46) [15]

> 17-я строка

18-я...
говорю же перезапустил дельфи, больше не видел, но след в душе остался :)

---

← →
Ябеда   (2008-08-08 07:02) [16]

> Loginov Dmitry ©   (07.08.08 20:37) [13]


К сожелению тоже самое :(

Мой вариант с переносом части кода в синхронизируемую процедуру более стабильный.

---

← →
Loginov Dmitry ©   (2008-08-08 08:02) [17]

> тоже самое


Не верю!

Примени TCanval.Lock к [4] так, чтобы все обращения к обоим битмапам были защищены! Нет причин, чтобы это не работало. Если все-равно не работает, значит происходит вылет из доп. потока из-за ошибки, значит нужно организовать вывод ошибок в лог и потом определить, на чем именно ошибка. Если и это - никак, выложи тестовый пример где-нибудь в инете, разберемся.

---

← →
Игорь Шевченко ©   (2008-08-08 10:20) [18]

Рисовать на форме надо в обработчике события OnPaint

А в процедуре SetBitmap надо копировать нужное изображение в промежуточный битмап и вызывать метод формы Invalidate

---

Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2008.09.21;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.5 MB
Время: 0.006 c