Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

 
 
Опции темы Поиск в этой теме Опции просмотра
  #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.
Ответить с цитированием
 


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 09:41.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter