[nixon232]

Сам слип:

Код:

procedure WaitMe(msc: Cardinal);
var
  Ret: Dword;
  WaitTime: TLargeInteger;
  Timer: THandle;
begin
  // sleep  without freezing
  Timer := CreateWaitableTimer(nil, True, nil);
  WaitTime := -msc * 10000; 
  SetWaitableTimer(Timer, WaitTime, 0, nil, nil, false);
  repeat
    // (WAIT_OBJECT_0+0) is returned when the timer is signaled.           tw
    // (WAIT_OBJECT_0+1) is returned when a message is in the queue.
    Ret := MsgWaitForMultipleObjects(1, Timer, false, INFINITE, QS_ALLINPUT);
    if Ret <> (WAIT_OBJECT_0 + 1) then
      Break;
    Application.ProcessMessages;
  until false;
  if Ret <> WAIT_OBJECT_0 then
    CancelWaitableTimer(Timer);
  CloseHandle(Timer);
end;

Логирование

Код:

procedure TThr.AddLogEvent(Value: string; AColor: TColor);
var
  sTime: string;
begin

  try
    if fState then
      Synchronize(
        procedure
        begin
          sTime := '[' + FormatDateTime('hh:mm:ss:zzz', Now) + '] ';
          if AColor <> clBlack then
          begin
            MF.rLog.SelAttributes.Style := [fsBold];
            MF.rLog.SelAttributes.Color := AColor;
          end
          else
          begin
            MF.rLog.SelAttributes.Style := [];
            MF.rLog.SelAttributes.Color := clBlack;
          end;

          MF.rLog.lines.Add(sTime + Value);
        end);
  finally

  end;

end;

Примерный вызов:

Код:

procedure TThr.proc(...);
var
  ...
begin

  if t.Ntry > 0 then
  begin
    AddLogEvent(Format('Start Tick (RE_TRY) (%d) try #%d', [NextTryAfter, t.Ntry]), clWebDarkRed);
    WaitMe(NextTryAfter);
    AddLogEvent(Format('End Tick (RE_TRY) (%d) try #%d', [NextTryAfter, t.Ntry]), clWebDarkRed);
    if not NeedChange(t) then
    begin
....
      Exit
    end;
  end;

в итоге в логе мы видим

............
[22:58:52:515] Start Tick (RE_TRY) (1500) try #1
[Нужный слип в 1.5 сек]
[22:58:54:016] End Tick (RE_TRY) (1500) try #1
..........
[22:58:54:964] Start Tick (RE_TRY) (1500) try #2
опять все ок, слип прошел
[22:58:56:465] End Tick (RE_TRY) (1500) try #2
..........
[22:58:56:920] Start Tick (RE_TRY) (1500) try #3
И тут
[22:58:58:422] End Tick (RE_TRY) (1500) try #3
.........
[22:58:59:371] Start Tick (RE_TRY) (1500) try #4
По времени нету паузы
[22:59:00:872] End Tick (RE_TRY) (1500) try #4

Скорее всего это проблемы Синхронизации записи в лог? что можно сделать?

[dr. F.I.N.]

А для чего Вам в потоке MsgWaitForMultipleObjects? У Вас используются окна в потоке? Вы отправляете в поток сообщения? Чем Вас не устроил простой Sleep() или SleepEx()?

[nixon232]

В первых вариантах был слип, но он мне фризил интерфейс основной формы, этот вариант мне помог. Потом, я нашел причину фризов, а возвращать слип как-то не стал. Это может быть как-то связано с проблемой?

[dr. F.I.N.]

Сообщение от nixon232

В первых вариантах был слип, но он мне фризил интерфейс основной формы, этот вариант мне помог.

Если дополнительный поток вызывает подвисание основного, значит что-то Вы делаете неверно. А именно программа не попадает в цикл обработки сообщений. Что Вы решили добавлением Application.ProcessMessage. Т.е. деления на потоки у Вас и не получилось.

Сообщение от nixon232

Потом, я нашел причину фризов, а возвращать слип как-то не стал. Это может быть как-то связано с проблемой?

Сложно сказать. Поставьте брейк и посмотрите откуда ноги растут. Хотя если бы мне нужна была пауза в потоке, и ничего кроме неё, Sleep вполне оправдан (это позволяет притормозить вызвавший поток и дать время на отработку остальных, что и должно предотвращать зависание).

Как итог, по Вашему куску кода можно сказать, что вся процедура WaitMe легко заменяется на Sleep. Ну а если пауза значительная и может повлиять на завершение программы (например пауза в 10 секунд не даст завершиться программе, пока доп поток не отработает), то можно сделать как мы с Вами обсуждали в прошлой теме - WaitForMultiplyObjects и ожидать либо таймер, либо событие завершения потока.