高分相求:ShowModal方法的另类实现,请对VCL机制了解的朋友看看. [1000分] (100分)

//发现DELPHI的窗体ShowModal有很多不尽人意的地方,
//功力太浅,改VCL源码也没有实现我想达到的效果.
//用其它方法也试了,总是达不到完美,看有没有哪位已经做到了

//覆盖TCustomForm的ShowModal方法
//可能还要覆盖CreateParams方法
function ShowModal:Integer;override;

function TBaseForm.ShowModal: Integer;
begin
//
end;

//要求达到的效果:
//1.ShowModal后,点击任务栏上的应用程序按钮可以把应用程序最小化
//2.ShowModal后,ShowModal窗口有最小化按钮,按下可以最小化整个应用程序
//3.不影响正常使用,尽量不用其它地方配合,只在一个基类中完成
//4.最重要的一点,分数不是问题~呵呵

上面的问题解决,但还有些不近人意的地方...请看

ShowModal后,我用下面的过程想实现Application的菜单与当前活动窗体的菜单一致.

procedure TFrmBase.UpdateApplicationMenu;
var
i : Integer;
iCount : Integer;
hMenu : HWND;
psMenu : array[0..MAXBYTE] of char;
uFlags : Integer;
begin
hMenu := GetSystemMenu(Application.Handle,False);
iCount := GetMenuItemCount(hMenu);
for i := 0 to iCount - 1 do
DeleteMenu(hMenu,0,MF_BYPOSITION);

hMenu := GetSystemMenu(Handle,False);
iCount := GetMenuItemCount(hMenu);
for i := 0 to iCount - 1 do
begin
GetMenuString(hMenu,i,psMenu,MAXBYTE,MF_BYPOSITION);
if StrPas(psMenu) = '' then
uFlags := MF_SEPARATOR
else
uFlags := MF_BYCOMMAND;
AppendMenu(
GetSystemMenu(Application.Handle,False),
uFlags,
GetMenuItemID(hMenu,i),
psMenu);
end;
end;

另,syAppHandler单元的主过程改为成如下
function NewWndProc(
Handle : HWND;
Msg : Integer;
wParam : Longint;
lParam : Longint
):Longint
stdcall;
begin
Result := 0;
if Msg = WM_SYSCOMMAND then
begin
case wParam of
SC_MINIMIZE : //最小化消息
begin
if Assigned(Screen.ActiveForm) then
SetWindowPos(
Application.Handle,
Screen.ActiveForm.Handle,
Screen.ActiveForm.Left,
Screen.ActiveForm.Top,
Screen.ActiveForm.Width,
0,SWP_SHOWWINDOW);
DefWindowProc(Application.Handle,WM_SYSCOMMAND,SC_MINIMIZE,0);
end;
SC_RESTORE : //还原消息
begin
if Assigned(Screen.ActiveForm) then
SetWindowPos(
Application.Handle,
Screen.ActiveForm.Handle,
Screen.ActiveForm.Left,
Screen.ActiveForm.Top,
Screen.ActiveForm.Width,
0,SWP_SHOWWINDOW);
DefWindowProc(Application.Handle,WM_SYSCOMMAND,SC_RESTORE,0);
end;
SC_CLOSE : //关闭消息
if (Application.MainForm = nil) and Assigned(Screen.ActiveForm) then
Screen.ActiveForm.Close
else
Result := CallWindowProc(OldWProc, Handle, Msg, wParam, lParam);
else //其它默认消息
if Assigned(Screen.ActiveForm) then
if Screen.ActiveForm.FormStyle <> fsMDIChild then
Result := DefWindowProc(
Screen.ActiveForm.Handle,WM_SYSCOMMAND,wParam,lParam)
else
Result := DefWindowProc(
Application.MainForm.Handle,WM_SYSCOMMAND,wParam,lParam)
else
Result := CallWindowProc(OldWProc, Handle, Msg, wParam, lParam);
end
//case
end
else
Result := CallWindowProc(OldWProc, Handle, Msg, wParam, lParam);
end;

我在工程中MDI主窗体建立之前SHOW了一个登录窗体,所有动作都正常,也自动更新
但建立了主窗体(MDI)后,菜单的Enabled不更新了.

现在我想知道,更新系统菜单的Enabled是什么消息?TApplication是怎么处理的?
我得自己处理了,像最大化,最小化等...

另,我加上的菜单项前面没有系统默认的图标,像关闭前有个×的图标,应该怎么加来着?

to 楼主:
说话可要算数啊,我已经做到了,
1000分哦,大大刺激了我的思维能力,呵呵
你也可以自己实现一个基类,来实现这种功能,方法在后面说明
只需要修改你的Forms单元就可以了,其它的地方不需要任何改动,

复制Forms.pas到当前目录,然后按下面的步骤修改:
1.查找下面的内容
function TCustomForm.ShowModal: Integer;
var
WindowList: Pointer;
SaveFocusCount: Integer;
SaveCursor: TCursor;
SaveCount: Integer;
ActiveWindow: HWnd;
begin
CancelDrag;
if Visible or not Enabled or (fsModal in FFormState) or
(FormStyle = fsMDIChild) then
raise EInvalidOperation.Create(SCannotShowModal);
if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
ReleaseCapture;
Include(FFormState, fsModal);
ActiveWindow := GetActiveWindow;
SaveFocusCount := FocusCount;
Screen.FSaveFocusedList.Insert(0, Screen.FFocusedForm);
Screen.FFocusedForm := Self;
SaveCursor := Screen.Cursor;
Screen.Cursor := crDefault;
SaveCount := Screen.FCursorCount;
WindowList := DisableTaskWindows(0);
在它的后面加上一句:
EnableWindow(Application.Handle, True);
可以实现你的第一个要求

2.查找下面的内容
procedure TCustomForm.WMSysCommand(var Message: TWMSysCommand);
begin
在后面加入下面的代码:
if (fsModal in FormState) and
(Message.CmdType and $FFF0 = SC_MINIMIZE) then
begin
Application.Minimize;
end
else

此修改为了解决你的第二个要求
同时,这两处修改都符合你的第三个要求

下面介绍第二种方法
假设自己实现一个基类,分别实现下面两个过程
第一:
覆盖父类的方法
protected
procedure DoShow
override;

过程的内容如下:
begin
if (fsModal in FormState) then
begin
EnableWindow(Application.Handle, True);
end;
inherited;
end;

第二:
进行消息映射:
protected
procedure WMSysCommand(var Message: TWMSysCommand)
message WM_SYSCOMMAND;

过程的内容如下:
begin
if (fsModal in FormState) and
(Message.CmdType and $FFF0 = SC_MINIMIZE) then
begin
Application.Minimize;
end
else inherited;
end;

注意,第一钟方法已经经过验证,
第二种方法未经测试,但是应该没有什么问题

第一条实现没什么问题 。
第二条比较麻烦,主窗口被Diable掉了，不会对鼠标，键盘产生的原始
消息作出放应.

To LiChaoHui:
你的代码大部分情况还不错,不过如果有Form的FormStyle属性是fsStayOnTop,
就会把整个布局变乱.
原因是TApplication.WndProc在收到WM_Enabled消息后会
调用RestoreTopMosts过程(TApplication.Restore过程也会调用它)。
Sign,牵一发而动全身啊.

还发现一个问题,即Application的右键菜单的关闭怎么处理?
用Application.MainForm.Close;的话,非主窗体的OnClose事件不会发生.
还有其它的问题,要注意的很多,并不是一下子几句代码能解决的,呵

这题1000分绝对值.

看看能不能从能 TaskBar 处下手，不过我现在没时间.

to xeen:
我的方法没有问题呀, 很正常啊,
我试了一下,对于fsStayOnTop的窗口,处理也很正常,
没有你说的布局错乱的现象啊,

to ysai,
你不相信几行代码就可以解决,你可以测试一下啊,
我已经满足了楼主的要求了,
我在测试中还没有发现什么特殊的问题

to LiChaohuiL:
你多显示几个fsStayOnTop的窗口,然后ShowModal一个普通的窗口看看.

我试了一下，两个fsStayOnTop的窗口也很正常的，
倒是符合题意的，
这么难的问题，几行代码（总共才7行代码），
LiChaohuiL: 老大真是NB啊，
实在是难以置信，
真是精通VCL的高手啊

to LiChaoHui:
改了后,显示一个模式窗体,然后右击任务栏上应用程序的图标,最小化和还原有效,但.
关闭无效了,我可以处理Application的消息,但要怎么处理?用Application.Terminate?
当然不行,用Application.MainForm.Close?可以,但模式窗体的OnClose事件没有触发!
至于fsStayOnTop窗口,我一般不用,可以放到后面解决.

to xeen:
真是牵一发而动全身!从 TaskBar 处下手?不太明白...

我自己也试过几种方法了,就是不能达到满意的效果.
已经做到了点任务栏按钮,非主窗体最小化的动画效果,这点DELPHI处理得不好.
还有,WINDOWS的Modal窗口有父窗口,如果点它的父窗口的话,模式窗口的标题会闪,
这点可以覆盖CreateParams方法解决,但配合LiChaoHui的代码就会出问题,我的代码是:

procedure CreateParams(var Params:TCreateParams)
override;

procedure TBaseForm.CreateParams(var Params: TCreateParams);
begin
inherited;
if Owner is TForm then
Params.WndParent:=TForm(Owner).Handle;
end;

感觉DELPHI的Application对象封装的有点过了,呵呵
不知道有没有必要自己写个东西代替Application的任务栏按钮.

我试了一下，的确有点问题，fsStayOnTop的窗口跑到最上面去了
把ShowModal 的对话框都遮住了，又研究了一下，现做出修正：
在EnableWindow(Application.Handle, True);
后面加上一句
Application.NormalizeAllTopMosts;

然后在后面的try语句的 finally 部分的最后面加上一句
Application.RestoreTopMosts;

呵呵，似乎解决问题了，不过还不太满意

感觉上只修改一个组件比较难，估计至少得对Forms单元的几个类做修改
才能得到比较满意的效果，这就是说要对VCL代码大动干戈了,出问题
的风险更大[]

to 轻舞肥羊,
>>改了后,显示一个模式窗体,然后右击任务栏上应用程序的图标,最小化和还原有效,但.
>>关闭无效了,我可以处理Application的消息,但要怎么处理?用Application.Terminate?
>>当然不行,用Application.MainForm.Close?可以,但模式窗体的OnClose事件没有触发!
>>至于fsStayOnTop窗口,我一般不用,可以放到后面解决.
我看了一下，没什么问题啊，最小化，恢复，关闭都是正常的，可以关闭程序的
看VCL中的源码，在模态窗口显示时，如果退出程序，是不会发生OnClose的事件的
但是，如果你想让它发生，那也是很容易的事情的，
通过我上面的代码 fsStayOnTop窗口的问题也解决了，
楼主还有什么不满意呢？
已经符合你的要求了

用下面的单元测试,Show出第28个模式窗体就会出问题,我是D7,不知道为什么
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
protected
procedure DoShow
override;
procedure WMSysCommand(var Message: TWMSysCommand)
message WM_SYSCOMMAND;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.DoShow;
begin
if (fsModal in FormState) then
EnableWindow(Application.Handle, True);
inherited;
end;

procedure TForm1.WMSysCommand(var Message: TWMSysCommand);
begin
if (fsModal in FormState) and
(Message.CmdType = SC_MINIMIZE) then
begin
SetWindowPos(
Application.Handle,
Screen.ActiveForm.Handle,
Screen.ActiveForm.Left,
Screen.ActiveForm.Top,
Screen.ActiveForm.Width,
0,SWP_SHOWWINDOW);
DefWindowProc(Application.Handle,WM_SYSCOMMAND,SC_MINIMIZE,0);
Application.Minimize;
end
else inherited;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
with TForm1.Create(self) do
try
Caption := 'aaaaaaa';
ShowModal;
finally
Free;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
with TForm1.Create(self) do
begin
FormStyle := fsStayOnTop;
Show;
end;
end;

end.

另外,我为了达到点击任务栏按钮有最小化及还原的动画效果,加上了下面这个单元,
结果显示模式窗体后,右击任务栏按钮,选择关闭,就没有执行关闭的动作...
unit syAppHandler;

interface

uses
Windows, Messages, SysUtils,Forms;

implementation

var
OldWProc : TFNWndProc;

function NewWndProc(
Handle : HWND;
Msg : Integer;
wParam : Longint;
lParam : Longint
):Longint
stdcall;
begin
if Msg = WM_SYSCOMMAND then
begin
case wParam of
SC_MINIMIZE :
begin
if Assigned(Screen.ActiveForm) then
SetWindowPos(
Application.Handle,
Screen.ActiveForm.Handle,
Screen.ActiveForm.Left,
Screen.ActiveForm.Top,
Screen.ActiveForm.Width,
0,SWP_SHOWWINDOW);
DefWindowProc(Application.Handle,WM_SYSCOMMAND,SC_MINIMIZE,0);
end;
SC_RESTORE :
begin
if Assigned(Screen.ActiveForm) then
SetWindowPos(
Application.Handle,
Screen.ActiveForm.Handle,
Screen.ActiveForm.Left,
Screen.ActiveForm.Top,
Screen.ActiveForm.Width,
0,SWP_SHOWWINDOW);
DefWindowProc(Application.Handle,WM_SYSCOMMAND,SC_RESTORE,0);
end;
{SC_CLOSE ://如果加上这些,可以截到消息,但应该怎么处理?
begin
if Assigned(Application.MainForm) then
Application.MainForm.Close
else
Application.Terminate;
end;}
end;
end
else
Result := CallWindowProc(OldWProc, Handle, Msg, wParam, lParam);
end;

initialization
//取代应用程序的消息处理
OldWProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC,
Longint(@NewWndProc)));

finalization
//还原消息处理过程
if OldWProc <> Nil then
SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(OldWProc));

end.

看来的确是不容易啊，楼主的附加条件太难了点，呵呵，继续看看吧

我定义了一个单元，定义了一个窗体基类，
你的其它窗口都要从这个基类继承，再配合你的动画显示窗口的代码，
我测试了很多遍，没有出现什么异常啊

unit UBase;

interface

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

type
TBaseForm = class(TForm)
private
{ Private declarations }
protected
procedure DoShow
override;
procedure DoHide
override;
procedure WMSysCommand(var Message: TWMSysCommand)
message WM_SYSCOMMAND;
public
{ Public declarations }
end;

var
BaseForm: TBaseForm;

implementation


{ TBaseForm }

procedure TBaseForm.DoHide;
begin
inherited;
if (fsModal in FormState) then
begin
Application.RestoreTopMosts;
end;
end;

procedure TBaseForm.DoShow;
begin
if (fsModal in FormState) then
begin
EnableWindow(Application.Handle, True);
Application.NormalizeTopMosts;
end;
inherited;
end;

procedure TBaseForm.WMSysCommand(var Message: TWMSysCommand);
begin
if (fsModal in FormState) and
(Message.CmdType = SC_MINIMIZE) then
begin
SetWindowPos(
Application.Handle,
Screen.ActiveForm.Handle,
Screen.ActiveForm.Left,
Screen.ActiveForm.Top,
Screen.ActiveForm.Width,
0,SWP_SHOWWINDOW);
DefWindowProc(Application.Handle,WM_SYSCOMMAND,SC_MINIMIZE,0);
Application.Minimize;
end
else inherited;
end;

end.

你的那个动画的单元，我也做了修正，修正后如下：
你少了个默认消息处理

unit syAppHandler;

interface

uses
Windows, Messages, SysUtils,Forms;

implementation

var
OldWProc : TFNWndProc;

function NewWndProc(
Handle : HWND;
Msg : Integer;
wParam : Longint;
lParam : Longint
):Longint
stdcall;
begin
if Msg = WM_SYSCOMMAND then
begin
case wParam of
SC_MINIMIZE :
begin
if Assigned(Screen.ActiveForm) then
SetWindowPos(
Application.Handle,
Screen.ActiveForm.Handle,
Screen.ActiveForm.Left,
Screen.ActiveForm.Top,
Screen.ActiveForm.Width,
0,SWP_SHOWWINDOW);
DefWindowProc(Application.Handle,WM_SYSCOMMAND,SC_MINIMIZE,0);
end;
SC_RESTORE :
begin
if Assigned(Screen.ActiveForm) then
SetWindowPos(
Application.Handle,
Screen.ActiveForm.Handle,
Screen.ActiveForm.Left,
Screen.ActiveForm.Top,
Screen.ActiveForm.Width,
0,SWP_SHOWWINDOW);
DefWindowProc(Application.Handle,WM_SYSCOMMAND,SC_RESTORE,0);
end;
{SC_CLOSE ://如果加上这些,可以截到消息,但应该怎么处理?
begin
if Assigned(Application.MainForm) then
Application.MainForm.Close
else
Application.Terminate;
end;}
else
Result := CallWindowProc(OldWProc, Handle, Msg, wParam, lParam);
end;
end
else
Result := CallWindowProc(OldWProc, Handle, Msg, wParam, lParam);
end;

initialization
//取代应用程序的消息处理
OldWProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC,
Longint(@NewWndProc)));

finalization
//还原消息处理过程
if OldWProc <> Nil then
SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(OldWProc));

end.

晕,发现问题越来越多了.....

看看这里
http://www.delphibbs.com/keylife/iblog_show.asp?xid=294

不难就不值这么多分了,嘿嘿

呵呵，你也在研究这些东西，我给你我的成果看一下吧，
的确是改动了n多的地方，我采用过几种方案，
现在觉的目前的这一种比较好

我解决了，系统菜单的不一致，窗口最大化时的闪烁，
正常平铺，窗口显示动画，
使得窗口看起来更像是VC开发出来的，
判断程序是否是Delphi编写的最简易方法(根据程序的任务栏系统菜单)失效

不管此题难与不难，我的解答完全符合了你开头的要求，
这一点你要承认，
我对Forms单元的改造，在playicq上面有个例子程序，
http://new.playicq.com/dispdocnew.php?id=2156

但是更成功的改造，如果需要程序，留下email
我发送给你可执行程序，你可以看一下效果