VB 灰色按钮客星
無(wú)聊時(shí)寫的程序。沒(méi)什么技術(shù)可言,就是使用了鼠標(biāo)鉤子和一些遍歷子窗體的函數(shù)等等,有興趣的可以看看,下面是源碼。
主窗體源碼:
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風(fēng)格函數(shù)
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
Private Sub Form_Initialize()
? ? '顯示XP風(fēng)格
? ? InitCommonControls
End Sub
Private Sub cmdEnabled_Click()
? ? If Me.lstEnableButton.ListCount = 0 Then
? ? ? ? MessageBox Me.hwnd, "目前還沒(méi)有選項(xiàng)!!", "提示", 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, "設(shè)置成功!!", "提示", 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, "目前還沒(méi)有選項(xiàng)!!", "提示", 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, "設(shè)置成功!!", "提示", 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 "鼠標(biāo)下的句柄是:" & 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
總結(jié)
- 上一篇: excel常用小操作
- 下一篇: 王者荣耀服务器维修多久,王者荣耀服务器正