ProgressBar и потоки

[antigrav]

Коллеги, здравствуйте!

Есть максимально простая задача: в длительном цикле необходимо так или иначе показывать пользователю номер текущей итерации. Делаю это с помощью ProgressBar. При этом если использую главный поток (кнопка 1), то результат вижу по окончании цикла, когда ProgressBar уже заполнен, а когда использую дополнительный поток (кнопка 2) - вижу постепенное заполнение ProgressBar, чего и пытаюсь добиться в главном потоке. Почему так? Такое ощущение, что от меня ускользает какой-то важный принцип использования FMX. Кто-нибудь может объяснить происходящее? Код ниже. Спасибо!

 

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,
  FMX.Controls.Presentation;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    ProgressBar1: TProgressBar;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    procedure Test;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses

  System.Threading;

{$R *.fmx}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Test;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  TTask.Run(
    Test
  );
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  ProgressBar1.Value := 0;
end;

procedure TForm1.Test;
const
  n = 200;
var
  I: Integer;
begin
  ProgressBar1.Min := 0;
  ProgressBar1.Max := n - 1;
  for I := 0 to n - 1 do
  begin
    ProgressBar1.Value := I;
    sleep(10);
  end;
end;

end.
 

[krapotkin]

ну же нельзя обращаться из доп потока к компонентам

ничего не изменилось с тех пор

пример с ProgressBar там есть

https://www.cyberforum.ru/blogs/469693/blog4875.html

[antigrav]

Спасибо за ссылку! Полезно. Добавил в избранное. 

Про синхронизацию я знаю, поэтому сам был удивлен, что запись напрямую в компонент из доп потока сработала.

Вот такой код, с синхронизацией, для второй кнопки тоже работает:

procedure TForm1.Button2Click(Sender: TObject);
begin
  TTask.Run(
    procedure
    const
      n = 200;
    var
      I: Integer;
    begin
      TThread.Synchronize(nil,
        procedure
        begin
          ProgressBar1.Min := 0;
          ProgressBar1.Max := n - 1;
        end
      );
      for I := 0 to n - 1 do
      begin
        TThread.Synchronize(nil,
          procedure
          begin
            ProgressBar1.Value := I;
          end
        );
        sleep(10);
      end;
    end
  );
end;

 

Вопрос мой такой: почему точно также не работает код для основного потока (кнопка 1), то есть почему не видно постепенного заполнения ProgressBar в главном потоке? 

 

[krapotkin]

не понял вопрос. мы работаем в обработчике одного из событий очереди сообщений в главном потоке.

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

 

 

Изменено 12 ноября, 2023 пользователем krapotkin

[antigrav]

Я про этот код. Главный поток.

procedure TForm1.Button1Click(Sender: TObject);
begin
  Test;
end;

procedure TForm1.Test;
const
  n = 200;
var
  I: Integer;
begin
  ProgressBar1.Min := 0;
  ProgressBar1.Max := n - 1;
  for I := 0 to n - 1 do
  begin
    ProgressBar1.Value := I;
    sleep(10);
  end;
end;

Я нажимаю кнопку и ожидаю, что после ее нажатия ProgressBar1 постепенно, в цикле, будет заполняться. Но этого не происходит. После нажатия я вижу пустой ProgressBar1 и только спустя время 10*200, в конце цикла, вижу уже заполненный ProgressBar1. Постепенного заполнения ProgressBar не происходит.

Такой же процесс в дополнительном потоке, однако, работает корректно. Точнее, так как мне нужно.

[antigrav]

То есть внутри цикла ProgressBar1 не перерисовывается.

[antigrav]

Приложу, на всякий случай, проект

Project1.zip

[OnePeople]

Вам уже ответили, но можете конечно сделать так в главном потоке

procedure Test;
const
  n = 200;
var
  I: Integer;
begin
  pb1.Min := 0;
  pb1.Max := n - 1;
  for I := 0 to n - 1 do
  begin
    pb1.Value := I;
    sleep(10);
    Application.ProcessMessages;
  end;
end;

 

[antigrav]

Спасибо, OnePeople и krapotkin! С Application.ProcessMessages в главном потоке оба потока работают одинаково, что и требовалось.