防止窗体置前的焦点抢断

Question

春节后第一天上班,先给大家拜年啦
顺便讨教一个头疼的问题:
我的程序调用一个别人的应用程序,弹出一个小窗体,但是此时正在做其他操作,比如编写文档. 
跳出的窗体将输入焦点抢走了,很恼人... 请问各位有没有办法可以让输入正常哇~
调用代码就一句: Shell(App.path & "\popup.exe", vbNormalNoFocus)

Answer 1

SW_SHOWNA 用当前的大小和位置显示一个窗口，不改变活动窗口 参考一下这里

Answer 2

试过了,有时候正常有时候无效.
ShowWindow
SetWindowPos
PostMessage
SetForegroundWindow
SetActiveWindow
SetFocus
这些都试了（可能用的不正确还是咋的）,头大呀。

Answer 3

那可能人家用了Timer不停地获得焦点

Answer 4

VbNormalNoFocus    4 窗口会被还原到最近使用的大小和位置，而当前活动的窗口仍然保持活动。 
VbMinimizedNoFocus 6 窗口会以一个图标来显示。而当前活动的的窗口仍然保持活动。 
shell参数是这么说的
在shell后面SetFocus也不行吗？

Answer 5

这个自己弄个例子很好测试的,
我用一个timer让它到时间运行那个exe (先用GetForegroundWindow获取到了系统中的活动窗体句柄)
shell之后,我用上面的办法想抢回焦点无果,除非我点一下鼠标.
其实那个exe上面没输入焦点,就像QQ消息那种样子.

Answer 6

    SetActiveWindow  和  apiSetFocus 联合使用试试

Answer 7

错了，apiSetFocus 就是SetFocus

Answer 8

SetActiveWindow跟窗体的句柄
SetFocus跟控件的句柄

Answer 9

我怀疑，shell后，在系统中又加了一个新的进程，自身的程序抢不过人家~~

Answer 10

使弹出的窗口最小化如何
Shell(App.path & "\popup.exe", vbMinimizedNoFocus)

Answer 11

那个exe在这里

Answer 12

http://download.csdn.net/source/3014592 谢谢

Answer 13

如下测试木有问题
Private Sub Command1_Click()
    Shell App.Path & "\popup.exe", vbNormalNoFocus
    Command1.SetFocus
End Sub不知道楼主的shell是在什么事件里执行的

Answer 14

有时候是没有问题的,如果一次没有出现我说的情况,请退出程序再试下看看,包括IDE
我是在timer里面测试,然后点击别的应用程序(比如word),然后观察焦点

Answer 15

你在timer不停地shell?还是只shell一次？

Answer 16

Timer里N次没问题
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Const SW_SHOW = 5Private Sub Timer1_Timer()
    Shell App.Path & "\popup.exe", vbNormalNoFocus
    ShowWindow GetActiveWindow, SW_SHOW
End Sub

Answer 17

不是吧,我这里关掉了之后光标就正常了. 
Private Sub Timer1_Timer()
    '……
    Timer1.enable=false
End Sub
晕，这样编写文档的窗口始终是顶级窗口了

Answer 18

#19楼 我是在timer里面测试
#21楼 当然是一次,我用个按钮控制的,这样才好测试哇 好像矛盾timer没有焦点，GetActiveWindow 可以获得其它窗口的焦点
按钮本身可以得到焦点，点的时候肯定有焦点，GetActiveWindow得到的是VB窗口的焦点
同一个函数放的位置不一样，得到的结果是不一样的

Answer 19

我测试的:
Private Sub Command1_Click()
    Timer2.Enabled = True
End SubPrivate Sub Timer2_Timer()
    Dim lngActive As Long, lngActive2 As Long
    Dim dblPID As Double, lngShell As Long
    Dim s As String
    
    Timer2.Enabled = False
'    s = String(255, Chr(0))
    
    lngActive = GetForegroundWindow()
'    GetWindowText lngActive, s, 255
    
    dblPID = Shell(App.path & "\popup.exe", vbNormalNoFocus)           
    lngShell = InstanceToWnd(CLng(dblPID)) '转换PID-->句柄
    DoEvents
    
'    lngActive2 = FindWindow(vbNullString, s)
'    ShowWindow lngShell, 8'    Debug.Print lngShell
    SetWindowPos lngShell, -1, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE
    SetWindowPos lngActive, 1, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_SHOWWINDOW
'    SetWindowPos lngActive, 0, 0, 0, 0, 0, &H2& Or &H1& Or &H4& Or &H40&
        
'    BringWindowToTop lngShell
'    If GetForegroundWindow = lngShell Then SetForegroundWindow 0
        
'    Dim lParam As Long
'    lParam = MakeKeyLparam(vbKeyLButton, WM_KEYDOWN)
'    PostMessage lngActive, &H201&, vbKeyLButton, 0
'    DoEvents
'    lParam = MakeKeyLparam(vbKeyLButton, WM_KEYUP)
'    PostMessage lngActive, &H202&, vbKeyLButton, 0
    
'    lParam = MakeKeyLparam(vbKeyTab, WM_KEYDOWN)
'    PostMessage Me.hwnd, &H104&, vbKeyTab, lParam
'    Sleep 50
'    lParam = MakeKeyLparam(vbKeyTab, WM_KEYUP)
'    PostMessage Me.hwnd, &H105&, vbKeyTab, lParam
        
'    SetForegroundWindow lngActive
''    If lngActive2 <> 0 Then SetActiveWindow lngActive2'    SetActiveWindow lngActive
'    NewSetFocus lngActive'    keybd_event VK_A, MapVirtualKey(VK_A, 0), 0, 0     '按下A键
'    keybd_event VK_A, MapVirtualKey(VK_A, 0), KEYEVENTF_KEYUP, 0  '释放A键'    SendKeys "%{TAB}"
end sub

Answer 20

GetActiveWindow 这个API据说有点问题,现在没有用它,之前用过.

Answer 21

事前
GetCursorPos得到鼠标位置
WindowFromPointXY得到控件句柄
GetParent得到窗体句柄
事后
SetActiveWindow跟窗体的句柄
SetFocus跟控件的句柄
再不好用就没辙了

Answer 22

如果不是用VB语言的话，让你程序弹出的那个TopLevel窗口先隐藏创建，而后调用SetWindowPos来显示该窗口并设置SWP_NOACTIVATE标记。

Answer 23

使用shell运行程序（获得进程ID），使用enumwindows或enumthreadwindows或findwindowex找到那个进程中的可视窗口，使用setwindowlong和getwindowlong为那个窗口加上ws_child风格，再使用setfocus激活你的窗口，那个窗口应该不会再跟你抢焦点了。

Answer 24

可以用API设置模态窗体工作区，这样焦点就不会被抢走了。vbSystemModal
臆想的，嘿嘿，不知道有没有这样的API

Answer 25

1.就用你的Shell打开程序，不过可以选择vbMinimizedNoFocus参数
2.使用FindWindow获得该程序窗口的句柄
3.使用SendMessage利用该窗口的句柄将其隐藏

Answer 26

Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Declare Function WaitForInputIdle Lib "user32.dll" (ByVal hp As Long, ByVal t As Long) As Long
Private Declare Function CreateProcessInternalW Lib "kernel32.dll" (ByVal hToken As Long, ByVal lpApplicationName As Long, ByVal lpCommandLine As Long, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As Any, lpProcessInformation As PROCESS_INFORMATION, hNewToken As Long) As Long
Private Sub Timer1_Timer()
Dim SI As STARTUPINFO, PI As PROCESS_INFORMATION
SI.cb = Len(SI)
CreateProcessInternalW 0, StrPtr("popup.exe"), ByVal 0, ByVal 0, ByVal 0, ByVal 0, 0, 0, 0, SI, PI, ByVal 0
WaitForInputIdle PI.hProcess, 5000
Text1.SetFocus
End SubForm1中放一个Timer1 4秒钟一次,还放一个Text1

Answer 27

那个popup.exe要和你的exe放在一起

Answer 28

请问上面Text1.SetFocus 是做什么用的,我的输入焦点是在编辑的文档中.
用了Text1.SetFocus 之后,VB本身的应用会闪,但是焦点不在文档上啊

Answer 29

我这里的Text1就是要编辑的文档部分
如果你是其他控件放文档,就对那个控件SetFouces

Answer 30

谢谢关注,不过还是没抢过来. 我在17F上传的就是那个popup.exe
有个现象,如果我正在文档上快速输入字符,这个popup.exe是不会影响输入的,但要是输入中稍有停顿,输入焦点就没了.

Answer 31

Private Function ForeWindow() As Long
    Dim hForegdWnd As Long, dwCurID As Long, dwForeID As Long
    Dim hActive As Long
    hForegdWnd = GetForegroundWindow()
    dwForeID = Abs(GetWindowThreadProcessId(hForegdWnd, 0))
    dwCurID = Abs(GetCurrentThreadId())
    AttachThreadInput dwForeID, dwCurID, 1
    hActive = GetFocus() '输入焦点所在控件句柄
    AttachThreadInput dwForeID, dwCurID, 0
    
    ForeWindow = hActive
end functionsetfocus 上述函数所得句柄

Answer 32

什么时候运行ForeWindow,你应该就SetFocus你的文档窗口,而不是从GetFocus获得
我是这个意思
popup.exe在运行后会把自己作为焦点
我先创建popup.exe进程,然后等待把自己作为焦点,然后再把你的文档作为焦点
如果你在他把自己作为焦点之前ForeWindow是不行的,因为等下它会把自己作为焦点
在他把自己作为焦点之后ForeWindow也不行,因为这时GetForegroundWindow和GetFocus都是他的窗口了
你应该就在WaitForInputIdle后SetFocus你的文档窗口

Answer 33

我的那个例子中,你需要先点一下Text1

Answer 34

你的"如果你在他把自己作为焦点之前ForeWindow是不行的,因为等下它会把自己作为焦点" 这句话怎么理解啊?
我的Private Function ForeWindow() As Long 只是为了取到输入焦点所在控件的句柄,
确实是在之前就取好的,如果先不取,如何"SetFocus你的文档窗口"呢,这个"你的文档窗口"句柄如何获得呢,真纠结...

Answer 35

你在什么时候运行ForeWindow，在什么时候运行SetFocus上述函数所得句柄

Answer 36

惭愧,不知具体怎么组织代码.看了半天,上面说的总感觉矛盾. 而且SetFocus似乎不起作用

Answer 37

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function AttachThreadInput Lib "user32" (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long
Private Declare Function GetFocus Lib "user32" () As Long
Private Declare Function NewSetFocus Lib "user32" Alias "SetFocus" (ByVal hwnd As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As LongPrivate Sub Command1_Click()
    '点击之后切换到文本文档上打字(打字速度不要太快,或者只点一下文本文档,光标落入里面即可)
    '3秒后观察光标是否消失
    Timer2.Enabled = True
End Sub
Private Sub MDIForm_Load()
    Timer2.Interval = 3000
    Timer2.Enabled = False
End Sub
Private Sub Timer2_Timer()
    Dim lngActive As Long, lngActive2 As Long
    Timer2.Enabled = False
    
    lngActive2 = ForeWindow()
    
    Dim SI As STARTUPINFO, PI As PROCESS_INFORMATION
    SI.cb = Len(SI)
    CreateProcessInternalW 0, StrPtr("popup.exe"), ByVal 0, ByVal 0, ByVal 0, ByVal 0, 0, 0, 0, SI, PI, ByVal 0
    WaitForInputIdle PI.hProcess, 5000
'     Shell App.Path & "\popup.exe", vbMinimizedNoFocus
'    AttachThead lngActive2
End Sub
Private Function ForeWindow() As Long
    Dim hForegdWnd As Long, dwCurID As Long, dwForeID As Long
    Dim hActive As Long
    hForegdWnd = GetForegroundWindow()
    dwForeID = Abs(GetWindowThreadProcessId(hForegdWnd, 0))
    dwCurID = Abs(GetCurrentThreadId())
    AttachThreadInput dwForeID, dwCurID, 1
    hActive = GetFocus() '输入焦点所在控件句柄
    AttachThreadInput dwForeID, dwCurID, 0
    
    ForeWindow = hActive
End Function
Private Sub AttachThead(hwnd As Long)
    Dim hForegdWnd As Long, dwCurID As Long, dwForeID As Long
    
    dwCurID = GetCurrentThreadId()
    dwForeID = GetWindowThreadProcessId(hwnd, 0)
    AttachThreadInput hwnd, dwCurID, 1
    NewSetFocus hwnd
    AttachThreadInput hwnd, dwCurID, 0
End Sub
ForeWindow 就是上面47F那个 ,窗体是MDIform ,试了下普通窗体好像没问题

Answer 38

Private Sub Timer2_Timer()
    Dim lngActive As Long, lngActive2 As Long, h As Long
    Timer2.Enabled = False
    
   ' lngActive2 = ForeWindow()
    
    Dim SI As STARTUPINFO, PI As PROCESS_INFORMATION
    SI.cb = Len(SI)
    h = GetForegroundWindow
    CreateProcessInternalW 0, StrPtr("popup.exe"), ByVal 0, ByVal 0, ByVal 0, ByVal 0, 0, 0, 0, SI, PI, ByVal 0
    WaitForInputIdle PI.hProcess, 5000
    SetForegroundWindow h
'     Shell App.Path & "\popup.exe", vbMinimizedNoFocus
'    AttachThead lngActive2
End Sub增加Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long我这里可以

Answer 39

我另外新建一个工程，试了下也是可以的，谢谢~~
不知道我那个在用的老程序SetForegroundWindow用了之后就是会闪烁
之前我也用这个SetForegroundWindow试了就是闪烁就没用，我再检查下

Answer 40

CreateProcessInternalW在windows2000是没有的
我是因为原来有CreateProcessInternalW的声明才复制来用它
你最好用CreateProcessW,CreateProcessInternalW是未公开的api

Answer 41

你最好直接自己编一个popup.exe

Answer 42

从 WinXP 开始，新开程序的普通窗体是不会抢占焦点的。
你可以要求 popup.exe 加个命令行参数，用来控制不要置顶。

Answer 43

嗯,可这个popup.exe不是我的.
它置顶后本身是没有焦点的,但原来正操作的文档上焦点也没了. 
看来只能自己写个或者改下人家的那个popup.exe才好了

Answer 44

更正一下,加上SWP_NOOWNERZORDER消息