应用程序繁忙时显示的窗体上没有响应的按钮

Question

我有一个辅助表单，在mainform中进行一些繁重的处理时显示出来 我向次要表格（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制作），因为我喜欢它的简单性，另一个优秀的库OmniThreadLibrary由SO成员PrimožGabrijelčič制作，但它仅适用于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