Кнопки не реагируют на форму, отображаемую, пока приложение занято

У меня есть второстепенная форма, которая появляется во время интенсивной обработки в основной форме.
Я отправляю сообщения во вторичную форму (form2) о ходе обработки — это работает нормально.
Я хочу, чтобы кнопка на form2 отменить обработку, закрыв форму2 и переустановив глобальную переменную в false. Никакие кнопки не работают на form2, если она открыта с помощью form2.show (onclick и mousedown ничего не делают, и кнопка не перемещается)
Они работают с form2.showmodal, но это останавливает любую обработку в Mainform, а также перестает видеть обычное окно X, чтобы закрыть Form2.


person Whitehairedgeezer    schedule 06.12.2013    source источник
comment
Поместите долгоиграющие вещи в поток   -  person David Heffernan    schedule 06.12.2013


Ответы (2)


Это происходит потому, что основной поток занят и не может обрабатывать оконные сообщения.

Вы должны перенести тяжелую обработку в поток и использовать синхронизацию для управления ею.

Уродливый взлом будет звонить

application.processmessages;

во время тяжелой обработки, чтобы принудительно обрабатывать сообщения формы, когда основная форма занята.

Вам лучше найти пример с реализацией потока и посмотреть на него.

person Ghigo    schedule 06.12.2013
comment
Пожалуйста, не рекомендуйте application.processmessages - person David Heffernan; 06.12.2013
comment
TApplication.ProcessMessages не является взломом. - person Free Consulting; 06.12.2013
comment
Это не настоящий взлом, это просто плохой код. Вот почему я говорю об уродливом взломе. - person Ghigo; 06.12.2013
comment
Учитывая контекст вопроса, вы соглашаетесь с тем, что использование application.ProcessMessages в этом случае является плохим кодированием. Это не означает, что это всегда плохой код. - person Ghigo; 06.12.2013
comment
application.processmessages работает - кнопка не перемещается, но когда я отправляю каждое сообщение из основной формы, она находит событие onclick. Почему это уродливое или плохое кодирование? - person Whitehairedgeezer; 06.12.2013
comment
@ user3074340: если вы не понимаете последствия вызова Application.ProcessMessages, то вы можете столкнуться с некоторыми неприятными побочными эффектами в будущем ... Как указал Дэвид в комментарии к вашему вопросу, правильный ответ - поместить длинные вычисления в отдельная ветка... - person whosrdaddy; 06.12.2013

Поскольку я не сторонник использования Application.ProcessMessages, я покажу вам альтернативу с многопоточностью. В этом примере я использовал отличные AsyncCalls библиотека потоков (созданная Андреасом Хаусладеном), потому что мне нравится ее простота, другая отличная библиотека — 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.

основная форма дфм:

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
person whosrdaddy    schedule 06.12.2013