ปุ่มไม่ตอบสนองในแบบฟอร์มที่แสดงในขณะที่แอปพลิเคชันไม่ว่าง

เหตุการณ์นี้เกิดขึ้นเนื่องจากเธรดหลักไม่ว่าง และไม่สามารถประมวลผลข้อความในหน้าต่างได้

คุณควรย้ายการประมวลผลจำนวนมากในเธรด และใช้การซิงโครไนซ์เพื่อควบคุม

แฮ็คที่น่าเกลียดจะโทรมา

application.processmessages;

ในระหว่างการประมวลผลอย่างหนักเพื่อบังคับให้ประมวลผลข้อความของฟอร์มเมื่อฟอร์มหลักไม่ว่าง

คุณควรหาตัวอย่างการใช้งานเธรดและดูดีกว่า

เนื่องจากฉันไม่สนับสนุนการใช้ 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