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

  • 主题发起人 轻舞肥羊
  • 开始时间
B

barton

Unregistered / Unconfirmed
GUEST, unregistred user!
鱼和熊掌不可兼得。Delphi这样处理也是迫于无赖。又得让你能够设计方便,又要方便运
行。你看看VC++设计对话框多麻烦。相比之下你可以做一个取舍。
 
L

LiChaoHui

Unregistered / Unconfirmed
GUEST, unregistred user!
用下面的过程想实现Application的菜单与当前活动窗体的菜单一致?
有必要吗?完全没必要,
我给你发的东西,可以做到主窗口和application的菜单一致,
已经很不容易了,导致很多地方的修改
 

轻舞肥羊

Unregistered / Unconfirmed
GUEST, unregistred user!
TO LiChaoHui:
我是要在不修改VCL源码的基础上完成,可不想因为DELPHI的版本不同就不能用了.
至于有没有必要,这个问题不用管了,我就是想完成这样的效果,现在请从纯技术的角
度来看这个问题,而不要从需求角度看.
因为我用的是D7,你的源码我根本搞不懂~~~

反正我就是吃饱饭没事做(否则就不是肥羊了),想完成这个功能,就像客户一样,
提什么要求都是可能的 ^_^

 

小笨苯

Unregistered / Unconfirmed
GUEST, unregistred user!
借贵宝地问LiChaoHui大侠一个问题,就是怎样才能完美的实现Delphi写的程序在Windows
任务栏上的系统菜单的标准化(就是解决我们平常看到的只有三项菜单的现象),网上的方
法很多,但都有各种各样的缺点。
 

小雨哥

Unregistered / Unconfirmed
GUEST, unregistred user!
这么多的代码,我不看了,哪里一个是可以用的啊,热心的告诉一声就可以了。
其实也是很简单的事情,就是 abc 库中的 TToolWindow 加一个最小化功能啊。
 
S

sgzc

Unregistered / Unconfirmed
GUEST, unregistred user!
我只试一下,还没有从TCustomForm继承,我想应该一样,试一试。以下是你想要的ModalForm;


unit Unit2;

interface

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

type
PTaskWindow = ^TTaskWindow;
TTaskWindow = record
Next: PTaskWindow;
Window: HWnd;
end;

TForm2 = class(TForm)
lst1: TListBox;
btn1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FList:TList;
procedure CloseModal;
procedure HideAllWindow;
procedure ShowAllWindow;
procedure WMSysCommand(var Msg:TWMSYSCOMMAND);message WM_SYSCOMMAND;
public
{ Public declarations }
function ShowModal:integer
override;

end;

var
Form2: TForm2;

implementation

{$R *.dfm}

procedure EnableTaskWindows(WindowList: Pointer);
var
P: PTaskWindow;
begin
while WindowList <> nil do
begin
P := WindowList;
if IsWindow(P^.Window) then EnableWindow(P^.Window, True);
WindowList := P^.Next;
Dispose(P);
end;
end;

function TForm2.ShowModal:integer;
const
SCannotShowModal = 'Cannot make a visible window modal';
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;
Application.ModalStarted;
try
Include(FFormState, fsModal);
ActiveWindow := GetActiveWindow;
SaveCursor := Screen.Cursor;
Screen.Cursor := crDefault;
WindowList := DisableTaskWindows(0);
try
Show;
try
SendMessage(Handle, CM_ACTIVATE, 0, 0);
ModalResult := 0;
repeat
Application.HandleMessage;
if Application.Terminated then ModalResult := mrCancel else
if ModalResult <> 0 then CloseModal;

until ModalResult <> 0;
Result := ModalResult;
SendMessage(Handle, CM_DEACTIVATE, 0, 0);
SetACtiveWindow(ActiveWindow);
if GetActiveWindow <> Handle then ActiveWindow := 0;
finally
Hide;
end;
finally
Screen.Cursor := SaveCursor;
EnableTaskWindows(WindowList);
Exclude(FFormState, fsModal);
end;
finally
Application.ModalFinished;
end;
end;

procedure TForm2.CloseModal;
var
CloseAction: TCloseAction;
begin
try
CloseAction := caNone;
if CloseQuery then
begin
CloseAction := caHide;
DoClose(CloseAction);
end;
case CloseAction of
caNone: ModalResult := 0;
caFree: Release;
end;
except
ModalResult := 0;
Application.HandleException(Self);
end;
end;

procedure TForm2.WMSysCommand(var Msg:TWMSYSCOMMAND);
begin
inherited;
if Msg.CmdType=SC_MINIMIZE then begin
//Application.MainForm.Hide;
//Application.Components;
HideAllWindow;
end;

if Msg.CmdType=SC_RESTORE then begin
SHowAllWindow;
Windows.SetActiveWindow(Handle);
end;
end;

procedure TForm2.HideAllWindow;
var
i:INteger;
Control:TComponent;
Frm:TForm;
begin
for i:=0 to Screen.FormCount-1 do begin
if Screen.Forms.Visible and (Screen.Forms.Handle<>Handle) then begin
FList.Add(Pointer(Screen.Forms.Handle));
Screen.Forms.Hide;
end;
end;

end;

procedure TForm2.ShowAllWindow;
var
i:INteger;
Control:TComponent;
begin

for i:=FList.Count-1 Downto 0 do begin
ShowWindow(Integer(FList),SW_RESTORE);
end;
FList.Clear;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
FList:=TList.Create;
end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
FList.Free;
end;

end.
 

轻舞肥羊

Unregistered / Unconfirmed
GUEST, unregistred user!
TO sgzc:
你只是把Forms单元中的代码搬过来修改了点,你所做的功能LiChaoHui已经完成了,也
没有修改VCL源码...看来你没有认真看完整个贴子.
 

爱元元的哥哥

Unregistered / Unconfirmed
GUEST, unregistred user!
茴字有九种写法
 
L

LiChaoHui

Unregistered / Unconfirmed
GUEST, unregistred user!
我的方法是设置Application.Handle对应的窗口的扩展风格GWL_EXSTYLE
加入WS_EX_TOOLWINDOW特性,使其在任务栏上的按钮消失,
同时设置主窗口的wndparent父窗口(在CreateParams覆盖中设置)为桌面,
可以使其在任务栏上出现窗口,同时需要处理WM_SYSCOMMAND消息,
使其能够正常最小化和恢复,

这样会产生许多问题(违反了vcl原本的设计思想)
所以,我做了很多修改,但是还有些不完美的地方,
相关代码,你可以从playicq上面下载,

我最早使用的方法是,使application.handle不产生窗口对象,
但是,Application本身的复杂消息处理我不能处理的很好,
所有现在我用后面一种方法,效果也不错的
 
L

LiChaoHui

Unregistered / Unconfirmed
GUEST, unregistred user!
http://new.playicq.com/dispdocnew.php?id=5184
我已经说了不少了,你可以看一下我得实现怎么样,如果不满意,
我也只能做到那样了
 

小笨苯

Unregistered / Unconfirmed
GUEST, unregistred user!
LiChaoHui:
多谢大侠,说得极是啊!这些我都知道,但你有没有发现在其他不经意的地方,就会与正常
的窗口有所不同,我说的不是程序的主窗口,而是其他的模式或非模式的窗口,唉~~~~~~
其实,我们都应该知道,Borland的工程师们水平都很高,他们之所以要去掉那几项,一定
是有原因的,所以,我们强行改变,总会有一些潜在的缺陷,真不知怎么才好....
 
L

LiChaoHui

Unregistered / Unconfirmed
GUEST, unregistred user!
你可以说出来那些不同的地方啊,看看能不能解决

对Vcl的代码看的越多,你就越发现,vcl的窗口机制设计的是很有问题的,
最起码他不符合Windows本身的窗口框架和机制,
甚至,你会发现某些vcl对象,borland的程序员太偷懒了,
甚至是偷工减料

我告诉你他们删除Application.Handle的那几项的目的所在吧,
因为Application.Handle. 和主窗口不是一个Windows窗口,
所以菜单不同,这也是平铺窗口异常的原因,
对Application来说,他可能在不是基于窗口的应用程序中提供消息机制,
所以必须有个窗口,

菜单的那几项是没有用的,保持和主窗口的一致也很麻烦,会产生其他的问题,
所以干脆偷懒,直接删掉,最好不过了
 

轻舞肥羊

Unregistered / Unconfirmed
GUEST, unregistred user!
我就想知道茴字的另外几种写法,有什么不对吗?

现在的问题是从纯技术的角度来实现:Application的菜单与当前活动窗体的菜单一致
附加条件:活动窗体的状态改变后(最大化,还原),Application的菜单项的Enabled要
同时响应,另外,关闭,最小化,最大化,还原菜单中要用系统的默认图标.

至于赞成的不良后果,先不去讨论它.问题总有解决的办法

这可是有屎以来我发起的贴中最长的贴了,呵呵,希望不要让大家失望
 
L

LiChaoHui

Unregistered / Unconfirmed
GUEST, unregistred user!
而且平铺窗口的漏洞也还是没有办法的,

C#的开发环境也不能正常平铺窗口了,
是不是,Delphi中某些“思想”被移植到VS7了
 

小笨苯

Unregistered / Unconfirmed
GUEST, unregistred user!
LiChaoHui:
>>我告诉你他们删除Application.Handle的那几项的目的所在吧,
>>因为Application.Handle. 和主窗口不是一个Windows窗口,
>>所以菜单不同,这也是平铺窗口异常的原因,
>>对Application来说,他可能在不是基于窗口的应用程序中提供消息机制,
>>所以必须有个窗口,
原来是这样啊,多谢!
>>C#的开发环境也不能正常平铺窗口了,
>>是不是,Delphi中某些“思想”被移植到VS7了
有这样的事啊??!!好了,算了,我也不想再深追这事了[:(]
 
K

Kingron

Unregistered / Unconfirmed
GUEST, unregistred user!
>>现在的问题是从纯技术的角度来实现:Application的菜单与当前活动窗体的菜单一致
>>附加条件:活动窗体的状态改变后(最大化,还原),Application的菜单项的Enabled要
>>同时响应,另外,关闭,最小化,最大化,还原菜单中要用系统的默认图标.

及其简单!要弹出窗体系统菜单,只要利用一个语句消息即可:
SendMessage(GetActiveWindow,$313,0,0);
至于如何拦截那么也很简单,处理系统的Wndproc即可,在我的主页你可以找到所有问题的答案:
http://kingron.delphibbs.com

其实劳中成很久以前就研究这个问题(TaskBar菜单),我也研究过。去我的主页早早把。需要联合起来,我主页的资料都是零散的。
 
K

Kingron

Unregistered / Unconfirmed
GUEST, unregistred user!
http://www.soulan.com/kingron/delphi/standappmenu.htm
http://www.soulan.com/kingron/document/appsysmenu.htm
 

轻舞肥羊

Unregistered / Unconfirmed
GUEST, unregistred user!
TO Kingron:
$313 是什么消息?有没有标识?我想在MSDN上找找相关资料.它的最后两个参数是干嘛的.

你给的第一个链接不适合多窗体的应用程序
第二个,照做
if Msg = WM_INITMENU then
SendMessage(Screen.ActiveForm.Handle,$313,0,0) //GetActiveWindow一样
else
Result := CallWindowProc(OldWProc, Handle, Msg, wParam, lParam);
也没用,在SendMessage设断点是停下来了,但弹出的还是Application的菜单
 
K

Kingron

Unregistered / Unconfirmed
GUEST, unregistred user!
完美解决方法:
unit ModalForm;

{$IFNDEF _DEBUG_}
{$D-}
{$ENDIF}
{********************************************************************}
{* *}
{* Base Form for Modal Dialog *}
{* Copyright Kingron 2002.10.22 *}
{* WEB:http://kingron.myetang.com *}
{* Bug Report: Kingron@163.net *}
{* *}
{********************************************************************}

interface

uses
Windows, Messages, SysUtils, Classes, Forms, Controls, StdCtrls, Buttons,
ExtCtrls;

type
TCallBackProc = procedure(AForm: TForm) of object;

type
TFrmModal = class(TForm)
btnCancel: TButton;
btnOk: TButton;
bvlSpaceline: TBevel;
lblShadow: TLabel;
lblDivid: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject
var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
private
FAnimateStyle: integer;
OldWndProc: Pointer;
NewWndProc: Pointer;
procedure Hook;
procedure UnHook;
procedure Hooked(var Msg: TMessage);
procedure WMSysCommand(var Msg: TWMCommand)
message WM_SYSCOMMAND;
protected
{ Private declarations }
procedure CreateParams(var Para: TCreateParams)
override;
procedure DoShow
override;
published
property AnimateStyle: integer read FAnimateStyle write FAnimateStyle;
public
{ Public declarations }
class function Execute(BeforeShow: TCallBackProc = nil;
AfterClose: TCallBackProc = nil): TModalResult
virtual;
end;

implementation

{$R *.DFM}
const
CM_POPUP_MENU = WM_USER + $500
{ User Define Message for Menu Popup }
CM_APP_MENU = $0313
{ System App Menu Popup Message }

procedure TFrmModal.FormCreate(Sender: TObject);
begin
inherited;
FAnimateStyle := 0;
Screen.Cursors[crHandPoint] := LoadCursor(0, IDC_HAND);
DeleteMenu(GetSystemMenu(Handle, False), SC_SIZE, MF_BYCOMMAND);
Hook;
end;

procedure TFrmModal.CreateParams(var Para: TCreateParams);
begin
inherited;
if Application.MainForm <> nil then Para.WndParent := GetActiveWindow;
end;

class function TFrmModal.Execute(BeforeShow: TCallBackProc = nil
AfterClose:
TCallBackProc = nil): TModalResult;
var
Form: TForm;
begin
Form := Create(Application);
with Form do
try
if Assigned(BeforeShow) then BeforeShow(Form);
Result := ShowModal;
if Assigned(AfterClose) then AfterClose(Form);
finally
Free;
end;
end;

procedure TFrmModal.FormShow(Sender: TObject);

procedure RefreshControl(Control: TControl)
{ Refresh Self and SubControls }
var
i: integer;
begin
Control.Invalidate;
if Control is TWinControl then
for i := 0 to TWinControl(Control).ControlCount - 1 do
RefreshControl(TWinControl(Control).Controls);
end;

begin
if (Position = poDesigned) and (FAnimateStyle <> 0) then
begin
AnimateWindow(Handle, 200, FAnimateStyle or AW_ACTIVATE)
{ Animate Window }
SetActiveWindow(Handle)
{ Active Window }
RefreshControl(Self)
{ Update UI }
end;
end;

procedure TFrmModal.FormClose(Sender: TObject
var Action: TCloseAction);
begin
if FAnimateStyle <> 0 then
AnimateWindow(Handle, 200, AW_HIDE or FAnimateStyle)
{ Animate Window }
end;

procedure TFrmModal.DoShow;
begin
inherited;
EnableWindow(Application.Handle, True);
end;

procedure TFrmModal.Hook;
begin
OldWndProc := Pointer(GetWindowLong(Application.Handle, GWL_WNDPROC));
{ Make New WndProc }
NewWndProc := Classes.MakeObjectInstance(Hooked);
if not (csDesigning in ComponentState) then
SetWindowLong(Application.Handle, GWL_WNDPROC, longint(NewWndProc));
end;

procedure TFrmModal.UnHook;
begin
{ Restore Old WndProc }
SetWindowLong(Application.Handle, GWL_WNDPROC, longint(OldWndProc));
if Assigned(NewWndProc) then Classes.FreeObjectInstance(NewWndProc);
NewWndProc := nil;
end;

procedure TFrmModal.Hooked(var Msg: TMessage);
begin
case Msg.Msg of
{ Dont use SendMessage! }
WM_SYSCOMMAND:
case Msg.WParam of
SC_MINIMIZE: SendMessage(Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
SC_RESTORE:
SendMessage(Handle, WM_SYSCOMMAND, SC_RESTORE, 0);
end;
CM_APP_MENU:
with Mouse.CursorPos do
begin
SendMessage(Handle, CM_APP_MENU, Msg.WParam, MakeLParam(X, Y));
Exit;
end;
end;
{ Call Default Window Proc }
Msg.Result := CallWindowProc(OldWndProc, Application.Handle, Msg.Msg, Msg.wParam, Msg.lParam);
end;

procedure TFrmModal.FormDestroy(Sender: TObject);
begin
UnHook;
end;

procedure TFrmModal.WMSysCommand(var Msg: TWMCommand);
begin
case Msg.ItemID of
SC_RESTORE: Application.Restore;
SC_MINIMIZE: Application.Minimize;
end;
inherited;
end;

end.

////////////////////////////
object FrmModal: TFrmModal
Left = 450
Top = 102
Width = 388
Height = 396
BorderIcons = [biSystemMenu, biMinimize, biHelp]
Caption = 'Dialog'
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = '宋体'
Font.Style = []
OldCreateOrder = True
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
DesignSize = (
380
364)
PixelsPerInch = 96
TextHeight = 12
object bvlSpaceline: TBevel
Left = 160
Top = 315
Width = 214
Height = 5
Anchors = [akLeft, akRight, akBottom]
Shape = bsBottomLine
end
object lblShadow: TLabel
Left = 3
Top = 312
Width = 156
Height = 12
Anchors = [akLeft, akBottom]
Caption = 'Powered by Kylix.'
Enabled = False
Transparent = True
end
object lblDivid: TLabel
Left = 2
Top = 311
Width = 156
Height = 12
Anchors = [akLeft, akBottom]
Caption = 'Powered by Kylix.'
Enabled = False
Transparent = True
end
object btnCancel: TButton
Left = 307
Top = 329
Width = 68
Height = 26
Anchors = [akRight, akBottom]
Cancel = True
Caption = '&amp;Cancel'
ModalResult = 2
TabOrder = 1
end
object btnOk: TButton
Left = 231
Top = 329
Width = 70
Height = 26
Anchors = [akRight, akBottom]
Caption = '&amp;OK'
Default = True
ModalResult = 1
TabOrder = 0
end
end
 
K

Kingron

Unregistered / Unconfirmed
GUEST, unregistred user!
作为基窗体,其他窗体继承于他即可,使用方法:
procedure TForm1.Button1Click(Sender: TObject);
begin
TFrmModal.Execute();
end;
 
顶部