【老生常谈】求一个可用的Delphi窗体置顶的代码......

[yct0605]

系统环境：win7(32/64位系统)+D7，D7开发只有一个窗体
功能要求：窗体实现置顶显示，具体：
1.可以置顶于任务管理器之上（任务管理器最大化时，窗体可以置顶于任务管理器之上）
2.可以置顶于全屏运行的程序窗体显示
3.窗体失去焦点时置顶于桌面其他窗体显示（貌似是废话）
4.其他还没有想好...

[yct0605]

SetWindowPos(handle,HWND_TOPMOST,Left,Top,Width,Height,SWP_SHOWWINDOW) form1.FormStyle:=fsStayOnTop 实现的不是很好

[yct0605]

人气不旺啊

[aboutyych]

SetWindowPos，定时检查自己的窗体是否在最顶层，如不是则重新设置。 在你的程序之后再至顶显示的话肯定是要在你的程序上面。

[Blessed_Chuan]

SetWindowPos(handle,HWND_TOPMOST,Left,Top,Width,Height,SWP_SHOWWINDOW)
form1.FormStyle:=fsStayOnTop

[yct0605]

引用 3 楼 aboutyych 的回复:

SetWindowPos，定时检查自己的窗体是否在最顶层，如不是则重新设置。 在你的程序之后再至顶显示的话肯定是要在你的程序上面。

这个是视图图像，如果用定时器的话会影响图像的传输，视频图像会卡的

[yct0605]

大家顶起来啊

[levonsoft]

可以置顶于任务管理器之上（任务管理器最大化时，窗体可以置顶于任务管理器之上） 这个还分是否程序是否在激活状态 如果管理器最大化，并且当前焦点在管理器的时候，这时候要求你的窗体还在任务管理器之上（只有disactive 状态） 这种应该应该是比较难做到的。

[CCC的]

var
  WindowList: Pointer;
  ActiveWindow: HWnd;
begin
  ActiveWindow := GetActiveWindow;
  WindowList := DisableTaskWindows(ActiveWindow);
  {*显示进程对话框*}
  try
    if dlgProgress = nil then
      dlgProgress := TdlgProgress.Create(Application);
    dlgProgress.FormStyle:=fsStayOnTop;
    dlgProgress.Show;   //CSH
    dlgProgress.MessageText.Caption := msg_calculactioning;
    dlgProgress.Update; 
  finally
    EnableTaskWindows(WindowList);
    if ActiveWindow <> 0 then SetActiveWindow(ActiveWindow);
  end;
end;

[aniugee]

找个合适的事件判断，如果有窗体覆盖，马上再置顶

[lyhoo163]

从windows的机制来说，你的要求很难实现。 1、桌面上只通用一个置顶（焦点）。 2、当窗体置顶后，随时被其它窗体迭代。 3、其它窗体置顶后，重新置顶，需要击发机制。 解决方案： 1、SetWindowPos(handle,HWND_TOPMOST,Left,Top,Width,Height,SWP_SHOWWINDOW) 消息置顶 2、form1.FormStyle:=fsStayOnTop 设置窗体置顶类型，打开才能置顶 3、在窗体中定时检查，不断发出消息置顶。 4、深层次不允许其它程序置顶。

[doloopcn]

引用 9 楼 lyhoo163 的回复:

从windows的机制来说，你的要求很难实现。 1、桌面上只通用一个置顶（焦点）。 2、当窗体置顶后，随时被其它窗体迭代。 3、其它窗体置顶后，重新置顶，需要击发机制。 解决方案： 1、SetWindowPos(handle,HWND_TOPMOST,Left,Top,Width,Height,SWP_SHOWWINDOW) 消息置顶 2、form1.FormStyle:=fsStayOnTop 设置窗体置顶类型，打开才能置顶 3、在窗体中定时检查，不断发出消息置顶。 4、深层次不允许其它程序置顶。

加上一个事件应该差不多了onlostfocus 就是在窗口失去焦点的时候，把1.SetWindowPos函数运行一次

[yct0605]

引用 9 楼 lyhoo163 的回复:

从windows的机制来说，你的要求很难实现。 1、桌面上只通用一个置顶（焦点）。 2、当窗体置顶后，随时被其它窗体迭代。 3、其它窗体置顶后，重新置顶，需要击发机制。 解决方案： 1、SetWindowPos(handle,HWND_TOPMOST,Left,Top,Width,Height,SWP_SHOWWINDOW) 消息置顶 2、form1.FormStyle:=fsStayOnTop 设置窗体置顶类型，打开才能置顶 3、在窗体中定时检查，不断发出消息置顶。 4、深层次不允许其它程序置顶。

看来还是不好实现啊，如果在窗体内定时检查，频率快的话，会影响其他程序的输入状态。 D7这一点和C#.Net的窗体比起来还是有点不足的，C#.Net的窗体事件比D7的要多，而且对焦点控制的也比较好。

[yct0605]

引用 8 楼 hnlg81004 的回复:

var
  WindowList: Pointer;
  ActiveWindow: HWnd;
begin
  ActiveWindow := GetActiveWindow;
  WindowList := DisableTaskWindows(ActiveWindow);
  {*显示进程对话框*}
  try
    if dlgProgress = nil then
      dlgProgress := TdlgProgress.Create(Application);
    dlgProgress.FormStyle:=fsStayOnTop;
    dlgProgress.Show;   //CSH
    dlgProgress.MessageText.Caption := msg_calculactioning;
    dlgProgress.Update; 
  finally
    EnableTaskWindows(WindowList);
    if ActiveWindow <> 0 then SetActiveWindow(ActiveWindow);
  end;
end;

这段代码怎么使用？dlgProgress?

[踏雪无痕]

Application.NormalizeTopMosts;  
SetWindowPos(self.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or  SWP_NOSIZE);  

XE的Form有一个styleform属性就可以搞定

[aboutyych]

引用 5 楼 yct0605 的回复:

[quote=引用 3 楼 aboutyych 的回复:] SetWindowPos，定时检查自己的窗体是否在最顶层，如不是则重新设置。 在你的程序之后再至顶显示的话肯定是要在你的程序上面。

这个是视图图像，如果用定时器的话会影响图像的传输，视频图像会卡的[/quote] 不用Timer组件，用线程定时检查应该不会吧。 很容易实现的。

unit frm_Main;

interface

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

type
  TTopMostThread = class(TThread)
  protected
    FMainHandle: HWND;
    procedure Execute; override;
  public
    constructor Create(AMainHandle: HWND);  
  end;

  TfrmMain = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    FSetTop: TTopMostThread;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

{ TTopMostThread }

constructor TTopMostThread.Create(AMainHandle: HWND);
begin
  FreeOnTerminate := True;
  FMainHandle := AMainHandle;
  inherited Create(False);
end;

procedure TTopMostThread.Execute;
begin
  while not Terminated do
    begin
      SetWindowPos(FMainHandle,HWND_TOPMOST,0,0,0,0,SWP_NOMOVE or SWP_NOSIZE);
      Sleep(100);    //可适当调整此值
    end;   
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  FSetTop := TTopMostThread.Create(Self.Handle);
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  FSetTop.Terminate;
end;

end.