Нити потоки TThread кому интересно тыкайте.

← →
Serge_ © (2004-07-27 00:17) [0]

{Тут много вопросов задается про нити (потоки)
вот я и решил это написАть
Главная проблема возникающая при работе с нитями
это синхронизация
когда две нити используют один и тот-же контрол
возникает необходимость синхронизации.
в TThread есть метод Synchronize.
Но он очень не удобен так как
его параметер это простая процедура
соответсвенно если надо передать какие-то параметры
синхронизируемому методу надо описывать переменные в секции private
нашей нити неговоря уже о том что надо описывать сам этот метод
это конечно нормально когда у вас он один, а если 100
я в свое время сталкнувшись с эти гимороем написАл
простенький класс TSyncroWalker используя который можно забыть об описАнии методов и т.п.
а просто использовать методы контрола напрямую
конечно не забыв при этом вызвать функцию LockControl
естественно обрашаться к этому контролу из главной нити можно тоже
только через синхронизатор...}

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
type TSynchroWalker = class
private
FLock:TRTLCriticalSection;
FControl:TControl;
public
constructor Create(aowner:TControl);
destructor Destroy;override;
Function LockControl:TControl;
procedure UnlockControl;
end;

type TDummyThread = Class(TThread)
protected
procedure Execute;Override;
public
OutPutTo:TSynchroWalker;
MyIndex:integer;
end;

var
Form1: TForm1;
GlobalSyncMemo:TSynchroWalker;
Index:integer=0;
ThreadList:Tlist;
FormClosing:Boolean=False;
implementation
{$R *.dfm}

constructor TSynchroWalker.Create(aowner:tcontrol);
begin
InitializeCriticalSection(FLock);
FControl:=aowner;
end;

destructor TSynchroWalker.Destroy;
begin
DeleteCriticalSection(FLock);
Inherited Destroy;
end;

function TSynchroWalker.LockControl:TControl;
begin
EnterCriticalSection(FLock);
Result:=FControl;
end;

procedure TSynchroWalker.UnlockControl;
begin
LeaveCriticalSection(FLock);
end;

procedure TDummyThread.Execute;
var Memo:Tmemo;
begin
while not Terminated do begin
Memo:=OutPutTo.LockControl as TMemo;
Memo.Lines.Add("Строка добавлена нитью № "+inttostr(MyIndex));
if memo.Lines.Count>100 then memo.Lines.Clear;
OutPutTo.UnlockControl;
{Как неследует делать:
TMemo(OutPutTo.LockControl).Lines.Add("xxxx");
TMemo(OutPutTo.LockControl).Lines.Clear; <- ;-))))
Не надо 2 раза подрят вызывать функцию LockControl
каждый последующий вызов делайте после вызова UnlockControl
Нето повесите все нити(потоки) использующие этот синхронизатор
}
end;
Sleep(0); //<- Нужна для тупого метода WaitFor ...
end;

procedure TForm1.Button1Click(Sender: TObject);
var Thread:TDummyThread;
begin
Inc(index);
Label1.Caption:="Нитей запущено: "+Inttostr(Index);
Thread:=TDummyThread.Create(True);
Thread.OutPutTo:=GlobalSyncMemo;
Thread.MyIndex:=Index;
ThreadList.Add(Thread);
Thread.Resume;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ThreadList:=Tlist.Create;
GlobalSyncMemo:=TSynchroWalker.Create(memo1);
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var i:integer;
Thread:TDummyThread;
begin
//Конечно можно это все сменить на ExitProcess(0)... ;)
//Но только в данном случае.
if FormClosing then exit;
FormClosing:=True;
for i:=0 to ThreadList.Count-1 do begin
Thread:=ThreadList[i];
Label1.Caption:="Уничтожаю нить №: "+Inttostr(Thread.MyIndex);
Application.ProcessMessages;
Thread.Terminate;
Thread.WaitFor;
Thread.Free;
Dec(Index);
end;
CanClose:=True;
end;

end.

← →
Mental_Ray © (2004-07-27 07:23) [1]

Неплохо!

← →
TUser © (2004-07-27 09:08) [2]

> это конечно нормально когда у вас он один, а если 100
Ну у меня их сейчас порядка 25. Если надо будет - еще 75 добавлю.

← →
Digitman © (2004-07-27 10:01) [3]

"тыкаю"

код этот не имеет ничего общего с обеспечением требований по синхронизации обращений к VCL-контролам с основным тредом

применение в дан.случае крит.секции не дает никакой гарантии, что исключение canvas doesn"t allow drawing никогда не возникнет.. потому что внутренняя логика обращения контролов к своей канве (например, для обновления-перерисовки отдельных областей) знать ничего не знает ни о каких прикладных крит.секциях

← →
Андрей Л. (2004-07-27 10:44) [4]

Хоть бы помечали, как код, а то смотреть обычный текст совсем не удобно...

← →
Serge_ © (2004-07-29 10:42) [5]

Нус, у TMemo нет канваса ;)))
Но это не главноЕ, я тут проверил ваше предположение
на TLabel , запустил 150 нитей -> все работает....
нуу, без ошибок и исключений естессно.....

← →
Rem (2004-07-29 11:18) [6]

>>без ошибок и исключений естессно
Подробнее об условиях проведения испытания, пожалуйста.
При этом у меня вопрос: Сколько раз происходила прорисовка компонента в основном потоке? Совпадала ли по времени прорисовка в основном потоке с прорисовкой в дополнительных потоках?

← →
Sun bittern © (2004-07-29 11:33) [7]

Serge_ © (29.07.04 10:42) [5]

>> Нус, у TMemo нет канваса ;)))

Ну а на чем же он рисует? Вот в чем вопрос. :)))

← →
Digitman © (2004-07-29 11:57) [8]

> Serge_ © (29.07.04 10:42) [5]

> у TMemo нет канваса

не суть как важно.
на месте TMemo завтра окажется любой иной контрол, имеющий канву, тот же TLabel, упомянутый тобой

> проверил ваше предположение
> на TLabel , запустил 150 нитей -> все работает....

.. да, работает ... до тех пор 151-я нить (основная) не сподобится неявно обратиться к канве этого TLabel

← →
Serge_ © (2004-07-29 12:58) [9]

А можно узнать каким это НЕЯВНЫМ образом нить обратится к канве?
Если можно назовите хотябы одно из этих неявных обращенний.

← →
Sun bittern © (2004-07-29 13:12) [10]

to [10] вот Рабочий кусок...
никаких исключений...
при том что запущено 150 нитей каждая из них меняет TLabel.Caption, и в главной ните в бесконечно цикле
идет обращение к канве по ее хендлу...
все работает, господин Digitman
дак о каких неявных вызовах идет речь?

procedure TForm1.Button2Click(Sender: TObject);
var gc:TLabel;
BH,CH:DWORD;
r:TRect;
begin
gc:=TLabel(GlobalSyncLabel.LockControl);
CH:=gc.Canvas.Handle;
BH:=gc.Canvas.Brush.Handle;
r:=gc.Canvas.ClipRect;
GlobalSyncLabel.UnlockControl;
while true do begin
application.processmessages;
FillRect(CH,r,bh);
application.processmessages;
end;
end;

вот тебе пример :

procedure TCanvas.Lock;
begin
EnterCriticalSection(CounterLock);
Inc(FLockCount);
LeaveCriticalSection(CounterLock);
EnterCriticalSection(FLock);
end;

procedure TGraphicControl.WMPaint(var Message: TWMPaint);
begin
if Message.DC <> 0 then
begin
Canvas.Lock;
try
Canvas.Handle := Message.DC;
try
Paint;
finally
Canvas.Handle := 0;
end;
finally
Canvas.Unlock;
end;
end;
end;

а теперь попробуй возразить, что сообщение WM_PAINT не может возникнуть в произвольный момент времени

а вот еще

procedure FreeDeviceContext;
var
I: Integer;
begin
with CanvasList.LockList do
try
for I := 0 to Count-1 do
with TControlCanvas(Items[I]) do
if TryLock then //False, если другой трэд выполнил TCanvas.Lock
try
//это, соответственно, не выполнится
FreeHandle;
Exit;
finally
Unlock;
end;
finally
CanvasList.UnlockList;
end;
end;

Я и не собираюсь возражать,
давай мы спорить не будем просто, пожалуйста приведи мне код который вызовет исключение....

Нити потоки TThread кому интересно тыкайте. Найти похожие ветки