Tombol tidak merespons pada formulir yang ditampilkan saat aplikasi sedang sibuk

Hal ini terjadi karena thread utama sibuk dan tidak dapat memproses pesan jendela.

Anda harus memindahkan pemrosesan berat di thread dan menggunakan sinkronisasi untuk mengontrolnya.

Peretasan yang buruk akan terjadi

application.processmessages;

selama pemrosesan berat untuk memaksa pemrosesan pesan formulir ketika formulir utama sedang sibuk.

Anda sebaiknya menemukan contoh dengan implementasi thread dan melihatnya.

Karena saya tidak menganjurkan penggunaan Application.ProcessMessages, saya akan menunjukkan alternatif dengan threading. Dalam contoh ini, saya menggunakan AsyncCalls perpustakaan threading (dibuat oleh Andreas Hausladen) karena saya suka kesederhanaannya, perpustakaan unggulan lainnya adalah OmniThreadLibrary dibuat oleh SO anggota Primož Gabrijelčič tetapi hanya berfungsi dari Delphi versi 2007 dan lebih tinggi.

Contoh ini berisi 2 formulir, formulir utama dengan tombol Calculate dan dialog kemajuan yang menampilkan bilah kemajuan dan tombol Cancel. Kode dibuat sedemikian rupa sehingga Anda dapat menggunakan kembali dialog kemajuan untuk perhitungan lain karena tidak ada ketergantungan hardcode.

kode .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.

bentuk utama:

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.

bentuk utama 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

dialog kemajuan:

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.

dialog kemajuan 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