Текущий архив: 2008.09.21;
Скачать: CL | DM;
Вниз
Работа с 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 и убивать там же?
Просто был момент, когда я создвал их в executeFM1:=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;
Скачать: CL | DM;
Память: 0.53 MB
Время: 0.017 c
