Странное поведение функции Sleep (), используемой в repeat until в Delphi

Я использовал два таймера для "медленного" обновления некоторых значений (чтобы пользователь мог видеть прогресс), не замедляя работу приложения или, в худшем случае, системы.

//  "weights" for old and new value; I was working on integers
var
  Wa: integer =  1;
  Wb: integer =  9;
  Wt: integer = 10;

//  interval of 1000 ms, of course
procedure frmMain.T1000Timer(Sender: TObject);
begin
  Wa:= 1;
  nValue:= calculate_new_value;
end;

//  100 ms interval
procedure frmMain.T100Timer(Sender: TObject);
begin
  Wb:= Wt -Wa;
  //  displayed value, ie gauge.progress, or something.Value, etc.
  sam.Value:= Round( (Wb *sam.Value +Wa *nValue) /Wt );
  if Wa < Wt then Inc(Wa);
end;

Если вы должны использовать функцию типа delay или "sleep", вы можете использовать процедуру с ProcessMessages. Есть некоторые плюсы и минусы в его использовании, но я успешно во многих случаях без каких-либо вредных последствий. Я знаю, что здесь есть и другие, кто может лучше прокомментировать процессные процессы.

Procedure Delay(MSecs: Cardinal);
var
 FirstTick, CurrentTick : Cardinal;
 Done : Boolean;
begin
 Done := FALSE;
 FirstTick := GetTickCount;
 While Not Done do
  begin
   Application.ProcessMessages;
   CurrentTick := GetTickCount;
   If Int64(CurrentTick) - Int64(FirstTick) < 0 Then
    begin
     If CurrentTick >= (Int64(FirstTick) - High(Cardinal) + MSecs) Then
      Done := TRUE;
       End
        Else
         If CurrentTick - FirstTick >= MSecs Then
          Done := TRUE;
  end;
end;

// Below for a service

procedure YourSvrSvc.ProcessMessages;
var
  Msg: TMsg;
begin
  if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
end;

Procedure YOURSvrSvc.Delay(MSecs: Cardinal);
var
 FirstTick, CurrentTick : Cardinal;
 Done : Boolean;
begin
 Done := FALSE;
 FirstTick := GetTickCount;
 While Not Done do
  begin
   YOURSvrSvc.ProcessMessages;
   CurrentTick := GetTickCount;
   If Int64(CurrentTick) - Int64(FirstTick) < 0 Then
    begin
     If CurrentTick >= (Int64(FirstTick) - High(Cardinal) + MSecs) Then
      Done := TRUE;
       End
        Else
         If CurrentTick - FirstTick >= MSecs Then
          Done := TRUE;
  end;
end;

Мне трудно сказать, чтобы не использовать Sleep, так как я сам использую его все время, но Application.ProcessMessages на самом деле опасное решение, особенно при использовании в цикле. Я не уверен, какую информацию вы показываете (так как я не знаю языка), но похоже, что вы делаете некоторые преобразования из Float в String. Хотя эти преобразования выполняются за доли секунды, сложите их все вместе, и вы можете придумать длительную операцию. И предположим, вы решили добавить еще одну ценность к быть обновленным, что требует некоторого вычисления (например, байт в секунду при передаче файла). Это преобразование добавит немного больше времени на эту операцию, и прежде чем вы это узнаете, вы можете закончить обновление пользовательского интерфейса, которое занимает полсекунды (что не кажется долгим, но когда дело доходит до использования процессора, это довольно большая нагрузка).

Поэтому я бы предложил использовать поток для выполнения всех этих преобразований, вычислений и т. д. и инициировать события по мере необходимости, когда эта информация имеет измененный. Теперь нить определенно будет немного сложнее, чем другие предложенные здесь решения, без сомнения. Но использование нити также может принести много пользы. Вся ваша тяжелая работа может быть выполнена в фоновом режиме, пока ваше приложение по-прежнему отвечает идеально. Имейте в виду, что использование потока может быть очень сложным, особенно когда речь заходит об обновлениях пользовательского интерфейса. Есть несколько способов сделать нить, но я постараюсь сделать это просто...

type
  TMyThread = class;

  TMyThreadEvent = procedure(Sender: TObject; const Val1, Val2: String) of object;

  TMyThread = class(TThread)
  private
    FValue1: Integer;
    FValue2: Integer;
    FString1: String;
    FString2: String;
    FOnChange: TMyThreadEvent;
    procedure SYNC_OnChange;
  protected
    procedure Execute; override;
  public
    constructor Create;
    property Value1: Integer read FValue1 write FValue1;
    property Value2: Integer read FValue2 write FValue1;
    property String1: String read FString1;
    property String2: String read FString2;
    property OnChange: TMyThreadEvent read FOnChange write FOnChange;
  end;

  ...

  constructor TMyThread.Create;
  begin
    inherited Create(False);
    FValue1 := '0';
    FValue2 := '0';
  end;

  procedure TMyThread.Execute;
  var
    S1, S2: String;
    DoChange: Bool;
  begin
    DoChange:= False;
    FValue2:= DoSomeBigCalculation(FValue1); //Some random big calculation
    S1:= FormatFloat('#,##0.#', FValue1);
    S2:= FormatFloat('#,##0.#', FValue2);
    if (S1 <> FString1) then begin
      FString1:= S1;
      DoChange:= True;
    end;
    if (S2 <> FString2) then begin
      FString2:= S2;
      DoChange:= True;
    end;
    if DoChange then
      Synchronize(SYNC_OnChange);
  end;

  procedure TMyThread.SYNC_OnChange;
  begin
    if assigned(FOnChange) then
      FOnChange(Self, FString1, FString2);
  end;

Теперь, чтобы использовать это, вы установил бы Свойства Integer по мере необходимости. Убедитесь, что вы задали событию OnChange процедуру с параметрами указанного выше типа TMyThreadEvent. Всякий раз, когда какое-либо значение отличается от своего первоначального (или старого) значения, оно инициирует это событие. Я также настоятельно рекомендую, чтобы любой код обработки, который вы можете иметь, который производит эти значения в первую очередь, был помещен внутрь потока. Возможности многопоточности огромны и доказывают большое преимущество в приложениях, которые имеют много общего с их.

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