创建Photoshop式浮动窗口应用程序

创建Photoshop式浮动窗口应用程序


好些天没写Blog了，献上一篇。

用过Photoshop的朋友一定对它的那些方便的浮动面板记忆犹新，其实这些面板就是一个个的小窗体，但这些小窗体都放在Photoshop的主窗体上（不是存在主窗体中），有自己的标题栏、最小化按钮及最大化按钮。但它们与MDI程序不同的是，他们可以拖到主窗体外，更重要的是工作中所有这些面板窗体与主窗体最处于激活状态。

用Spy & Capture查看一下就不难发现，这些面板窗体的Parent Window都是Photoshop的主窗体(以Photoshop CS为例，主窗体的Handle是001906D8，所有面板的Parent Window指向的就是001906D8），而一般我们创建的窗体的Parent是为None的。

下面的代码就为实现这种Photoshop式浮动窗口的示范：

//......

var
  Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  //把Form2的Parent改为Form1
  Form2 := TForm2.CreateParented(Form1.Handle);
  Form2.Show;
  //使得Form2处于激活状态
  SendMessage(Form2.Handle, WM_NCACTIVATE, Ord(True), 0);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Form2.Close;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  //记得加上这一句
  if Form2.Showing then Form2.Close;
end;

end.


上面的代码就可以显示一个与Form1同处激活状态的Form2，再对Form2的BorderStyle与BorderIcons属性作一些必要的选择，就可以实现更加完美的效果！

---

 

有人问我, 上面的代码产生的Form2 不能移出Form1, 因为Form2.Parent被指定为Form1了.

要像PhotoShop面板那样移出主窗体, 我想了一下变通的方法:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    btn1: TButton;
    btn2: TButton;
    edt1: TEdit;
    mmo1: TMemo;
    procedure FormDeactivate(Sender: TObject);
    procedure btn1Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SetAllFormsActivate(Sender: TObject);
    procedure SetAllFormsDeactivate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Unit2, Unit3;

{$R *.dfm}

procedure TForm1.SetAllFormsActivate(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to Application.ComponentCount - 1 do
  begin
    if Application.Components[i] is TForm then
      SendMessage(TForm(Application.Components[i]).Handle, WM_NCACTIVATE, Ord(True), 0);
  end;
end;

procedure TForm1.SetAllFormsDeactivate(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to Application.ComponentCount - 1 do
  begin
    if Application.Components[i] is TForm then
      SendMessage(TForm(Application.Components[i]).Handle, WM_NCACTIVATE, Ord(False), 0);
  end;
end;

procedure TForm1.FormDeactivate(Sender: TObject);
begin
  if Application.Active then SendMessage(Handle, WM_NCACTIVATE, Ord(True), 0);
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
  form2.Show;
end;

procedure TForm1.btn2Click(Sender: TObject);
begin
  Form3.Show;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnDeactivate := SetAllFormsDeactivate;
  Application.OnActivate := SetAllFormsActivate;
end;

end.

其它的Form:

 

procedure TForm2.FormDeactivate(Sender: TObject);
begin
  if Application.Active then SendMessage(Handle, WM_NCACTIVATE, Ord(True), 0);
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  FormStyle := fsStayOnTop;
end;

end.