Показать сообщение отдельно
  #8  
Старый 04.09.2023, 10:47
stalkernet stalkernet вне форума
Прохожий
 
Регистрация: 15.10.2017
Сообщения: 6
Версия Delphi: Delphi7
Репутация: 10
По умолчанию

Собственно решение найдено, но не все решено.
Огромное спасибо Всем за корректный пинок, на тему - кашу в голове нужно перемешивать, иначе - пригорает.

Вообщем траблы решены и вполне корректно - без костылей типа 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.
Ответить с цитированием