在Windows 8.1上运行的Delphi（2007）程序中，我希望在用户单击属于我的程序的任务栏按钮时收到通知。所以我正在捕获WM_SYSCOMMAND，在这种情况下通常会发送。
这适用于程序的主窗口。
如果模态窗口处于活动状态（使用Form2.ShowModal打开），则相同的代码无法捕获WM_SYSCOMMAND，无论是在main for还是在modeal形式中。有什么不同吗？有没有办法改变这个？
这是我添加到两种表单中的代码：
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。
答案 0 :(得分：10)
单击任务栏按钮时，系统会尝试对与任务栏按钮关联的窗口执行最小化操作。通常，这是主窗体的窗口。这就是WM_SYSCOMMAND的起源地。
现在，当显示模式窗体时，将禁用主窗体。通过调用Win32 EnableWindow函数禁用它。这是模态的一个组成部分。模态窗口是唯一启用的顶级窗口，因为您不应该与任何其他顶级窗口进行交互。
禁用窗口时，系统菜单也会被禁用。这就是为什么系统无法执行最小化操作，以及您没有收到WM_SYSCOMMAND的原因。
你可以做很多事情。显示模态窗体后，必须禁用主窗口。此时它不会收到WM_SYSCOMMAND，也不会发现用户点击了任务栏按钮。
答案 1 :(得分：0)
我要给你的是一个使用非阻塞代码的工作。
您需要声明一个事件，告诉我们表单何时关闭。
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;