Collection и Thread

← →
Phoroon © (2006-12-10 22:45) [0]

Привет всем!!!

Вот такой вопрос возник: есть структура типа collection и в Collectionitem создан поток. Но execute потока выполняет событие OnWork (пример: в OnWork написан цикл заполнения прогресс бара). Так вот, когда работает один поток из структуры Collection приложению он не мешает, а вот если несколько, то пока не закончится первый запущенный, второй не наченается и приложение занято.

Вот листинг CollectionItem
type
TMSLItemPropertyThread = class(TCollectionItem)
private
Thread: TMSLWorkThread;

FOnExecute: TNotifyEvent;
FFreeOnTerminate: boolean;
FOnPause: TNotifyEvent;
FOnFinish: TNotifyEvent;
FOnResume: TNotifyEvent;
FOnTerminated: TNotifyEvent;
FOnStart: TNotifyEvent;
FRunOnExecute: boolean;
FPriority: TThreadPriority;
FOnWork: TNotifyEvent;

procedure SetPriority(const Value: TThreadPriority);

procedure DoFinish(Sender: TObject);
procedure DoTerminated(Sender: TObject);
procedure DoStart(Sender: TObject);
procedure DoPause(Sender: TObject);
procedure DoResume(Sender: TObject);
procedure DoExecute(Sender: TObject);

public
//системные методы
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;

//Внешние методы
procedure Start;
procedure Execute;
procedure Terminate;
procedure Stop;
procedure Pause;
procedure Resume;

published
//Свойства
property Priority: TThreadPriority read FPriority write SetPriority default tpNormal;
property FreeOnTerminate: boolean read FFreeOnTerminate write FFreeOnTerminate default true;
property RunOnExecute: boolean read FRunOnExecute write FRunOnExecute default true;

//События
property OnFinish: TNotifyEvent read FOnFinish write FOnFinish;
property OnTerminated: TNotifyEvent read FOnTerminated write FOnTerminated;
property OnStart: TNotifyEvent read FOnStart write FOnStart;
property OnPause: TNotifyEvent read FOnPause write FOnPause;
property OnResume: TNotifyEvent read FOnResume write FOnResume;
property OnExecute: TNotifyEvent read FOnExecute write FOnExecute;
property OnWork: TNotifyEvent read FOnWork write FOnWork;

end;

{TMSLItemPropertyThread}
constructor TMSLItemPropertyThread.Create(Collection: TCollection);
begin
inherited Create(Collection);

FPriority:=tpNormal;
FRunOnExecute:=true;
FFreeOnTerminate:=true;
end;

destructor TMSLItemPropertyThread.Destroy;
begin
if Thread <> nil then begin
Thread.Terminate;
Thread.Free;
Thread:=nil;
end;

inherited Destroy;
end;

procedure TMSLItemPropertyThread.Assign(Source: TPersistent);
begin

inherited Assign(Source);
end;

procedure TMSLItemPropertyThread.Execute;
begin
Thread:=TMSLWorkThread.Create();

with Thread do begin
OnFinishThread:=DoFinish;
OnTerminatedThread:=DoTerminated;
OnStartThread:=DoStart;
OnPauseThread:=DoPause;
OnResumeThread:=DoResume;
OnExecuteThread:=DoExecute;

PriorityThread:=FPriority;
RunOnExecuteThread:=FRunOnExecute;
FreeOnTerminateThread:=FFreeOnTerminate;
Sender:=Self;
end;

Thread.ExecuteThread;
end;

procedure TMSLItemPropertyThread.SetPriority(const Value: TThreadPriority);
begin
if FPriority <> Value then FPriority := Value;
end;

procedure TMSLItemPropertyThread.DoExecute(Sender: TObject);
begin
if Assigned(FOnExecute) then FOnExecute(Self);
end;

procedure TMSLItemPropertyThread.DoFinish(Sender: TObject);
begin
if Assigned(FOnFinish) then FOnFinish(Self);
end;

procedure TMSLItemPropertyThread.DoPause(Sender: TObject);
begin
if Assigned(FOnPause) then FOnPause(Self);
end;

procedure TMSLItemPropertyThread.DoResume(Sender: TObject);
begin
if Assigned(FOnResume) then FOnResume(Self);
end;

procedure TMSLItemPropertyThread.DoStart(Sender: TObject);
begin
if Assigned(FOnStart) then FOnStart(Self);
end;

procedure TMSLItemPropertyThread.DoTerminated(Sender: TObject);
begin
if Assigned(FOnTerminated) then FOnTerminated(Self);
end;

procedure TMSLItemPropertyThread.Pause;
begin
Thread.PauseThread;
end;

procedure TMSLItemPropertyThread.Resume;
begin
Thread.ResumeThread;
end;

procedure TMSLItemPropertyThread.Start;
begin
Thread.StartThread;
end;

procedure TMSLItemPropertyThread.Stop;
begin
Thread.StopThread;
end;

procedure TMSLItemPropertyThread.Terminate;
begin
Thread.TerminateThread;
end;

Вот листинг Потока
{TMSLWorkThread}
type
TMSLWorkThread = class(TMSLBaseThread)
protected
procedure Work; override;

public
Sender: TObject;

end;

{ TMSLWorkThread }
procedure TMSLWorkThread.Work;
begin
if Assigned((sender as TMSLItemPropertyThread).OnWork) then
(sender as TMSLItemPropertyThread).OnWork(Sender);
end;

← →
Джо © (2006-12-10 22:55) [1]

Я не вижу метода Execute в исходнике потока.

← →
MetalFan © (2006-12-10 23:01) [2]

смешали все в кучу... назавния методов наследника TCollectionItem совпадают по логике названия с методами TThread....
и [1] кстати да...
видисо execute в предке TMSLBaseThread

← →
Phoroon © (2006-12-10 23:26) [3]

метод execute в предке вызывает

вот листинг базового потока

{TMSLBaseThread}
type
TMSLBaseThread = class(TThread)
private
//Поля событий
FOnFinishThread,
FOnTerminatedThread,
FOnStartThread,
FOnPauseThread,
FOnResumeThread,
FOnExecuteThread: TNotifyEvent;

//Поля свойств
FFreeOnTerminateThread: boolean;
FRunOnExecuteThread: boolean;
FPriorityThread: TThreadPriority;

//Методы свойств
procedure SetPriorityThread(const Value: TThreadPriority);
procedure SetRunOnExecuteThread(const Value: boolean);

protected
//Системные методы
procedure Execute; override;
procedure Work; virtual; abstract; //Определить при сборке

//Внутренние методы
procedure DoTerminateThread(Sender: TObject);

public
//Системные методы
constructor Create(CreateSuspended: Boolean = true); virtual;
destructor Destroy; override;

//Внешние методы
procedure StartThread;
procedure ExecuteThread;
procedure TerminateThread;
procedure StopThread;
procedure PauseThread;
procedure ResumeThread;

published
//Свойства
property PriorityThread: TThreadPriority read FPriorityThread write SetPriorityThread default tpNormal;
property FreeOnTerminateThread: boolean read FFreeOnTerminateThread write FFreeOnTerminateThread default true;
property RunOnExecuteThread: boolean read FRunOnExecuteThread write SetRunOnExecuteThread default true;

//События
property OnFinishThread: TNotifyEvent read FOnFinishThread write FOnFinishThread;
property OnTerminatedThread: TNotifyEvent read FOnTerminatedThread write FOnTerminatedThread;
property OnStartThread: TNotifyEvent read FOnStartThread write FOnStartThread;
property OnPauseThread: TNotifyEvent read FOnPauseThread write FOnPauseThread;
property OnResumeThread: TNotifyEvent read FOnResumeThread write FOnResumeThread;
property OnExecuteThread: TNotifyEvent read FOnExecuteThread write FOnExecuteThread;

end;

{TMSLBaseThread +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
constructor TMSLBaseThread.Create(CreateSuspended: Boolean);
begin
inherited Create(CreateSuspended);

FPriorityThread:=tpNormal;
FRunOnExecuteThread:=true;
FreeOnTerminateThread:=true;
end;

destructor TMSLBaseThread.Destroy;
begin
if Self.Terminated = false then
Self.Terminate;

inherited;
end;

procedure TMSLBaseThread.Execute;
begin
//Synchronize(Self, Work());
Work;
if Assigned(FOnFinishThread) then FOnFinishThread(Self);
end;

procedure TMSLBaseThread.ExecuteThread;
begin
if Assigned(FOnExecuteThread) then FOnExecuteThread(Self);
OnTerminate:=DoTerminateThread;

Priority:=FPriorityThread;
FreeOnTerminate:=FFreeOnTerminateThread;

Self.Create(not FRunOnExecuteThread);
//if FRunOnExecuteThread = true then
//if Assigned(FOnStartThread) then FOnStartThread(Self);
end;

procedure TMSLBaseThread.DoTerminateThread(Sender: TObject);
begin
if Assigned(FOnTerminatedThread) then FOnTerminatedThread(Self);
end;

procedure TMSLBaseThread.PauseThread;
begin
if Assigned(FOnPauseThread) then FOnPauseThread(Self);
Suspend;
end;

procedure TMSLBaseThread.ResumeThread;
begin
if Assigned(FOnResumeThread) then FOnResumeThread(Self);
Resume;
end;

procedure TMSLBaseThread.StartThread;
begin
if Assigned(FOnStartThread) then FOnStartThread(Self);
Self.Create(false);
end;

procedure TMSLBaseThread.StopThread;
begin
if Assigned(FOnTerminatedThread) then FOnTerminatedThread(Self);
Terminate;
end;

procedure TMSLBaseThread.TerminateThread;
begin
Self.Terminate;
end;

procedure TMSLBaseThread.SetPriorityThread(const Value: TThreadPriority);
begin
if FPriorityThread <> Value then begin
FPriorityThread:=Value;
Self.Priority:=FPriorityThread;
end;
end;

procedure TMSLBaseThread.SetRunOnExecuteThread(const Value: boolean);
begin
if FRunOnExecuteThread <> Value then
FRunOnExecuteThread:=Value;

end;

← →
Phoroon © (2006-12-10 23:28) [4]

> смешали все в кучу... назавния методов наследника TCollectionItem
> совпадают по логике названия с методами TThread....

такое переопределение нужно лишь для показа свойств потока

← →
DrPass © (2006-12-11 01:02) [5]

> а вот если несколько, то пока не закончится первый запущенный,
> второй не наченается и приложение занято.

Сам по себе твой исходник ни о чем не говорит. Если, конечно, ты правильно определил симптомы, скорее всего ты просто используешь Synchronize в своем OnWork

← →
Германн © (2006-12-11 01:20) [6]

> Phoroon © (10.12.06 23:26) [3]

Проясни следущий фрагмент:

> procedure TMSLBaseThread.Execute;
> begin
> //Synchronize(Self, Work());
>

← →
Anatoly Podgoretsky © (2006-12-11 07:43) [7]

> Германн (11.12.2006 1:20:06) [6]

Это комментарий, ниже Work

← →
Сергей М. © (2006-12-11 08:43) [8]

А это что за жуть

> Self.Create(not FRunOnExecuteThread);

> Self.Create(false);

?

← →
Phoroon © (2006-12-11 10:16) [9]

> Self.Create(not FRunOnExecuteThread);

Это совершенно не жуть.
Эсли ты не умеешь хорошо смотреть исходник, тебе никто не виноват.

Пояснение:
FRunOnExecuteThread - поле свойства property RunOnExecute: boolean read FRunOnExecute write FRunOnExecute default true;

Если при создании потока указать false, то поток стартует при создании.
А свойство приводит к более приемлемому виду. По этому и написанно Self.Create(not FRunOnExecuteThread);

← →
Phoroon © (2006-12-11 10:18) [10]

> Сам по себе твой исходник ни о чем не говорит. Если, конечно,
> ты правильно определил симптомы, скорее всего ты просто
> используешь Synchronize в своем OnWork

Не использую.

procedure TMSLWorkThread.Work;
begin
if Assigned((sender as TMSLItemPropertyThread).OnWork) then
(sender as TMSLItemPropertyThread).OnWork(Sender);
end;

← →
Phoroon © (2006-12-11 10:20) [11]

> Проясни следущий фрагмент:> procedure TMSLBaseThread.Execute;
> > begin> //Synchronize(Self, Work());>

Этот вопрос на прямую связан с
> [5]

На этот метод можно не обращать внимания.

← →
Сергей М. © (2006-12-11 10:27) [12]

> Это совершенно не жуть

Еще какая жуть !

Self в дан.контексте - текущий экземпляр класса, а не сам класс.
Этой строчкой ты требуешь от текущего экземпляра класса создать еще один экземпляр того же класса, что в даном случае и есть жуть.

← →
Phoroon © (2006-12-11 15:03) [13]

> Еще какая жуть !

Действительно, это полная жуть.

Извеняюсь за > [9] резкость.

Заменил на suspend, resume. Все нормально работает.

Спасибо всем!!!

> Сергей М. (11.12.2006 10:27:12) [12]

Не еще один, а переинициализировать данный, это уже не коструктор, а метод.

> Anatoly Podgoretsky © (11.12.06 15:21) [14]

Да, согласен, замечание важное и по существу.
Впрочем, сути это не меняет - в ходе иниц-ции создается еще один поток (как ОС-объект) и с этого места начинается жуть)

Насколько я понял, вы про этот кусок.

> constructor TMSLBaseThread.Create(CreateSuspended: Boolean);
> begin inherited Create(CreateSuspended);FPriorityThread:=tpNormal;
> FRunOnExecuteThread:=true;FreeOnTerminateThread:=true;end;
>

Но если inherited Create(CreateSuspended); убрать, то он пишет ошибку "Не верный дескриптор".

Вывод: предок данного класса не создается, соответственно и данный поток не может быть создан.

Если про этот кусок, то здесь убрал конструктор.

> procedure TMSLBaseThread.StartThread;beginif Assigned(FOnStartThread)
> then FOnStartThread(Self);
>Self.Create(false);
>end;

> если inherited Create(CreateSuspended); убрать, то он пишет
> ошибку "Не верный дескриптор".

Все правильно.
В методе Create предка как раз и создается собственно поток как объект ОС. Если не вызвать этот метод в наследнике, поток создан не будет, и любое обращение к несуществующему хэндлу несуществующего же потока приведет к оной ошибке, что вполне очевидно.

> Вывод: предок данного класса не создается

Точнее - не инициализируется.

Collection и Thread Найти похожие ветки