无聊时写的程序。没什么技术可言,就是使用了鼠标钩子和一些遍历子窗体的函数等等,有兴趣的可以看看,下面是源码。
主窗体源码:
Option Explicit
Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
'显示XP风格函数
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
Private Sub Form_Initialize()
'显示XP风格
InitCommonControls
End Sub
Private Sub cmdEnabled_Click()
If Me.lstEnableButton.ListCount = 0 Then
MessageBox Me.hwnd, "目前还没有选项!!", "提示", 0
End If
Dim strList As String, lnghWnd As Long
strList = Me.lstEnableButton.List(Me.lstEnableButton.ListIndex)
strList = Mid(strList, InStr(strList, "句柄为:") + Len("句柄为:") + 1, Len(strList) - InStr(strList, "句柄为:") - Len("句柄为:"))
If IsNumeric(strList) Then
lnghWnd = CLng(strList)
Else
lnghWnd = 0
End If
Call EnableWindow(lnghWnd, 0)
MessageBox Me.hwnd, "设置成功!!", "提示", 0
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdRestore_Click()
Dim strList As String, lnghWnd As Long
If Me.lstEnableButton.ListCount = 0 Then
MessageBox Me.hwnd, "目前还没有选项!!", "提示", 0
End If
strList = Me.lstEnableButton.List(Me.lstEnableButton.ListIndex)
strList = Mid(strList, InStr(strList, "句柄为:") + Len("句柄为:") + 1, Len(strList) - InStr(strList, "句柄为:") - Len("句柄为:"))
If IsNumeric(strList) Then
lnghWnd = CLng(strList)
Else
lnghWnd = 0
End If
Call EnableWindow(lnghWnd, 1)
MessageBox Me.hwnd, "设置成功!!", "提示", 0
End Sub
Private Sub cmdStop_Click()
If cmdStop.Caption = "停止扫描" Then
UnhookWindowsHookEx hHook
cmdStop.Caption = "开始扫描"
Else
cmdStop.Caption = "停止扫描"
hHook = SetWindowsHookEx(WH_MOUSE_DLL, AddressOf MouseProc, App.hInstance, 0)
End If
End Sub
Private Sub Form_Load()
hHook = SetWindowsHookEx(WH_MOUSE_DLL, AddressOf MouseProc, App.hInstance, 0)
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnhookWindowsHookEx hHook
End Sub
模块源码:
Option Explicit
Public Const WH_MOUSE = 7
Public Const WH_MOUSE_DLL = 14
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) 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 IsWindowEnabled Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function EnableWindow Lib "user32" (ByVal hwnd As Long, ByVal fEnable As Long) As Long
Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd 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 GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
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 Const LB_FINDSTRING = &H18F
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type MOUSEHOOKSTRUCT
pt As POINTAPI
hwnd As Long
wHitTestCode As Long
dwExtraInfo As Long
End Type
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public hHook As Long
Private objMOUSEMSG As MOUSEHOOKSTRUCT
Public Function MouseProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim p As POINTAPI, strClassName As String * 260, lnghWnd As Long, lngRet As Long
If idHook < 0 Then
'call the next hook
MouseProc = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
Else
CopyMemory objMOUSEMSG, ByVal lParam, LenB(objMOUSEMSG)
'GetCursorPos p
'lnghWnd = WindowFromPoint(p.X, p.Y)
lnghWnd = WindowFromPoint(objMOUSEMSG.pt.X, objMOUSEMSG.pt.Y)
If lnghWnd > 0 And lnghWnd <> frmMain.hwnd Then EnumChildWindows lnghWnd, AddressOf ChlidWindowProc, 0
'lngRet = GetClassName(lnghWnd, strClassName, 260)
' If LCase(Left(strClassName, lngRet)) = "button" Or Left(strClassName, lngRet) = "ThunderCommandButton" Then
' If IsWindowEnabled(lnghWnd) Then
' 'EnableWindow lnghWnd, 0
' ShowWindow lnghWnd, 0
' Else
' 'EnableWindow lnghWnd, 1
' ShowWindow lnghWnd, 5
' End If
' End If
' Debug.Print "鼠标下的句柄是:" & lnghWnd & " 类名是:" & Left(strClassName, lngRet)
'call the next hook
MouseProc = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
End If
End Function
Public Function ChlidWindowProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
Dim lngRet As Long, strClassName As String * 260, strMessage As String, lngFind As Long
lngRet = GetClassName(hwnd, strClassName, 260)
If InStr(LCase(Left(strClassName, lngRet)), "button") > 0 Then
If 0 = IsWindowEnabled(hwnd) Then
strMessage = "在窗体名为: " & GetWindowCaption(GetParenthWnd(hwnd)) & " 被禁用的按钮名为: " & GetWindowCaption(hwnd) & " 句柄为: " & hwnd
lngFind = SendMessage(frmMain.lstEnableButton.hwnd, LB_FINDSTRING, -1, ByVal strMessage)
If lngFind = -1 Then frmMain.lstEnableButton.AddItem strMessage
'Debug.Print "在窗体: " & GetWindowCaption(GetParenthWnd(hWnd)) & " 被禁用的按钮: " & GetWindowCaption(hWnd) & " 句柄为: " & hWnd
'EnableWindow hWnd, 1
End If
End If
ChlidWindowProc = True
End Function
Public Function GetParenthWnd(ByVal hwnd As Long) As Long
Dim lngPrehWnd As Long, lnghWnd As Long
lnghWnd = GetParent(hwnd)
If lnghWnd > 0 Then
Do While 1
DoEvents
lngPrehWnd = lnghWnd
lnghWnd = GetParent(lnghWnd)
If lnghWnd = 0 Then
GetParenthWnd = lngPrehWnd
Exit Function
End If
Loop
Else
GetParenthWnd = hwnd
End If
End Function
Public Function GetWindowCaption(ByVal hwnd As Long) As String
Dim lngLen As String, strTmp As String * 260, lngRet As Long
lngLen = GetWindowTextLength(hwnd)
If lngLen = 0 Then
GetWindowCaption = ""
Else
lngRet = GetWindowText(hwnd, strTmp, lngLen + 1)
GetWindowCaption = Replace(Trim(Left(strTmp, lngRet)), Chr(0), "")
End If
End Function
VB 灰色按钮客星
最新推荐文章于 2020-10-06 16:41:51 发布