树叶回归大地的怀抱诗:vb中有没有办法让窗口至顶

来源:百度文库 编辑:高校问答 时间:2024/04/20 05:07:30

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) As Long

Private Sub Command1_Click()
'总置顶
SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 2 Or 1
End Sub

Private Sub Command2_Click()
'取消总置顶
SetWindowPos Me.hwnd, -2, 0, 0, 0, 0, 2 Or 1
End Sub

Option Explicit
Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

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)

Public Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long

Public Declare Function FindWindowa Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Public Declare Function GetForegroundWindow Lib "user32" () As Long

Public coll As New Collection
'hWnd是Window传给我们的Window handle,而lParam是我们呼叫EnumWindows()时的第
'二个叁数值,在这个例子中,我们传0进来,所以lParam一直是0
Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
Dim S As String, pid As Long
If GetParent(hwnd) = 0 Then
'读取 hWnd 的视窗标题
S = String(80, 0)
Call GetWindowText(hwnd, S, 80)
S = Left(S, InStr(S, Chr(0)) - 1)
Call GetWindowThreadProcessId(hwnd, pid)
'当没有标题的hWnd之pid被加入Coll的Collection时,若pid重覆会有错,我们不管它
On Error Resume Next
If Len(S) = 0 Then
'没有标题,则记录Class Name
S = String(255, 0)
Call GetClassName(hwnd, S, 255)
S = Left(S, InStr(S, Chr(0)) - 1)
coll.Add "-!@" + S, Str(pid) 'key 为Pid
Else
'如果相同的pid记录两次,便会产生err, 而去执行errh的程序
On Error GoTo errh
If IsWindowVisible(hwnd) Then
coll.Add S, Str(pid)
End If
End If
End If
EnumWindowsProc = True ' 表示继续列举 hWnd
Exit Function
errh:
'如果先前coll 记录key=pid的 那个Item记录的是ClassName,则Item以Window
'的Title来取代
If Mid(coll.Item(Str(pid)), 1, 3) = "-!@" Then '表示先前以ClassName记录
coll.Remove (Str(pid))
coll.Add S, Str(pid)
End If
EnumWindowsProc = True ' 表示继续列举 hWnd
End Function

Private Sub Command1_Click()
Dim co As Variant
List1.Clear
Call EnumWindows(AddressOf EnumWindowsProc, 0&)
For Each co In coll
If Mid(co, 1, 3) = "-!@" Then
co = "[" + Mid(co, 4) + "]"
End If
List1.AddItem co
Next
End Sub

Private Sub Command2_Click()

Dim hwnd As Long
hwnd = GetForegroundWindow ' FindWindowa("Notepad", "新建 文本文档.txt - 记事本")

Dim str1 As String, len1 As Long
str1 = Space(255) '定义接收字串.
str2 = Space(255) '定义接收字串.
GetWindowText hwnd, str1, 1024

Do While hwnd <> 0
hwnd = GetNextWindow(hwnd, 2) '只有2才表示找下一个窗口

len1 = GetWindowText(hwnd, str1, Len(str1))
len2 = GetClassName(hwnd, str2, Len(str2))

List2.AddItem str1 & " / " & str2
If (InStr(1, str1, List1.Text, 1) > 0) Then

'MsgBox "你要的窗口找到了, 它是:" + str1

Dim rtn
'让窗口在顶层
rtn = SetWindowPos(hwnd, -1, 0, 0, 0, 0, 3)

Exit Sub '这一句看情况修改
End If
Loop
'MsgBox "很遣憾, 没有你要找的窗口"

End Sub

Private Sub Command3_Click()
Dim hwnd As Long

hwnd = FindWindow(vbNullString, List1.Text)
rtn = SetWindowPos(hwnd, -1, 0, 0, 0, 0, 3)

End Sub

Private Sub Form_Load()
Dim co As Variant
List1.Clear
Call EnumWindows(AddressOf EnumWindowsProc, 0&)
For Each co In coll
If Mid(co, 1, 3) = "-!@" Then
co = "[" + Mid(co, 4) + "]"
End If
List1.AddItem co
Next
End Sub

Private Sub List1_DblClick()

hwndcalc = FindWindow(0&, Replace(List1.Text, "Class Name:", ""))
MsgBox hwndcalc

hwndcalc = FindWindow(Replace(List1.Text, "Class Name:", ""), 0&)
MsgBox hwndcalc

End Sub

显示窗口列表并置顶任一窗口。刚弄的还在调试