Здравствуйте, Strannic, Вы писали:
S>Проблема щас в другом, точнее не проблема а непонятнка. Стартует поток Thread.Execute; но как только Execute выполнилось поток тут же вызывает DoTerminate. В итоге я не сильно соображаю, каким образом не завершать работу потока пока ему явно не придет на это команды??? Ну не делать же в Execute Repeat Until Terminated; — так же все ресурсы можно посадить!
Тут тебе необходимо в потоке организовать очередь сообщений.
Можно сделать ее самым банальным способом — создать в потоке окно и посылать к нему сообщения с помощью функций SendMessage (дождаться результата) и PostMessage (поставить сообщение в очередь и продолдать работать)
Создать окно AllocateHWnd и уничтожить DeallocateHWnd (юнит Forms.pas)
Твой поток будет выглядеть так:
const
MY_MESSAGE_BASE = CM_BASE + 1000;
MY_MESSAGE1 = MY_MESSAGE_BASE + 1; // sample message 1
MY_MESSAGE2 = MY_MESSAGE_BASE + 2; // sample message 2
type
TPluginThread = class (TThread)
private
FWndHandle: HWND;
protected
procedure WndProc(var Message: TMessage); virtual;
procedure Execute; override;
procedure Idle;
function ProcessMessage(var Msg: TMsg): Boolean;
procedure ProcessMessages;
private
procedure MyMessage1(var Message: TMessage); message MY_MESSAGE1;
procedure MyMessage2(var Message: TMessage); message MY_MESSAGE2;
public
property WndHandle: HWND read FWndHandle;
end;
implementation
procedure TPluginThread.Execute;
begin
try
FWndHandle := AllocateHWND (WndProc);
try
ProcessMessages;
finally
DeallocateHWnd (FWndHandle);
end;
except
// kill any exceptions
end;
end;
procedure TPluginThread.ProcessMessages;
var
Msg: TMsg;
begin
while not Terminated and ProcessMessage (Msg) do {loop};
end;
function TPluginThread.ProcessMessage(var Msg: TMsg): Boolean;
begin
Result := False;
if PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE) then
begin
if GetMessage (Msg, 0, 0, 0) then begin
Result := True;
if Msg.Message <> WM_QUIT then begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end else
Terminate;
end;
end else
WaitMessage;
Idle;
end;
procedure TPluginThread.Idle;
begin
{ do something if you want}
end;
procedure TPluginThread.WndProc(var Message: TMessage);
begin
try
Dispatch(Message);
except
// kill exceptions;
end;
end;
procedure TPluginThread.MyMessage1(var Message: TMessage);
begin
// do something
end;
procedure TPluginThread.MyMessage2(var Message: TMessage);
begin
// do something
end;
Пример посылки сообщения:
SendMessage (MyThread.WndHandle, MY_MESSAGE1, 0, 0)