Загрузка формы в виде наложения, когда функция работает в фоновом режиме

Когда я вызываю функцию, и она «запускается» (может занять до 3 секунд — функция обновления получает данные с сервера API), я хотел бы показать форму загрузки в виде индикатора загрузки Ajax в виде наложения над основной формой.

Все мои предыдущие попытки потерпели неудачу. Я пытался изменить Create the LoadingForm, чтобы он отображался непосредственно после создания Main. Затем я попробовал LoadingForm.Show/Showmodal. В модальной последовательности останавливается и продолжается только тогда, когда я закрываю форму и показываю, что окно не закрывается, несмотря на .

У меня тоже была ситуация, что форма открылась, а гифка не показывалась, место где она должна быть была просто белой и осталась белой - ни изображения ни анимации

введите здесь описание изображения

Любая идея?


person Hidden    schedule 21.02.2016    source источник
comment
Ваша функция работает в отдельном потоке?   -  person LU RD    schedule 22.02.2016
comment
Нет его в основном блоке.   -  person Hidden    schedule 22.02.2016
comment
Что ж, это означает, что графический интерфейс не отвечает во время вызова функции.   -  person LU RD    schedule 22.02.2016
comment
Ну, у меня есть банкомат MainForm (где функция занимает несколько секунд) и отдельная форма. Итак, каждый раз, когда я вызываю функцию обновления, я хочу отобразить форму наложения, не могли бы вы опубликовать пример кода?   -  person Hidden    schedule 22.02.2016
comment
Если ваша функция может выполняться в отдельном потоке, см. раздел Delphi: как предотвратить потерю ответов приложением с одним потоком?.   -  person LU RD    schedule 22.02.2016
comment
Функции нужен доступ к сетке главной формы...   -  person Hidden    schedule 22.02.2016
comment
Поместите данные в контейнер и используйте виртуальную сетку.   -  person LU RD    schedule 22.02.2016
comment
@Hidden Что вам нужно понять, так это то, что поток не может быть одновременно занят выполнением работы и запуском графического интерфейса. Вам понадобятся две нити. Это потребует переделки вашей программы.   -  person David Heffernan    schedule 22.02.2016
comment
Если ваш метод блокировки представляет собой цикл, у вас есть три варианта. 1) Показать диалоговое окно и явно вызывать его методы обновления/перерисовки периодически во время цикла. 2) периодически вызывать ProcessMessages во время цикла. 3) Переместите работу в фоновый поток и используйте обратные вызовы. Метод 3 является идеальным, как правило. Если ваш блокирующий вызов не содержит цикла (или не находится под вашим контролем), у вас действительно есть только один вариант — № 3, использовать поток.   -  person J...    schedule 22.02.2016
comment
Вы пробовали использовать фоновый рабочий компонент или асинхронный вызов, как это предлагается в ответах здесь stackoverflow.com /questions/21430812/background-worker-delphi ?   -  person fuchs777    schedule 24.02.2016


Ответы (2)


В приведенном ниже коде используется поток для имитации длительного выполнения блока в методе Execute и "обратный вызов" OnProgress для уведомления формы об изменении процента выполнения.

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


Unit1.pas основная форма и класс потока

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.StdCtrls, Unit2;

type
  TMyRun = class(TThread)
    protected
      procedure Execute; override;
    public
      OnProgress: TProgressEvent;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    FProgressForm: TfrmProgress;
    procedure myRunProgress(Sender: TObject; Stage: TProgressStage;
        PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
    procedure myRunTerminate(Sender: TObject);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TMyRun.Execute;
var
  i: Integer;
  r: TRect;
begin
  for i := 1 to 100 do begin
    if Terminated then
      Break;

    Sleep(50);//simulates some kind of operation

    if Assigned(OnProgress) then
      Synchronize(procedure
          begin
            OnProgress(Self, psRunning, i, False, r, '');
          end);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FProgressForm := TfrmProgress.Create(nil);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FProgressForm.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  with TMyRun.Create do begin
    FreeOnTerminate := True;
    OnProgress := myRunProgress;
    OnTerminate := myRunTerminate;
  end;
  FProgressForm.ShowModal;
end;

procedure TForm1.myRunProgress(Sender: TObject; Stage: TProgressStage;
  PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
begin
  FProgressForm.ProgressBar1.Position := PercentDone;
end;

procedure TForm1.myRunTerminate(Sender: TObject);
begin
  FProgressForm.Close;
end;

end.

Unit1.dfm

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 81
  ClientWidth = 181
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesktopCenter
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 48
    Top = 24
    Width = 91
    Height = 25
    Caption = 'Run the thread'
    TabOrder = 0
    OnClick = Button1Click
  end
end

Unit2.pas диалоговое окно прогресса

unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls;

type
  TfrmProgress = class(TForm)
    ProgressBar1: TProgressBar;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmProgress: TfrmProgress;

implementation

{$R *.dfm}

end.

Unit2.dfm

object frmProgress: TfrmProgress
  Left = 0
  Top = 0
  BorderStyle = bsSizeToolWin
  Caption = 'frmProgress'
  ClientHeight = 51
  ClientWidth = 294
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object ProgressBar1: TProgressBar
    Left = 16
    Top = 16
    Width = 265
    Height = 17
    TabOrder = 0
  end
end

Ссылаясь на комментарий, в котором говорится, что для длительных операций требуется доступ к сетке в основной форме, чтобы избежать блокировки потока VCL для этого объекта:

  1. To avoid the access to the VCL data from the thread - it's the preferred way if the already modified data have to be reused in the routine:
    • pass a copy of the grid's data to the thread - say in the constructor
    • обновить копию
    • обновить сетку отредактированной копией данных после завершения потока, т.е. после возврата ShowModal.
  2. To access the form's object from the thread - this can be done if the form's objects are accessed for very short time intervals:
    • use a synchronized block to get the data from the grid
    • обновить сетку в синхронизированном обратном вызове потока, т.е. в методе myRunProgress или в методе myRunTerminate

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

Если другой внешний поток обновляет сетку, thread1 может прочитать данные, а затем заполнить частную очередь формы — скажем, TThreadList или другую коллекцию в блоке TCriticalSection — и уведомить thread2 о выполнении задания в очереди, но я надеюсь, что это, вероятно, не так. необходимо, чтобы ваша работа была сделана.

person fantaghirocco came to Rome    schedule 24.02.2016
comment
Из комментариев ОП сказал, что фоновой задаче необходим доступ к сетке данных vcl. Это сложно сделать, если вы не реорганизуете задачу для доступа к данным из структуры, независимой от vcl. - person LU RD; 25.02.2016
comment
@LURD Я не могу полностью понять вашу точку зрения: доступ к данным в сетке можно получить в синхронизированном блоке, пытаясь избежать длительной блокировки потока VCL. Или данные сетки можно передать в конструкторе потока. Сетку данных можно безопасно обновить в процедуре myRunProgress. По коду, который дал ОП, я больше ничего не могу догадаться. - person fantaghirocco came to Rome; 25.02.2016
comment
Здесь мы все гадаем, поскольку не можем сказать, целесообразно ли обращаться к данным сетки в синхронизированном блоке или передавать их через конструктор, а затем обновлять данные в синхронизированном обратном вызове. Во всяком случае, вы не упоминаете об этом в своем ответе. Правильнее всего провести рефакторинг кода, избегая зависимости от графического интерфейса. - person LU RD; 25.02.2016
comment
@LURD, если задание сильно зависит от сетки, можно использовать 2 потока: один читает, заполняет очередь, другой читает очередь и выполняет обновление пользовательского интерфейса. Но по самому вопросу, как вы думаете, я должен расширить свой ответ на это? - person fantaghirocco came to Rome; 25.02.2016
comment
ОП запрашивает код, но вопрос неполный и не показывает никаких исследований. Было бы нормально просто указать на недостатки в вопросе и рассказать о способах обработки (или предотвращения!) доступа к данным vcl из потока. - person LU RD; 25.02.2016
comment
Я не думаю, что на этот вопрос вообще можно ответить. Добавление награды не делает его более ясным. - person David Heffernan; 25.02.2016

Создайте настройку диалоговой формы:

BorderIcons = []
BorderStyle = bsDialog
FormStyle = fsStayOnTop
Position = poScreenCenter

в основной форме при вызове вашей функции напишите:

procedure TFormMain.Button1Click(Sender: TObject);
begin
    Enabled:=false;
    try
        FormDialog.Show;
        FormDialog.Refresh;

        MyLongRunProcedure; // calls your procedure here

    finally        
        Enabled:=true;
        FormDialog.Close;
    end;
end;

Он должен работать..

person MtwStark    schedule 26.02.2016
comment
если вы хотите/нужно, вы можете получить доступ к FormDialog из своей функции, чтобы обновить индикатор выполнения или обновить метку состояния. - person MtwStark; 26.02.2016