|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#8
|
|||
|
|||
Собственно решение найдено, но не все решено.
Огромное спасибо Всем за корректный пинок, на тему - кашу в голове нужно перемешивать, иначе - пригорает. Вообщем траблы решены и вполне корректно - без костылей типа 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. |