2

当我调用一个函数并且它“运行”时（最多可能需要 3 秒 - 刷新函数从 api 服务器获取数据）我想将加载表单显示为 Ajax 加载指示器作为主表单上方的叠加层。

我之前的尝试都失败了。我曾尝试更改在 Main 创建后直接显示的 Create the LoadingForm。然后我尝试了 LoadingForm.Show/Showmodal。在模态序列中停止并且仅在我关闭表单并显示窗口没有关闭时继续，尽管 .

我也有打开表单但没有显示 gif 的情况，它应该在的地方只是白色并保持白色 - 没有图像没有动画

在此处输入图像描述

有什么想法吗？

4

2 回答 2

9

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. 为了避免从线程访问 VCL 数据 -如果必须在例程中重用已修改的数据，这是首选方式：
    • 将网格数据的副本传递给线程——比如在构造函数中
    • 更新副本
    • 在线程完成后使用编辑后的数据副本更新网格 - 即在ShowModal返回之后。
  2. 要从线程访问表单的对象 -如果在很短的时间间隔内访问表单的对象，则可以这样做：
    • 使用同步块从网格中获取数据
    • 在线程的同步回调中​​更新网格 - 即在方法中myRunProgress或myRunTerminate方法中

对于不同的用例，如果您的例程不考虑已更改的数据，则混合方法也可能有意义（在构造函数中传递副本/更新线程同步块中的网格）：选择最适合您需要的方法.

如果另一个外部线程更新了网格，athread1可以读取数据然后填充表单的私有队列——比如块TThreadList中的一个或另一个集合TCriticalSection——并通知 athread2在队列上执行一项工作，但我希望这可能不需要让你的任务完成。

于 2016-02-24T08:43:22.380 回答
0

创建对话框表单设置：

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;

它应该工作..

于 2016-02-26T15:43:10.047 回答