Возникла новая проблема.
Собственно все работает как и должно работать, но...
Суть в следующем - потоки запускаются в цикле, их количество может быть несколько тысяч, ограничиваю число одновременно работающих
Код:
unit Unit1;
...
var
Form1: TForm1;
ThrdCount: Byte;
implementation
...
procedure TForm1.btnCheckClick(Sender: TObject);
var Checker: TUrlCheckThrd;
Indx: Integer;
begin
for Indx := First to Last do
begin
Checker:= TUrlCheckThrd.Create;
...
Inc(ThrdCount);
while ThrdCount>7 do Sleep(500); //тут окно и зависает
end;
end;
Пинать главную форму Application.ProcessMessages - не вариант, не для того я программу с нуля переписываю.
Решил создать поток, который будет запускать остальные потоки, так сказать "родительский", эти остальные будут посылать сообщение о своем завершении,
Код:
unit MyThread;
.....
procedure TUrlCheckThrd.Execute;
begin
....
Synchronize(CallMainForm);
SendMessage(FWND,DEC_THRDCOUNT,0,0);
end;
а "родительский" отлавливать
Код:
unit MainThread;
..........
type
TMainThread = class(TThread)
private
FThrdCount: Byte;
...........
procedure SetThrdCount(var Msg: TMessage); message DEC_THRDCOUNT;
protected
procedure Execute; override;
.............
end;
implementation
procedure TMainThread.SetThrdCount(var Msg: TMessage);
begin
Dec(FThrdCount);
end;
procedure TMainThread.Execute;
var Checker: TUrlCheckThrd;
Indx: Integer;
begin
for Indx := FFirst to FLast do
begin
Checker:= TUrlCheckThrd.Create(FCallForm, Self.Handle); // дочерний поток получает хэндл родительского
...............
Checker.Start;
Inc(FThrdCount);
while FThrdCount>7 do Sleep(500);
end;
end;
но то что сработало с формой не работает с потоком, то ли поток не слушает сообщения, то ли ждет завершения Execute, во всяком случае FThrdCount не уменьшается.