关于Delphi Application Normalization(Delphi程序标准化) 熟悉VCL和Win32的朋友,请帮忙改进一下代码。多谢!

时间:2022-04-02 17:33:53
下面的代码是将Delphi程序中Application在任务栏上面的按钮去除,同时用Form的按钮
替代。我把这个成为Delphi Application Normalization(Delphi程序标准化)
但是,在测试过程中碰到一个问题难以解决,就是如果当时显示了Modal Dialog,
那么点击任务栏上面的按钮将会短暂激活Form,并且Modal Dialog将会失去焦点。
这个问题看起来关系不大,但是如果使用Delphi提供的Win32通用对话框组件,
在对话框弹出的时候,也同样会使当前在Main Form之前的对话框消失,要用Alt+Tab切换
才会重新出现。熟悉VCL和Win32的朋友,请帮忙改进一下代码。多谢!
大家测试的时候将Delphi生成的Form从TForm改成从这个类派生就可以了。
unit CompXPForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Forms;

type
  { TCompXPForm }
  TCompXPForm = class (TForm)
  private
    { Private declarations }
    FPreventToolWindowToBeMainForm : Boolean;

    // Events
    FOnMinimize : TNotifyEvent;
    FOnRestore : TNotifyEvent;

    procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
  protected
    { Protected declarations }
    procedure CreateParams(var Params: TCreateParams); override;
    property PreventToolWindowToBeMainForm : Boolean
        read FPreventToolWindowToBeMainForm write FPreventToolWindowToBeMainForm
        stored True default True;

    // Events
    property OnMinimize : TNotifyEvent read FOnMinimize write FOnMinimize
        stored True;
    property OnRestore : TNotifyEvent read FOnRestore write FOnRestore
        stored True;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    { Public declarations }
  published
    { Published declarations }
  end;

implementation

var
    RefCount : Integer;

constructor TCompXPForm.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);

    if ( RefCount = 0) then
        SetWindowLong ( Application.Handle, GWL_EXSTYLE,
            GetWindowLong (Application.Handle, GWL_EXSTYLE) or
            WS_EX_TOOLWINDOW);
    Inc ( RefCount);

    if ( Application.MainForm <> nil) and ( Self <> Application.MainForm) then
    begin
        SetWindowLong ( Application.MainForm.Handle, GWL_EXSTYLE,
            GetWindowLong (Application.MainForm.Handle, GWL_EXSTYLE) or
            WS_EX_APPWINDOW);

        if (Self.FormStyle <> fsMDIChild) then SetParent ( Application.MainForm);
    end;
end;

procedure TCompXPForm.CreateParams(var Params: TCreateParams);
begin
    inherited;
    if ( Application.MainForm = nil) or ( Self = Application.MainForm) then
    begin
        if FPreventToolWindowToBeMainForm then
            Params.ExStyle := Params.ExStyle and (not WS_EX_TOOLWINDOW);
        Params.ExStyle := Params.ExStyle or WS_EX_APPWINDOW;
    end;

    // When activating, make the deactivating window disappear immediately
    Params.Style := Params.Style and (not WS_CHILDWINDOW);
end;

destructor TCompXPForm.Destroy;
begin
    Dec ( RefCount);
    if ( RefCount = 0) then begin
        if ( Application.MainForm.HandleAllocated) then
            SetWindowLong ( Application.MainForm.Handle, GWL_EXSTYLE,
                GetWindowLong (Application.MainForm.Handle, GWL_EXSTYLE) and
                ( not WS_EX_APPWINDOW));
        SetWindowLong ( Application.Handle, GWL_EXSTYLE,
            GetWindowLong (Application.Handle, GWL_EXSTYLE) and
            ( not WS_EX_TOOLWINDOW));
    end;
    inherited Destroy;
end;

procedure TCompXPForm.WMSysCommand(var Message: TWMSysCommand);
begin

    if (Message.CmdType and $FFF0 = SC_MINIMIZE) and
        (Application.MainForm = Self) then
    begin
        if not IsIconic ( Handle) then
        begin
            Application.NormalizeTopMosts;
            SetActiveWindow(Handle);
            if (Application.MainForm <> nil) and (Application.ShowMainForm or
                Application.MainForm.Visible) and IsWindowEnabled ( Handle) then
            begin
                SetWindowPos( Handle, Application.MainForm.Handle,
                    Application.MainForm.Left, Application.MainForm.Top,
                    Application.MainForm.Width, 0, SWP_SHOWWINDOW);
                DefWindowProc( Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
            end;
        end;
        if Assigned ( FOnMinimize) and ( not (csDesigning in ComponentState)) then
            FOnMinimize (Self);
    end
    else if (Message.CmdType and $FFF0 <> SC_MOVE) or
        (csDesigning in ComponentState) or (Align = alNone) or
        (WindowState = wsMinimized) then
        inherited;

    if ((Message.CmdType and $FFF0 = SC_MINIMIZE) or
        (Message.CmdType and $FFF0 = SC_RESTORE)) and
        not (csDesigning in ComponentState) and (Align <> alNone) then
        RequestAlign;

    if ( Message.CmdType and $FFF0 = SC_RESTORE) and Assigned ( FOnRestore)
        and ( not (csDesigning in ComponentState)) then
        FOnRestore (Self);
end;

end.

13 个解决方案

#1


gz

#2


你可以让窗口不可视!

#3


楼上,你见过这样的程序吗?
我的程序的目的就是Delphi程序标准化,
你还要我弄出一个奇奇怪怪的程序样式出来。

#4


up

#5


不明白你描写的是什么。我的测试如下,不知道是不是你想如此做(OS:W2K):
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, CompXPForm, StdCtrls;
type
  TForm1 = class(TCompXPForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
 end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
 MessageBox(Handle,'AAAAAAA','测试',mb_Ok);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 OpenDialog1.Execute ;
end;
end.
以上代码没有出现你所描写的情况(也许我理解错误,也许 OS 不同).
你代码中有明显的混乱,举一例:
constructor TCompXPForm.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);
    if ( RefCount = 0) then
1.----> SetWindowLong ( Application.Handle, GWL_EXSTYLE,
            GetWindowLong (Application.Handle, GWL_EXSTYLE) or
            WS_EX_TOOLWINDOW);
    Inc ( RefCount);

    if ( Application.MainForm <> nil) and ( Self <>
        Application.MainForm) then
    begin
2.----> SetWindowLong ( Application.MainForm.Handle, GWL_EXSTYLE,
            GetWindowLong (Application.MainForm.Handle,
             GWL_EXSTYLE) or WS_EX_APPWINDOW);
            
        if (Self.FormStyle <> fsMDIChild) then
         SetParent ( Application.MainForm);
    end;
end;
1.中将Application.Handle设置为WS_EX_TOOLWINDOW是无意义的,因为
  Application的窗口本来就不可见.
2.中没有对MainForm做实质的Style改变,EXStyle 是窗口类附加的四个字节
  信息,2中没有改变.所以当TCompXPForm被做为非MainForm创建时,它自己
  依然有自己的Handle,虽然你给了它一个Parent,但它除了在MainForm被
  关闭时同时也被取消生存资格外,它依然是一个独立的个体.
======== 申 明 ============
在遵循如下约定时本文可*处置:
1.保留本约定于文章适当处。
2.保全本人署名和联络方法。
3.未获授权不对内容作增删。
4.谢绝摘抄或用于赢利目的。
5.同意本作品享有充分免责。



#6


我是用MDI来测试的。

还有 针对你所说的两个问题,我回答如下
1.将Application.Handle设置为WS_EX_TOOLWINDOW是为了取消Application在任务栏上面的按钮,使Form的按钮出现任务栏上面。并非完全无意义,因为缺省的Delphi程序的Application对象虽然很有用,但是由于不完全符合Win32程序的规范,所以在某些情况下可能出现问题,比如制作DirectX的游戏时。
2.这段代码是为了确保在任务栏上出现的按钮是属于MainForm的,而不是其他窗口的。同样,为了保证和其他Win32程序保持一致。

#7


谢谢这么快就回复我的回答,只是现在这时候的网速实在太慢,没有耐心了.
首先同意你的第一点说明,不过我在 DirectX 编程中没有有意处理Application,
不论是窗口还是全屏幕模式暂时都没有发生错误,开始使用COM默认释放时,会有
程序退出了但任务条上出现一个空白按钮,后来建立了释放例程后不使用COM默认
释放就没有这个现象,查Microsoft文档,这个现象应该是 DirectX 双重代码的错.
对于第二点,试试不用也应该没有问题的,这次是又仔细看了你的代码后我这样觉得
得.另外,由于我的不求甚解,不打算仔细研究,所以只做一点建议,回到最初的问题,
你不妨使用TComponentStyle属性来达到你的目的.

#8


谢谢你的参与,我已经基本上找到问题所在了。
不过,使用TComponentStyle估计无法成功。
因为,根据目前的情况看,可能是Delphi的源代码的问题。
不是我危言耸听,但现在通过替换部分代码可能得到解决。
不知道VCL这样子设计是有意的还是是bug。

我会继续研究。感谢大家!
这份帖子还没有结束。恳请大家继续发言。

#9


up

#10


up

#11


问题已经完全解决。
而且解决方案已经发给了Borland
看他们会不会采纳
等他们的回复后我会将方法公布

不过好像没办法在C++Builder下工作
有没有C++Builder的专家
告诉我Delphi和BCB有什么不同

#12


问题已经完全解决。
而且解决方案已经发给了Borland
看他们会不会采纳
等他们的回复后我会将方法公布

不过好像没办法在C++Builder下工作
有没有C++Builder的专家
告诉我Delphi和BCB有什么不同

#13


对了,如果大家关心的话
请跟贴
我统计一下 看有多少人
如果Borland不采纳
也可以搞一个联名签名
(说笑,别当真)

#1


gz

#2


你可以让窗口不可视!

#3


楼上,你见过这样的程序吗?
我的程序的目的就是Delphi程序标准化,
你还要我弄出一个奇奇怪怪的程序样式出来。

#4


up

#5


不明白你描写的是什么。我的测试如下,不知道是不是你想如此做(OS:W2K):
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, CompXPForm, StdCtrls;
type
  TForm1 = class(TCompXPForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
 end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
 MessageBox(Handle,'AAAAAAA','测试',mb_Ok);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 OpenDialog1.Execute ;
end;
end.
以上代码没有出现你所描写的情况(也许我理解错误,也许 OS 不同).
你代码中有明显的混乱,举一例:
constructor TCompXPForm.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);
    if ( RefCount = 0) then
1.----> SetWindowLong ( Application.Handle, GWL_EXSTYLE,
            GetWindowLong (Application.Handle, GWL_EXSTYLE) or
            WS_EX_TOOLWINDOW);
    Inc ( RefCount);

    if ( Application.MainForm <> nil) and ( Self <>
        Application.MainForm) then
    begin
2.----> SetWindowLong ( Application.MainForm.Handle, GWL_EXSTYLE,
            GetWindowLong (Application.MainForm.Handle,
             GWL_EXSTYLE) or WS_EX_APPWINDOW);
            
        if (Self.FormStyle <> fsMDIChild) then
         SetParent ( Application.MainForm);
    end;
end;
1.中将Application.Handle设置为WS_EX_TOOLWINDOW是无意义的,因为
  Application的窗口本来就不可见.
2.中没有对MainForm做实质的Style改变,EXStyle 是窗口类附加的四个字节
  信息,2中没有改变.所以当TCompXPForm被做为非MainForm创建时,它自己
  依然有自己的Handle,虽然你给了它一个Parent,但它除了在MainForm被
  关闭时同时也被取消生存资格外,它依然是一个独立的个体.
======== 申 明 ============
在遵循如下约定时本文可*处置:
1.保留本约定于文章适当处。
2.保全本人署名和联络方法。
3.未获授权不对内容作增删。
4.谢绝摘抄或用于赢利目的。
5.同意本作品享有充分免责。



#6


我是用MDI来测试的。

还有 针对你所说的两个问题,我回答如下
1.将Application.Handle设置为WS_EX_TOOLWINDOW是为了取消Application在任务栏上面的按钮,使Form的按钮出现任务栏上面。并非完全无意义,因为缺省的Delphi程序的Application对象虽然很有用,但是由于不完全符合Win32程序的规范,所以在某些情况下可能出现问题,比如制作DirectX的游戏时。
2.这段代码是为了确保在任务栏上出现的按钮是属于MainForm的,而不是其他窗口的。同样,为了保证和其他Win32程序保持一致。

#7


谢谢这么快就回复我的回答,只是现在这时候的网速实在太慢,没有耐心了.
首先同意你的第一点说明,不过我在 DirectX 编程中没有有意处理Application,
不论是窗口还是全屏幕模式暂时都没有发生错误,开始使用COM默认释放时,会有
程序退出了但任务条上出现一个空白按钮,后来建立了释放例程后不使用COM默认
释放就没有这个现象,查Microsoft文档,这个现象应该是 DirectX 双重代码的错.
对于第二点,试试不用也应该没有问题的,这次是又仔细看了你的代码后我这样觉得
得.另外,由于我的不求甚解,不打算仔细研究,所以只做一点建议,回到最初的问题,
你不妨使用TComponentStyle属性来达到你的目的.

#8


谢谢你的参与,我已经基本上找到问题所在了。
不过,使用TComponentStyle估计无法成功。
因为,根据目前的情况看,可能是Delphi的源代码的问题。
不是我危言耸听,但现在通过替换部分代码可能得到解决。
不知道VCL这样子设计是有意的还是是bug。

我会继续研究。感谢大家!
这份帖子还没有结束。恳请大家继续发言。

#9


up

#10


up

#11


问题已经完全解决。
而且解决方案已经发给了Borland
看他们会不会采纳
等他们的回复后我会将方法公布

不过好像没办法在C++Builder下工作
有没有C++Builder的专家
告诉我Delphi和BCB有什么不同

#12


问题已经完全解决。
而且解决方案已经发给了Borland
看他们会不会采纳
等他们的回复后我会将方法公布

不过好像没办法在C++Builder下工作
有没有C++Builder的专家
告诉我Delphi和BCB有什么不同

#13


对了,如果大家关心的话
请跟贴
我统计一下 看有多少人
如果Borland不采纳
也可以搞一个联名签名
(说笑,别当真)