应用程序忙时显示的表单上的按钮没有响应

Question

我有一个辅助窗体，它在主窗体中进行一些繁重的处理时出现。
我向辅助表单 (form2) 发送有关处理进度的消息 - 效果很好。
我想要 form2 上的按钮通过关闭 form2 并将全局变量重新设置为 false 来取消处理。如果使用 form2.show 打开它，则在 form2 上没有任何按钮起作用（onclick 和 mousedown 什么都不做，并且按钮不移动）
他们使用 form2.showmodal ，但这会停止 Mainform 中的任何处理，它也会停止查看普通窗口 X 以关闭 Form2。

Answer 1

这是因为主线程很忙，无法处理窗口消息。

您应该在线程中移动繁重的处理并使用同步来控制它。

一个丑陋的黑客会打电话

application.processmessages;

在繁重的处理过程中，当主窗体忙时强制处理窗体消息。

你最好找个线程实现的例子看看。

Answer 2

由于我不提倡使用Application.ProcessMessages，我将向您展示线程的替代方案。在此示例中，我使用了出色的 AsyncCalls 线程库（由 Andreas Hausladen 制作），因为我喜欢它的简单性，另一个出色的库是由 SO 成员 Primož Gabrijelčič 制作的 OmniThreadLibrary，但它仅适用于 Delphi 2007 版及更高版本。

该示例包含 2 个表单，主表单带有一个 Calculate 按钮和一个显示进度条和一个 Cancel 按钮的进度对话框。 由于没有硬编码的依赖关系，因此您可以将进度对话框重复用于其他计算。

.dpr 代码：

program SO20424238;

uses
  Forms,
  u_frm_main in 'u_frm_main.pas' {Frm_main},
  u_dlg_progress in 'u_dlg_progress.pas' {ProgressDialog};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TFrm_main, Frm_main);
  Application.Run;
end.

主要形式：

unit u_frm_main;

interface

uses
  u_dlg_progress,
  AsyncCalls,
  Windows,
  Messages,
  SysUtils,
  Classes,
  Controls,
  Forms, StdCtrls;

const
  INT_MAX_CALCULATIONS = 100;

type
  TFrm_main = class(TForm)
    Btn_docalculate: TButton;
    procedure Btn_docalculateClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    CancelCalculation : Boolean;
    function SomeLongCalculation(OnProgress : TProgressEvent) : Integer;
    function ShowProgressDialog : TProgressDialog;
    procedure DoCalculate;
    procedure CancelEvent;
  public
    { Public declarations }
    Async : IAsyncCall;
  end;

var
  Frm_main: TFrm_main;

implementation

{$R *.dfm}

procedure TFrm_main.CancelEvent;
begin
 // set cancelation flag
 CancelCalculation := True;
end;

procedure TFrm_main.Btn_docalculateClick(Sender: TObject);
begin
 DoCalculate;
end;

function TFrm_main.ShowProgressDialog: TProgressDialog;
begin
 Result := TProgressDialog.Create(CancelEvent);
 Result.ProgressBar1.Max := INT_MAX_CALCULATIONS;
end;

function TFrm_main.SomeLongCalculation(OnProgress : TProgressEvent) : Integer;

var
  Index : Integer;

begin
 // BEWARE - this function runs in a different thread
 // *any* call to the VCL/GUI/shared variables must happen in the main (GUI) thread 
 // AsyncCalls make this easy by providing the EnterMainThread and LeaveMainThread functions
 for Index := 0 to INT_MAX_CALCULATIONS do
  begin
   Sleep(100); // replace this line with the actual calculation
   // now check if the user has canceled, check this in the main thread
   EnterMainThread;
   try
    if CancelCalculation then
     begin
      // notify progress window we are done
      if Assigned(OnProgress) then
       OnProgress(INT_MAX_CALCULATIONS);
      // exit calculation loop
      Break;
     end
    else
    // report actual progress
    if Assigned(OnProgress) then
     OnProgress(Index);
   finally
    LeaveMainThread;
   end;
  end;
end;

procedure TFrm_main.DoCalculate;

var
  ProgressDialog : TProgressDialog;

begin
 // create our progress dialog
 ProgressDialog := ShowProgressDialog;
 // reset cancelation flag
 CancelCalculation := False;
 // fire up calculation on a separate thread and hook up OnProgress function of our Progress dialog
 Async := TAsyncCalls.Invoke<TProgressEvent>(SomeLongCalculation, ProgressDialog.OnProgress);
 // show progress dialog, this will block all other forms from user input
 ProgressDialog.ShowModal;
end;

procedure TFrm_main.FormDestroy(Sender: TObject);
begin
 if Assigned(Async) then
  Async.Forget;
end;

end.

主格式dfm：

object Frm_main: TFrm_main
  Left = 0
  Top = 0
  Caption = 'Threading example'
  ClientHeight = 82
  ClientWidth = 273
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Btn_docalculate: TButton
    Left = 92
    Top = 28
    Width = 75
    Height = 25
    Caption = 'Calculate!'
    TabOrder = 0
    OnClick = Btn_docalculateClick
  end
end

进度对话框：

unit u_dlg_progress;

interface

uses
  AsyncCalls,
  SysUtils,
  Controls,
  Forms,
  Dialogs,
  StdCtrls,
  ComCtrls,
  Classes;

type
  TCancelEvent = procedure of object;

  TProgressEvent = procedure(Value : Integer) of object;

  TProgressDialog = class(TForm)
    ProgressBar1: TProgressBar;
    Btn_cancel: TButton;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Btn_cancelClick(Sender: TObject);
  private
    { Private declarations }
    FCancelEvent : TCancelEvent;
  public
    { Public declarations }
    procedure OnProgress(Value : Integer);
    constructor Create(CancelEvent : TCancelEvent);
  end;

implementation

{$R *.dfm}

{ TProgressDialog }

procedure TProgressDialog.Btn_cancelClick(Sender: TObject);
begin
 if Assigned(FCancelEvent) then
  FCancelEvent;
end;

procedure TProgressDialog.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 // make sure our dialog is freed after use
 Action := caFree;
end;

procedure TProgressDialog.FormCreate(Sender: TObject);
begin
 // reset progress bar
 ProgressBar1.Position := 0;
end;

procedure TProgressDialog.OnProgress(Value: Integer);
begin
 if Value >= ProgressBar1.Max then
  Close;
 ProgressBar1.Position := Value;
 Label1.Caption := IntToStr(Value);
end;

constructor TProgressDialog.Create(CancelEvent: TCancelEvent);
begin
 inherited Create(nil);
 FCancelEvent := CancelEvent;
end;

end.

进度对话框 dfm：

object ProgressDialog: TProgressDialog
  Left = 0
  Top = 0
  BorderIcons = []
  BorderStyle = bsDialog
  Caption = 'ProgressDialog'
  ClientHeight = 101
  ClientWidth = 364
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  OnClose = FormClose
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 18
    Top = 55
    Width = 77
    Height = 26
    Caption = 'Label1'
  end
  object ProgressBar1: TProgressBar
    Left = 8
    Top = 16
    Width = 341
    Height = 25
    Smooth = True
    MarqueeInterval = 1
    Step = 1
    TabOrder = 0
  end
  object Btn_cancel: TButton
    Left = 136
    Top = 59
    Width = 75
    Height = 25
    Cancel = True
    Caption = '&Cancel'
    TabOrder = 1
    OnClick = Btn_cancelClick
  end
end