防止窗体置前的焦点抢断

[king06]

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

[king06]

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

[Lactoferrin]

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

[king06]

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

[Lactoferrin]

要不你把你的工程代码简化一下发上来

[king06]

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 Long

Private 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 ,试了下普通窗体好像没问题

[king06]

其实没什么代码,就是这么简单一个操作而已.我上面都是试着改来改去

[Lactoferrin]

原来编辑文档的不是你的程序

[king06]

[Quote=引用 56 楼 lactoferrin 的回复:]
原来编辑文档的不是你的程序
[/Quote]

[Lactoferrin]

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

我这里可以

[king06]

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

[Lactoferrin]

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

[神马都能聊]

[Quote=引用 59 楼 king06 的回复:]
我另外新建一个工程，试了下也是可以的，谢谢~~
不知道我那个在用的老程序SetForegroundWindow用了之后就是会闪烁
之前我也用这个SetForegroundWindow试了就是闪烁就没用，我再检查下
[/Quote]
看了下你的那个弹出窗口的程序，好像它有定时/定时长刷新消息窗口。

[Lactoferrin]

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

[Lactoferrin]

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 Sub

Form1中放一个Timer1 4秒钟一次,还放一个Text1

[Lactoferrin]

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

[king06]

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

[Tiger_Zhao]

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

[king06]

[Quote=引用 63 楼 tiger_zhao 的回复:]
从 WinXP 开始，新开程序的普通窗体是不会抢占焦点的。
你可以要求 popup.exe 加个命令行参数，用来控制不要置顶。
[/Quote]
嗯,可这个popup.exe不是我的.
它置顶后本身是没有焦点的,但原来正操作的文档上焦点也没了.
看来只能自己写个或者改下人家的那个popup.exe才好了

[king06]

调用者最大化时,此时置顶一个窗体容易出现此类现象, 针对这样情况,作下处理好了
结贴

[king06]

更正一下,加上SWP_NOOWNERZORDER消息