На главную
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS

Дорогие друзья!
Поздравляем вас с Новым 2021 годом!
Всем ЗДОРОВЬЯ, удачи, успеха и благополучия!
msm.ru
! ПРАВИЛА РАЗДЕЛА · FAQ раздела Delphi · Книги по Delphi
Пожалуйста, выделяйте текст программы тегом [сode=pas] ... [/сode]. Для этого используйте кнопку [code=pas] в форме ответа или комбобокс, если нужно вставить код на языке, отличном от Дельфи/Паскаля.
Следующие вопросы задаются очень часто, подробно разобраны в FAQ и, поэтому, будут безжалостно удаляться:
1. Преобразовать переменную типа String в тип PChar (PAnsiChar)
2. Как "свернуть" программу в трей.
3. Как "скрыться" от Ctrl + Alt + Del (заблокировать их и т.п.)
4. Как прочитать список файлов, поддиректорий в директории?
5. Как запустить программу/файл?
... (продолжение следует) ...

Вопросы, подробно описанные во встроенной справочной системе Delphi, не несут полезной тематической нагрузки, поэтому будут удаляться.
Запрещается создавать темы с просьбой выполнить какую-то работу за автора темы. Форум является средством общения и общего поиска решения. Вашу работу за Вас никто выполнять не будет.


Внимание
Попытки открытия обсуждений реализации вредоносного ПО, включая различные интерпретации спам-ботов, наказывается предупреждением на 30 дней.
Повторная попытка - 60 дней. Последующие попытки бан.
Мат в разделе - бан на три месяца...
Модераторы: jack128, D[u]fa, Shaggy, Rouse_
  
> Мерцание progressBar1> при уменьшении значения progressBar1.position.
Доброе время суток. :victory:
Всех с новым годом!!! :D
Теперь тема.
Мерцание progressBar1 при уменьшении значения progressBar1.position.

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

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

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

Mainform:

ExpandedWrap disabled
    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
ExpandedWrap disabled
    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.


Конечно, можно обойтись
ExpandedWrap disabled
              
                    ...
    (* вариантом *) sleep(1);
                    dec(index) // где "index в потоке уменьшается"
                    ...

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

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

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

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

Заранее :thanks:
Прикреплённый файлПрикреплённый файлTestThread2.rar (186,3 Кбайт, скачиваний: 6)
Сообщение отредактировано: RusSun -
ExpandedWrap disabled
    ProgressBar1.DoubleBuffered:=true;
1 пользователей читают эту тему (1 гостей и 0 скрытых пользователей)
0 пользователей:


Рейтинг@Mail.ru
[ Script Execution time: 0,1181 ]   [ 21 queries used ]   [ Generated: 18.01.21, 03:34 GMT ]