📄 frmmain.frm
字号:
VERSION 5.00
Begin VB.Form frmMain
Caption = "系统所打开的窗体"
ClientHeight = 4695
ClientLeft = 4470
ClientTop = 2715
ClientWidth = 6150
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4695
ScaleWidth = 6150
Begin VB.Frame fraOpen
Caption = "系统中打开的所有窗体"
Height = 3255
Left = 120
TabIndex = 3
Top = 1320
Width = 5895
Begin VB.ListBox lstOpen
Height = 1500
Left = 150
Sorted = -1 'True
TabIndex = 6
Top = 360
Width = 4620
End
Begin VB.CommandButton cmdRefresh
Caption = "刷新(&R)"
Height = 420
Left = 4920
TabIndex = 5
Top = 360
Width = 840
End
Begin VB.CommandButton cmdActivate
Caption = "激活(&A)"
Height = 420
Left = 4920
TabIndex = 4
Top = 960
Width = 840
End
Begin VB.Label lblPos
AutoSize = -1 'True
Caption = "lblPos"
ForeColor = &H00404040&
Height = 180
Left = 1200
TabIndex = 12
Top = 2805
Width = 540
End
Begin VB.Label lblProcessID
AutoSize = -1 'True
Caption = "lblProcessID"
ForeColor = &H00404040&
Height = 180
Left = 1200
TabIndex = 11
Top = 2430
Width = 1080
End
Begin VB.Label lblClassName
AutoSize = -1 'True
Caption = "lblClassName"
ForeColor = &H80000008&
Height = 180
Left = 1200
TabIndex = 10
Top = 2040
Width = 1080
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "类 名："
ForeColor = &H80000008&
Height = 180
Left = 240
TabIndex = 9
Top = 2040
Width = 900
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "过程ID号："
ForeColor = &H00404040&
Height = 180
Left = 240
TabIndex = 8
Top = 2430
Width = 900
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "窗体位置："
ForeColor = &H00404040&
Height = 180
Left = 240
TabIndex = 7
Top = 2805
Width = 900
End
End
Begin VB.Frame Frame1
Caption = "当前活动窗口属性"
Height = 1095
Left = 120
TabIndex = 0
Top = 120
Width = 5895
Begin VB.Label lblClass
AutoSize = -1 'True
Caption = "lblClass"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 195
Left = 1320
TabIndex = 14
Top = 720
Width = 840
End
Begin VB.Label lblCurrent
AutoSize = -1 'True
Caption = "lblCurrent"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 195
Left = 1320
TabIndex = 13
Top = 360
Width = 1050
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "标 题："
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 195
Left = 360
TabIndex = 2
Top = 360
Width = 795
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "类 名："
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 195
Left = 360
TabIndex = 1
Top = 720
Width = 795
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'声明API函数
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
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 Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
'声明窗体数据类型
Private Type wndClass
style As Long
lpfnwndproc As Long
cbClsextra As Long
cbWndExtra2 As Long
hInstance As Long
hIcon As Long
hCursor As Long
hbrBackground As Long
lpszMenuName As String
lpszClassName As String
End Type
'声明矩形数据类型
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'常数声明
Private Const WM_ACTIVATE = &H6
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const HWND_TOPMOST = -1
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
Private Sub cmdRefresh_Click()
'清空列表框的内容，并重新显示窗体的内容
lstOpen.Clear
Dim lCount As Long
'调用自定义的GetAllWindows来取得所打开的窗体
lCount = GetAllWindows()
fraOpen.Caption = "当前总共有" & lCount & "个窗口被打开"
'刷新当前活动窗体的状态
Dim hwnd As Long
Dim strName As String * 255
hwnd = GetForegroundWindow
If hwnd = 0 Then Exit Sub
'取得窗体的标题
GetWindowText hwnd, strName, Len(strName)
lblCurrent.Caption = strName
'取得窗体的类名
GetClassName hwnd, strName, Len(strName)
lblClass.Caption = strName
End Sub
Private Sub cmdActivate_Click()
If lstOpen.Text = "" Then Exit Sub
Dim hwnd As Long
'根据窗体的类名或者标题名，调用FindWindow函数来取得相应的窗体
If Trim$(lblClassName.Caption) = "" Then
hwnd = FindWindow(vbNullChar, Trim$(lstOpen))
Else
hwnd = FindWindow(lblClassName.Caption, lstOpen.Text)
End If
'调用BringWindowToTop函数，将窗体激活
BringWindowToTop hwnd
'设置用以说明窗体的Label控件
hwnd = GetForegroundWindow()
If hwnd = 0 Then Exit Sub
Dim strName As String * 255
'取得标题名
GetWindowText hwnd, strName, Len(strName)
lblCurrent.Caption = strName
'取得类名
GetClassName hwnd, strName, Len(strName)
lblClass.Caption = strName
End Sub
Private Sub Form_Load()
'使得程序的窗体处在窗体的最前端
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
'单击cmdRefresh按钮
cmdRefresh.Value = True
End Sub
Private Sub lstOpen_Click()
Dim hwnd As Long
Dim strTitle As String * 255
Dim wndClass As wndClass
Dim lngProcID As Long
Dim rctTemp As RECT
'根据窗体标题找到窗体
hwnd = FindWindow(vbNullString, lstOpen.Text)
'调用GetClassName函数来取得窗体类的所有信息
GetClassName hwnd, strTitle, Len(strTitle)
If Left$(strTitle, 1) = vbNullChar Then
lblClassName.Caption = "没有找到相应的窗体!!!"
Else
lblClassName.Caption = strTitle
GetWindowThreadProcessId hwnd, lngProcID
GetWindowRect hwnd, rctTemp
End If
'根据所取得的信息来更新所显示的内容
lblProcessID = lngProcID
lblPos = "上边界 " & rctTemp.Top & " 下边界 " & rctTemp.Bottom & _
" 左边界 " & rctTemp.Left & " 右边界 " & rctTemp.Right
End Sub
'该函数用来取得系统中所有打开的窗口
Public Function GetAllWindows() As Long
'用来保存窗口的句柄
Dim hwnd As Long
'取得桌面窗口
hwnd = GetDesktopWindow()
'取得桌面窗口的第一个子窗口
hwnd = GetWindow(hwnd, GW_CHILD)
Dim strTitle As String * 255 '用来存储窗口的标题
Dim lCount As Long '用来记录系统中所打开的窗体的个数
lCount = 1
'通过循环来枚举所有的窗口
Do While hwnd <> 0
'取得下一个窗口的标题，并写入到列表框中
GetWindowText hwnd, strTitle, Len(strTitle)
If Left$(strTitle, 1) <> vbNullChar Then
lstOpen.AddItem Left$(strTitle, InStr(1, strTitle, vbNullChar))
lCount = lCount + 1
End If
'调用GetWindow函数，来取得下一个窗口
hwnd = GetWindow(hwnd, GW_HWNDNEXT)
Loop
'返回系统所所打开的窗口的个数
GetAllWindows = lCount
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -