Мерцание progressBar1> при уменьшении значения progressBar1.position.

[RusSun]

Доброе время суток.
Всех с новым годом!!!
Теперь тема.
Мерцание progressBar1 при уменьшении значения progressBar1.position.

Когда progressBar1 "идёт" заполняется от меньшего значения к большему, то всё хорошо работает.

Про экспериментировал. Что если значение, после роста до progressBar1.Max, будет уменьшаться до 1.
Когда идет уменьшение значения, то видно не вооруженным взглядом, что progressBar1 "дергается и мерцает".
Почти не заметно на значении 10k и менее.
У меня progressBar1.Max = 100k
progressBar1.Min = 1
шаг 1k

Примечание k = 1000.

Mainform:

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,ThreadUnit, ComCtrls;
 
type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    ProgressBar1: TProgressBar;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  Thread :TMyThread;
  FlagThreadStop: boolean = False;
implementation
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
begin
     FlagThreadStop:= not FlagThreadStop;
   if FlagThreadStop then
   begin
      Thread.Resume;
      Button1.Caption:= 'Stop It'
   end
   else
   begin
      Thread.Suspend;
   Button1.Caption:= 'Run Thread'
   end;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
Thread:= TMyThread.Create(true);
Thread.Priority := tplower;
//Thread.Priority := tpNormal;
//Thread.FreeOnTerminate:=True; //Это ошибочное действие
Thread.Resume;
Thread.Suspend
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
////Возобновим поток если они приостановлен
if Thread.Suspended then Thread.Resume;
//Посылаем требование завершиться
Thread.Terminate;
//Уничтожаем объект
Thread.Free;
//Закрываем приложение
Form1.Close;
end;
 
initialization
  ReportMemoryLeaksOnShutdown := True;
end.

Thread

unit ThreadUnit;
 
interface
 
uses
  Classes,sysUtils;//,windows,messages
 
type
  TMyThread = class(TThread)
//const
//  WM_MyMsg = WM_User + 1;
private
  index:integer;
  flag: boolean;
  procedure Updatelabel;
    { Private declarations }
  protected  //   public
    procedure Execute; override;
  end;
 
implementation
uses unit1;//обязательно
{ Tcountobj }
procedure TMyThread.Updatelabel;
    begin
      Form1.label1.Caption:= Inttostr(index);
      Form1.ProgressBar1.Position:= index
      // PostMessage(Form1.ProgressBar1.Handle, WM_MyMsg, Form1.ProgressBar1.Max, index);
      // Application.Processmessages;
    end;
 
{ TMyThread }
 
procedure TMyThread.Execute;
begin
 inherited;
 index:=1;
 flag:= False;
        while terminated = False do
          begin
          
          //заполняем бесконечный счётчик
          while index>0 do
                            begin
                            //Вот эта проверка даёт быстрый выход из цикла !!!
                            if Thread.Terminated then break;
                            Synchronize(Updatelabel);
                            if not flag then
                                  Inc(index)
                                  else
                                  begin
                                  //sleep(1);
                                  //Form1.ProgressBar1.StepIt;
                                  dec(index);
                                  end;
                            if index > 100000 then
                            begin
                            index:=100000;
                            flag:= true;
                            //Form1.ProgressBar1.StepIt;
                            end;
                             end;
 
 
          end;
end;
 
end.

Конечно, можно обойтись

          
                ...
(* вариантом *) sleep(1);
                dec(index) // где "index в потоке уменьшается"
                ...

Мерцание и дергание уменьшится. (но соответственно появляется задержка)

Мне кажется, что должно быть более грамотное решение.

Мой вопрос: Как уменьшить или совсем убрать мерцание и дергание прогрессбара при
уменьшении значения progressBar1.position -> "progressBar1.Max до progressBar1.Min" ?

В некоторых программах, я видел, тоже были прогрессбары
и "движение справа налево" осуществлялось плавно, без рывков и скачков.

Заранее
Прикреплённый файлTestThread2.rar (186,3 Кбайт, скачиваний: 242)

Сообщение отредактировано: RusSun - 04.01.21, 06:32

[Gonarh]

ProgressBar1.DoubleBuffered:=true;