Why do modal Delphi forms not receive WM_SYSCOMMAND when the user clicks the task bar button?

Question

In a Delphi (2007) program, running on Windows 8.1, I would like to get notified when the user clicks on the task bar button belonging to my program. So I am trapping the WM_SYSCOMMAND which usually gets send in that case.

This works fine for program's main window.

If a modal window is active (opened with Form2.ShowModal), the same code cannot trap the WM_SYSCOMMAND, neither in the main for nor in the modal form. What is different? And is there any way to change this?

This is the code I have added to both forms:

unit unit1;

interface

type
  TForm1 = class(TForm)
    // [...]
    procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
  end;

 // [...]

implementation

 // [...]

procedure Tf_dzProgressTest.WMSysCommand(var Msg: TWMSysCommand);
begin
  inherited; // place breakpoint here
end;

 // [...]

end.

I also tried to use Application.OnMessage or a TApplicationEvents component and even overriding the form's WndProc method. Neither could trap WM_SYSCOMMAND while a modal form was active.

Answer 1

David explained the problem very well, so I'm not going to repeat what he said.

What I'm going to give you is a work around using non blocking code.`

You'll need to declare an event that will tell us when the form has closed.

  TModalResultEvent = procedure(aSender: TObject; var aModal: TModalResult) of object;

This allows us to Listen in on Messages passing through the Application

const
  WM_SYSCOMMAND1 = WM_USER + 1;  

type
  TApplicationHelper = class(TWinControl)
  private
    FListener: TWinControl;
  public
    constructor Create(AOwner: TComponent); override;
    procedure WMSysCommand1(var Msg: TWMSysCommand); message WM_SYSCOMMAND1;
    procedure FirstChance(var Msg: TMsg; var Handled: Boolean); virtual;

    property Listener: TWinControl read FListener write FListener;
  end;

constructor TApplicationHelper.Create(AOwner: TComponent);
begin
  inherited;
  Application.OnMessage := FirstChance;
  if aOwner is TWinControl then
    FListener := TWinControl(aOwner)
  else
    FListener := Self;
end;

procedure TApplicationHelper.FirstChance(var Msg: TMsg;
  var Handled: Boolean);
begin
{get in and out...this gets called alot...I would recommend only using
 PostMessage since it is non blocking}
  if Assigned(FListener) then
  begin
    if Msg.Message = WM_SYSCOMMAND then
    begin
      PostMessage(FListener.Handle, WM_SYSCOMMAND1, Msg.wParam, Msg.lParam);
    end;
  end;
end;

procedure TApplicationHelper.WMSysCommand1(var Msg: TWMSysCommand);
begin
  ShowMessage('WMSYSCOMMAND1 AppHelper');
end;

end.      

Example of how to call the Non Blocking form.

unit IForms;

interface

uses
  Forms, Controls;

type
  TModalResultEvent = procedure(aSender: TObject; var aModal: TModalResult) of object;

IForm = interface
  function getEnableForm: boolean;
  procedure setEnableForm(const Value: boolean);
  Property EnableForm: boolean read getEnableForm write setEnableForm;
end;

implementation

end.

TForm1 = class(TForm, IForm)
  Button1: TButton;
  Button2: TButton;
  procedure Button1Click(Sender: TObject);
  procedure Button2Click(Sender: TObject);
  procedure FormCreate(Sender: TObject);
  procedure CheckBox1Click(Sender: TObject);
  procedure FormDestroy(Sender: TObject);      
private
  { Private declarations }
  FEnable:  boolean;
  FAppHelper: TApplicationHelper;      
  procedure FormModal(aSender: TObject; var aModal: TModalResult);
  function getEnableForm: boolean;
  procedure setEnableForm(const Value: boolean);
//don't need it
//procedure EnableChildren(aParent: TWinControl; aEnable: boolean);
  procedure WMSysCommand1(var Msg: TWMSysCommand); message WM_SYSCOMMAND1;
public
{ Public declarations }
  Property EnableForm: boolean read getEnableForm write setEnableForm;
end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
uses
  Unit2, Unit3;

procedure TForm1.Button1Click(Sender: TObject);
var
  a_Form: TForm2;
begin
//Normal blocking code
  a_Form := TForm2.Create(nil);
  try
    a_Form.ShowModal;
  finally
    a_Form.Free;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  a_Form: TForm3;
begin
//Non blocking code
  a_Form := TForm3.Create(nil);
  a_Form.ShowModal(Self, FormModal);
end;
{
  mrNone     = 0;
  mrOk       = idOk;
  mrCancel   = idCancel;
  mrAbort    = idAbort;
  mrRetry    = idRetry;
  mrIgnore   = idIgnore;
  mrYes      = idYes;
  mrNo       = idNo;
  mrAll      = mrNo + 1;
  mrNoToAll  = mrAll + 1;
  mrYesToAll = mrNoToAll + 1;

 }
procedure TForm1.FormModal(aSender: TObject; var aModal: TModalResult);
var
  a_Message: string;
begin
  if aSender is TForm then
    a_Message := 'Form: ' + TForm(aSender).Name;

  Case aModal of
    mrNone: a_Message := a_Message + ' None';
    mrOk: a_Message := a_Message + ' Ok';
    mrCancel: a_Message := a_Message + ' Cancel';
    mrAbort: a_Message := a_Message + ' Abort';
    mrRetry: a_Message := a_Message + ' Retry';
    mrYes: a_Message := a_Message + ' Yes';
    mrNo: a_Message :=  a_Message + ' No';
    mrAll: a_Message :=  a_Message + ' All';
    mrNoToAll: a_Message :=  a_Message + ' No To All';
    mrYesToAll: a_Message :=  a_Message + ' Yes To All';
  else
    a_Message := a_Message + ' Unknown';
  end;
  ShowMessage(a_Message);
end;
{
procedure TForm1.EnableChildren(aParent: TWinControl; aEnable: boolean);
var
  a_Index: integer;
begin
  for a_Index :=  0 to aParent.ControlCount - 1 do
  begin
    if aParent.Controls[a_Index] is TWinControl then
      EnableChildren(TWinControl(aParent.Controls[a_Index]), aEnable);
    aParent.Controls[a_Index].Enabled := aEnable;
  end;
end;}

function TForm1.GetEnableForm: boolean;
begin
  //Result := FEnable;
  Result := Enabled;
end;

procedure TForm1.SetEnableForm(const Value: boolean);
begin
  //FEnable := Value;
  Enabled := Value;
  //EnableChildren(Self, FEnable);
end.

procedure TForm1.FormCreate(Sender: TObject);
begin
  FAppHelper:= TApplicationHelper.Create(Self);
  FAppHelper.Parent := Self;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  if CheckBox1.Checked then
    FAppHelper.Listener := Self
  else
    FAppHelper.Listener := FAppHelper;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FAppHelper.Free;
end;

procedure TForm1.WMSysCommand1(var Msg: TWMSysCommand);
begin
  ShowMessage('WMSYSCOMMAND1 Form1');
end;
{
object Form1: TForm1
  Left = 84
  Top = 126
  Width = 514
  Height = 259
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 56
    Top = 56
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 256
    Top = 56
    Width = 75
    Height = 25
    Caption = 'Button2'
    TabOrder = 1
    OnClick = Button2Click
  end
  object CheckBox1: TCheckBox
    Left = 256
    Top = 112
    Width = 97
    Height = 17
    Caption = 'Send to Form'
    Checked = True
    State = cbChecked
    TabOrder = 2
    OnClick = CheckBox1Click
  end
end
}    

This is the Non Blocking Form

unit Unit3;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Unit1, StdCtrls;

type
  TForm3 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    FForm: IForm;
    FModalResultEvent: TModalResultEvent;
  protected
    procedure DoClose; virtual;
  public
    { Public declarations }
    procedure ShowModal(aForm: IForm; aModalResultEvent: TModalResultEvent) overload;  
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

{
  object Button1: TButton
    Left = 32
    Top = 128
    Width = 73
    Height = 25
    Caption = 'Yes'
    ModalResult = 6
    TabOrder = 0
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 128
    Top = 128
    Width = 57
    Height = 25
    Caption = 'No'
    ModalResult = 7
    TabOrder = 1
    OnClick = Button1Click
  end
  object Button3: TButton
    Left = 216
    Top = 128
    Width = 57
    Height = 25
    Caption = 'Cancel'
    ModalResult = 2
    TabOrder = 2
    OnClick = Button1Click
  end
}

procedure TForm3.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  try
    DoClose;
  finally
    Action := caFree;
  end;
end;

procedure TForm3.ShowModal(aForm: TForm; aModalResultEvent: TModalResultEvent);
begin
  FForm := aForm;
  FModalResultEvent := aModalResultEvent;
  if Assigned(FForm) then
    FForm.EnableForm:= False;
  Self.Show;
end;

procedure TForm3.Button1Click(Sender: TObject);
begin
  if Sender is TButton then
  begin
    Self.ModalResult := TButton(Sender).ModalResult;
    Close;
  end;
end;

procedure TForm3.DoClose;
var
  a_MR: TModalResult;
begin
  a_MR := Self.ModalResult;
  if Assigned(FForm) then
    FForm.EnableForm := True;

  if Assigned(FModalResultEvent) then
    FModalResultEvent(Self, a_MR);
end;

Answer 2

When you click on the task bar button, the system attempts to execute the minimize action for the window associated with the task bar button. Typically that is the window for the main form. That is where the WM_SYSCOMMAND originates.

Now, when a modal form is showing, the main form is disabled. It was disabled with a call to the Win32 EnableWindow function. That is an integral part of modality. The modal window is the only enabled top level window because you are not supposed to interact with any other top level window.

When a window is disabled, its system menu is also disabled. That is why the system is unable to perform the minimize action, and why you do not receive WM_SYSCOMMAND.

There's not a whole lot that you can do about this. Once you show a modal form, the main window has to be disabled. And at that point it is not going to receive WM_SYSCOMMAND and is not going to find out that the user clicked the task bar button.