Собственно решение найдено, но не все решено.
Огромное спасибо Всем за корректный пинок, на тему - кашу в голове нужно перемешивать, иначе - пригорает.
Вообщем траблы решены и вполне корректно - без костылей типа Sleep. Правда 1 вопрос остался.
Итак то о чем забывают написать в мануалах. Опять-же - это мое понимание.
MsgWaitForMultipleObjects - во время ожидания обработка списка MSG не ведется. Если ожидается больше 1 MSG, в обработку передается только одно. какое из них ????? и обязатально application.ProcessMessages; после выхода. иначе обработка списка не начнется.
EventStatus := 1;
WaitForMultipleObjects - если присвоение и постановка в ожидание происходит меньше какого-то крит. минимума внутри SystemTick - значение не доежает до интерфейсной секции потока. Решения не нашел. костль тапа sleep ломается.
Код рабочий. Потоки контролируемые. ожидание не морозит форму. Лишнего процессорного времени не требует. Кому надо можно поставить потоки - каждому потоку по своему ядру. Проверен на 10 потоках в течении 12 часов. Ошибок не было. Наверно мало гонял. )))
По факту - написать оказалось проще и быстрее. даже с учетом граблей. больше времени ушло на понимание что-же авторы мануалов пытальсь сказать. Особенно в своих примерах. Осталось прикрутить Break потоков на выполнение дурной работы. Будут вопросы по коду - задавайте. Смогу отвечу.
Собственно код - на форме 1 кнопка и мемо. названия стандартные. FunTime - LIB для замера времени. можно выкинуть.
форма
Код:
const
THR_MSG = WM_USER + 666;
stop_MSG = WM_USER + 100;
private
TrWorkArr: TArray<THFind>;
MainFEventHandles: THandle;
{ Private declarations }
public
EvHandles: TArray<Tarray<THandle>>;
TrWorkResArr: TArray<uint32>;
SyncOK: uint32;
EndFlg: uint32;
ThrCnt: byte;
MList: TStringlist;
procedure THRMSG(var MSG: TMessage); message THR_MSG;
procedure THRMSGstop(var MSG: TMessage); message stop_MSG;
{ Public declarations }
end;
implementation
{$R *.dfm}
procedure TForm1.THRMSG(var MSG: TMessage);
begin
TrWorkResArr[MSG.WParam] := MSG.LParam;
MList.Add('Np ' + MSG.WParam.ToString +' FinRes '+ MSG.LParam.ToString);
end;
procedure TForm1.THRMSGstop(var MSG: TMessage);
begin
MList.Add('Np stop ' + MSG.WParam.ToString +' Sleep '+ MSG.LParam.ToString);
inc(EndFlg, 1);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i, n: uint32;
WaitHandle: TArray<THandle>;
waitres: integer;
WT: RecTime;
begin
ThrCnt := 4;
memo1.Clear;
MList := TStringlist.Create;
MainFEventHandles := CreateEvent(nil, True, False, nil);
setlength(EvHandles, ThrCnt);
setlength(TrWorkArr, ThrCnt);
setlength(TrWorkResArr, ThrCnt);
setlength(WaitHandle, ThrCnt);
for I := 0 to ThrCnt - 1 do begin
TrWorkResArr[i] := 0;
setlength(EvHandles[i], 2);
EvHandles[i, 0] := CreateEvent(nil, True, False, nil);
EvHandles[i, 1] := CreateEvent(nil, True, False, nil);
TrWorkArr[i] := THFind.Create(true);
TrWorkArr[i].FreeOnTerminate := true;
TrWorkArr[i].Priority := tpNormal;
TrWorkArr[i].MainHandle := MainFEventHandles;
TrWorkArr[i].FWinHandle := Form1.Handle;
TrWorkArr[i].FResumeHandle := EvHandles[i, 1];
TrWorkArr[i].FStopHandle := EvHandles[i, 0];
TrWorkArr[i].FIdx := i;
WaitHandle[i] := TrWorkArr[i].Handle;
end;
starttime(wt);
for n := 0 to 10 do begin
for I := 0 to ThrCnt - 1 do begin
if TrWorkArr[i].Suspended = true then TrWorkArr[i].Resume
else
SetEvent(EvHandles[i, 1]);
end;
try
EndFlg := 0;
SyncOk := 0;
while EndFlg <> ThrCnt do begin
MsgWaitForMultipleObjects(0, TrWorkArr, false, INFINITE, QS_SENDMESSAGE);
application.ProcessMessages;
end;
MList.Add('');
except
// ShowMessage('n ' + n.ToString);
end;
end;
stoptime(wt);
memo1.Lines := MList;
memo1.Lines.Add('OK');
Memo1.Lines.Add(DecodeRecTime(wt));
for I := 0 to ThrCnt - 1 do begin
SetEvent(EvHandles[i, 0]);
end;
MList.Free;
end;
end.
Поток
Код:
unit TTHFind;
interface
uses
Winapi.Windows, Winapi.Messages, System.Classes, System.Generics.Collections, math;
const
THR_MSG = WM_USER + 666;
stop_MSG = WM_USER + 100;
type
ThFind = class(TThread)
private
FEventHandles: array [0 .. 1] of THandle; // 0: immediate stop; 1: resume treatment
{ Private declarations }
public
FIdx: integer;
EventStatus: uint32;
FWinHandle, FResumeHandle, FStopHandle: THandle;
MainHandle: THandle;
FindResult: byte;
protected
procedure Execute; override;
end;
implementation
{ ThFind }
procedure ThFind.Execute;
var
WaitRes, n,sm: Integer;
begin
FEventHandles[0] := FStopHandle;
FEventHandles[1] := FResumeHandle;
sm := 0;
repeat
EventStatus := 0;
FindResult := 0;
if FIdx = 0 then sm := RandomRange(100, 200);
if FIdx = 1 then sm := RandomRange(1000, 2000);
if FIdx > 1 then sm := RandomRange(10, 100);
sleep(sm);
FindResult := 1;
SendMessage(FWinHandle, stop_MSG, FIdx, sm);
sendMessage(FWinHandle, THR_MSG, FIdx, FindResult);
EventStatus := 1;
WaitRes := WaitForMultipleObjects(2, @FEventHandles, false, INFINITE); // in end work
ResetEvent(FEventHandles[0]);
ResetEvent(FEventHandles[1]);
inc(sm, 1);
until WaitRes = WAIT_OBJECT_0; // ImmediateStop
free;
end;
end.