为什么当用户单击任务栏按钮时模态 Delphi 表单没有收到 WM_SYSCOMMAND？
Why do modal Delphi forms not receive WM_SYSCOMMAND when the user clicks the task bar button?
在 Delphi (2007) 程序 Windows 8.1 运行 中，我希望在用户单击属于我的程序的任务栏按钮时收到通知。所以我捕获了通常在这种情况下发送的 WM_SYSCOMMAND。
这适用于程序的主要部分 window。
如果模态 window 处于活动状态（用 Form2.ShowModal 打开），则相同的代码不能捕获 WM_SYSCOMMAND，无论是在主要形式还是在模态形式中。有什么不同吗？有什么办法可以改变这个吗？
这是我添加到两种形式的代码：
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.
我还尝试使用 Application.OnMessage 或 TApplicationEvents 组件，甚至覆盖表单的 WndProc 方法。当模态形式处于活动状态时，也无法捕获 WM_SYSCOMMAND。
当您单击任务栏按钮时，系统会尝试对与任务栏按钮关联的 window 执行最小化操作。通常这是主窗体的 window。这就是 WM_SYSCOMMAND 的起源。
现在，当模式窗体显示时，主窗体被禁用。它通过调用 Win32 EnableWindow 函数被禁用。这是模态的一个组成部分。模态 window 是唯一启用的顶层 window 因为你不应该与任何其他顶层交互 window.
当window被禁用时，它的系统菜单也会被禁用。这就是系统无法执行最小化操作的原因，也是您没有收到 WM_SYSCOMMAND 的原因。
对此您无能为力。一旦显示模态表单，就必须禁用主 window。那时它不会收到 WM_SYSCOMMAND 也不会发现用户单击了任务栏按钮。
David 很好地解释了这个问题，所以我不打算重复他说的话。
我要给你的是使用非阻塞代码的解决方法。`
您需要声明一个事件，以便在表单关闭时通知我们。
TModalResultEvent = procedure(aSender: TObject; var aModal: TModalResult) of object;
这使我们能够监听通过应用程序传递的消息
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.
如何调用非阻塞表单的示例。
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
}
这是非阻塞形式
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;
在 Delphi (2007) 程序 Windows 8.1 运行 中，我希望在用户单击属于我的程序的任务栏按钮时收到通知。所以我捕获了通常在这种情况下发送的 WM_SYSCOMMAND。
这适用于程序的主要部分 window。
如果模态 window 处于活动状态（用 Form2.ShowModal 打开），则相同的代码不能捕获 WM_SYSCOMMAND，无论是在主要形式还是在模态形式中。有什么不同吗？有什么办法可以改变这个吗？
这是我添加到两种形式的代码：
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.
我还尝试使用 Application.OnMessage 或 TApplicationEvents 组件，甚至覆盖表单的 WndProc 方法。当模态形式处于活动状态时，也无法捕获 WM_SYSCOMMAND。
当您单击任务栏按钮时，系统会尝试对与任务栏按钮关联的 window 执行最小化操作。通常这是主窗体的 window。这就是 WM_SYSCOMMAND 的起源。
现在，当模式窗体显示时，主窗体被禁用。它通过调用 Win32 EnableWindow 函数被禁用。这是模态的一个组成部分。模态 window 是唯一启用的顶层 window 因为你不应该与任何其他顶层交互 window.
当window被禁用时，它的系统菜单也会被禁用。这就是系统无法执行最小化操作的原因，也是您没有收到 WM_SYSCOMMAND 的原因。
对此您无能为力。一旦显示模态表单，就必须禁用主 window。那时它不会收到 WM_SYSCOMMAND 也不会发现用户单击了任务栏按钮。
David 很好地解释了这个问题，所以我不打算重复他说的话。
我要给你的是使用非阻塞代码的解决方法。`
您需要声明一个事件，以便在表单关闭时通知我们。
TModalResultEvent = procedure(aSender: TObject; var aModal: TModalResult) of object;
这使我们能够监听通过应用程序传递的消息
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.
如何调用非阻塞表单的示例。
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
}
这是非阻塞形式
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;