[求助]请问如何把窗口一直保持活动状态?

Question

女朋友7月10日就生日了!我想做个屏保送给她,除了无法一直保持活动状态以外,其它的都完成了.哪位能帮我解决问题?不是要窗口总在最前,窗口总在最前我已经做到,我是要一直保持活动状态.就是要窗口一直在当前,有其它程序弹出对话框或者窗口也不会抢走焦点.我现在的屏保现在这样的问题,如果某些程序弹出对话框要我回答问题,我按Esc想退出屏保,却不是退出屏保,而是先退出那个对话框...因为弹出来的对话框得到了焦点了.

Answer 1

貌似不行吧  既然你要退出那个对话框 必须让他得到焦点  不然你的esc事件怎么响应呢?
或者用API吧 
把其他消息都拦截了吧

Answer 2

建议做个定时显示的花哨无边框窗体（做个动画），这样既不影响其他软件运行，也做到了惊喜。
屏保程序想完全截获按键消息，必须做个hook，无其他方法。
还有，既然是屏保，为何其他程序弹出对话框，屏保不消失？感觉lz做的并不是个真正的屏保程序。

Answer 3

 先 sendmessage 把窗口标题栏修改为有焦点效果
 再 attxxxthread 和前台窗口共享输入最好做个子类化, 拦截下焦点转移

Answer 4

回复二楼:
我是不想按Esc的时候退出某些对话框,相反,我是想其它的都不响应,只想按Esc的时候退出屏保!

Answer 5

回复三楼:
那个屏保是个飘雪的效果,有无窗体显示都可以出现效果的,对于用户的操作,我已经完全锁定了,有Hook,也把任务管理器锁定了.
我为了能让它锁定屏幕,就用窗体最大化,和窗体总在最前.屏保不一定在有程序弹出对话框的时候就消失的.是锁定状态的时候,像别人发QQ视频,难道会自动取消锁定状态,那样不合理!

Answer 6

回复六和十楼:
其实可能不必那么复杂,只是我不会做...
其实我就是想把一个总在最前的窗口保持活动状态,不让其它程序抢去焦点.
我自己找到点代码是可以做到切换时可以改变标题,要是把那个改变标题的代码变得激活程序主窗口就行了.看看代码,能不能帮我改成激活程序主窗口(这个窗口已经运行,有总在上层,无标题,最大化,透明的特性).'窗体Form1
Option Explicit
Private Sub Form_Load()
OldWindowProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf NewWindowProc) '设置相关的窗口信息
End Sub
'模块
Option Explicit
'定义相关的 API 函数
Public OldWindowProc As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Const GWL_WNDPROC = (-4)
Public Const WM_ACTIVATE = &H6
Public Const WA_ACTIVE = 1
Public Const WA_CLICKACTIVE = 2
Public Const WA_INACTIVE = 0Public Function NewWindowProc(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long '注意不要在这里面运行类似 Form1Show 或 End 等等破坏性的操作
If msg = WM_ACTIVATE Then
If (wParam = WA_ACTIVE Or wParam = WA_CLICKACTIVE) Then
Form1.Caption = "活动窗口" '窗口得到焦点时
Else
'在这如果有激活程序主窗口就什么事也解决了
Form1.Caption = "非活动窗口" '窗口失去焦点时
End If
End If
NewWindowProc = CallWindowProc(OldWindowProc, hwnd, msg, wParam, lParam)
End Function

Answer 7

非活动时,来个 setfocus me.hwnd 或者 窗口名.setfocu

Answer 8

不行哦,给你看看例子代码吧:'窗体Form1
Option Explicit
Private Sub Form_Load()
'总在最前
Dim res As Long
res = SetWindowPos(Form1.hwnd, HWND_TOPMOST, 0, 0, 0, 0, Flags)
OldWindowProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf NewWindowProc) '设置相关的窗口信息
End Sub'模块
Option Explicit
'定义相关的 API 函数
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Const HWND_TOPMOST = -1
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const SWP_FRAMECHANGED = &H20
Public Const SWP_DRAWFRAME = SWP_FRAMECHANGED
Public Const Flags = SWP_DRAWFRAME Or SWP_NOMOVE Or SWP_NOSIZEPublic OldWindowProc As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Const GWL_WNDPROC = (-4)
Public Const WM_ACTIVATE = &H6
Public Const WA_ACTIVE = 1
Public Const WA_CLICKACTIVE = 2
Public Const WA_INACTIVE = 0Public Function NewWindowProc(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long '注意不要在这里面运行类似 Form1Show 或 End 等等破坏性的操作
If msg = WM_ACTIVATE Then
If (wParam = WA_ACTIVE Or wParam = WA_CLICKACTIVE) Then
Form1.Caption = "活动窗口" '窗口得到焦点时
Else
'在这如果有激活程序主窗口就什么事也解决了
'Form1.SetFocus'用这个不行
Form1.Caption = "非活动窗口" '窗口失去焦点时
End If
End If
NewWindowProc = CallWindowProc(OldWindowProc, hwnd, msg, wParam, lParam)
End Function

Answer 9

不行,就一个form1,要它永远不会被其它程序抢去活动状态.
不知道哪位有好办法呢?

Answer 10

那还不简单 再加个form就行了~

Answer 11

在窗体上添加Timer1,然后输入以下代码Rem 以下是写在模块中的代码
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongRem ---------Rem 以下是写在窗体中的代码
Private Sub Timer1_Timer()
    Dim rtn As Long
    Me.Show
    rtn = SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 3)
    Me.SetFocus
End Sub

Answer 12

哦，忘了说了，把Timer1的interval设成10。我要分~

Answer 13

参考：
http://wenwen.soso.com/z/q61480467.htm
http://baike.baidu.com/view/1080349.html?fromTaglist

Answer 14

谢谢很多的热心朋友,可是还是达不到我想要的效果!希望大家多多帮忙想想!
不能用timer,timer是有缺点的.我也不考虑用控件了.我希望它只有52K的大小,现在已经是52K了!所以希望有简单的代码!
屏保有两种方式,一种是永远在飘雪,Form1是隐藏的,屏保时用户还可以一直操作,比如玩游戏之类的,另外一种是锁屏的飘雪,Form1是总在最前,透明,最大化,有Hook,用户什么也不能做.就是后者出现问题,有程序弹出对话框的时候,抢走了焦点,按Esc变成退出那个对话框了,而不是退出屏保,
我是在模块里用Load Form1的,这样可以很好地做到这两种方式.就是锁屏那种方式才会有问题,从根本上出发,让它从激活状态转向非激活状态时执行激活它自己就可以解决问题,可是我做不到.

Answer 15

LZ对锁定的要求蛮高的嘛，既然说不能动任何东西。
其实也不难，关键就是杀毒的可能会把LZ给KILL。思路可以这样，不需要我们一直对自身去干啥东西，可以运行后全屏、最大化，这时遍历系统所有进程，把除了核心进程以外的所有其他进程全部暂停并且保留句柄，或者全部附加到你自身进程调试器也行。
然后这样做了，后面的进程就无法影响你了。
这时开一个1s的Timer，实时监视如果有新进程出现立马KILL，然后继续这比较病毒了，不过也许能满足LZ的要求。

Answer 16

不能用timer,timer是有缺点的.我也不考虑用控件了.我希望它只有52K的大小,现在已经是52K了!所以希望有简单的代码!
屏保有两种方式,一种是永远在飘雪,Form1是隐藏的,屏保时用户还可以一直操作,比如玩游戏之类的,另外一种是锁屏的飘雪,Form1是总在最前,透明,最大化,有Hook,用户什么也不能做.就是后者出现问题,有程序弹出对话框的时候,抢走了焦点,按Esc变成退出那个对话框了,而不是退出屏保,
我是在模块里用Load Form1的,这样可以很好地做到这两种方式.就是锁屏那种方式才会有问题,从根本上出发,让它从激活状态转向非激活状态时执行激活它自己就可以解决问题,可是我做不到.
或者这样说吧,就是让它像某些游戏那样,游戏运行时,别的程序弹出的窗口不抢焦点,游戏可以一直玩!
还希望从程序自身出发,不考虑影响其它程序,我程序有一种方式是在下雪时可以做其它事情,如果这样做,就无法做其它事情了.

Answer 17

定时器，间隔一会儿调用SetForegroundWindow(Me.Handle)。
或是DeActived事件中调用

Answer 18

楼上的不行,SetForegroundWindow只有闪烁.
在不同的进程,不能用只在同一线程才有效的方法.

Answer 19

咋可能。SetForegroundWindow直接把窗体设置为激活窗体了。你要是在自己窗体上点按钮当然不行了。你点下去，执行SetForegroundWindow，那个窗口激活了，然后你鼠标弹起，自己窗体又激活了。

Answer 20

谁能帮忙在下面的代码注释"'在这如果有激活程序主窗口就什么事也解决了"中加入语句,让它达到预期效果?
'窗体Form1
Option Explicit
Private Sub Form_Load()
'总在最前
Dim res As Long
res = SetWindowPos(Form1.hwnd, HWND_TOPMOST, 0, 0, 0, 0, Flags)
OldWindowProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf NewWindowProc) '设置相关的窗口信息
End Sub'模块
Option Explicit
'定义相关的 API 函数
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Const HWND_TOPMOST = -1
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const SWP_FRAMECHANGED = &H20
Public Const SWP_DRAWFRAME = SWP_FRAMECHANGED
Public Const Flags = SWP_DRAWFRAME Or SWP_NOMOVE Or SWP_NOSIZEPublic OldWindowProc As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Const GWL_WNDPROC = (-4)
Public Const WM_ACTIVATE = &H6
Public Const WA_ACTIVE = 1
Public Const WA_CLICKACTIVE = 2
Public Const WA_INACTIVE = 0Public Function NewWindowProc(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long '注意不要在这里面运行类似 Form1Show 或 End 等等破坏性的操作
If msg = WM_ACTIVATE Then
If (wParam = WA_ACTIVE Or wParam = WA_CLICKACTIVE) Then
Form1.Caption = "活动窗口" '窗口得到焦点时
Else
'在这如果有激活程序主窗口就什么事也解决了
Form1.Caption = "非活动窗口" '窗口失去焦点时
End If
End If
NewWindowProc = CallWindowProc(OldWindowProc, hwnd, msg, wParam, lParam)
End Function

Answer 21

40楼贴的不就是消息方式来处理激活没激活么。直接写actived事件就可以了。

Answer 22

用IDE调试会出现杯具……（我在注释那里加了个msgbox，结果IDE疯了~）

Answer 23

可能我搜集的那个代码也不好,真是不知道怎么做才好!
难道不用timer,用其它方法让窗口一直保持活动状态真的那么难吗?

Answer 24

请人帮忙在"'在这如果有激活程序主窗口就什么事也解决了"里加代码!!!
'窗体Form1frm
Private Sub Form_Load()
'总在最前
SetWindowPos Form1.hwnd, -1, 0, 0, 0, 0, 3
Hook Form1.hwnd
End SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
UnHook Form1.hwnd
End Sub'模块Module1.bas
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPublic Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongPublic Const WM_NCACTIVATE = &H86
Public Const GWL_WNDPROC = (-4)
Public OldWndProc&Public Function Hook&(ByVal hWnd1&)
OldWndProc = SetWindowLong(hWnd1, GWL_WNDPROC, AddressOf NewWndProc)
Hook = OldWndProc
End FunctionPublic Sub UnHook(ByVal hWnd1&)
SetWindowLong hWnd1, GWL_WNDPROC, OldWndProc
End SubPublic Function NewWndProc&(ByVal hWnd1&, ByVal uMsg&, ByVal wParam&, ByVal lParam&)
If uMsg = WM_NCACTIVATE Then
   If wParam = 0 Then '失去焦点
      Form1.Caption = "失去焦点"
        '在这里加入在失去焦点时想要执行的代码'在这如果有激活程序主窗口就什么事也解决了
   Else
      Form1.Caption = "得到焦点"
        '在这里加入在得到焦点时想要执行的代码
   End If
End If
NewWndProc = CallWindowProc(OldWndProc, hWnd1, uMsg, wParam, lParam)
End Function

Answer 25

其实楼主应该换一个思路，别钻牛角尖了，你直接hook了键盘，当任何窗体得到焦点的时候，按下esc你都会知道，你将这个消息自己处理掉，然后吃掉就好了。和自己的窗体得到焦点效果是一样的，何必苦苦执著于自己的窗体必须要得到焦点呢？

Answer 26

Private Declare Function SetWindowPos& Lib "user32" (ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, _
ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)Private Sub Form_Load()
    Timer1.Interval = 10
    Timer1.Enabled = True
End SubPrivate Sub Timer1_Timer()
    SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3
End Sub
其实这些就够了

Answer 27

Private Declare Function SetWindowPos& Lib "user32" (ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, _
ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)Private Sub Form_Load()
    Timer1.Interval = 10
    Timer1.Enabled = True
End SubPrivate Sub Timer1_Timer()
    SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3
End Sub
其实这些就够了