VB 灰色按钮客星

原创 2007年10月03日 12:26:00

无聊时写的程序。没什么技术可言,就是使用了鼠标钩子和一些遍历子窗体的函数等等,有兴趣的可以看看,下面是源码。

主窗体源码:

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 

灰色按钮客星

  • 2008年02月27日 22:26
  • 19KB
  • 下载

linkbutton按钮在某些条件下置为灰色不能点击(基于easyui)

首先在datagrid中添加onClickRow事件 " data-options=" rownumbers:true, singleSelect:true, ...
  • QCIWYY
  • QCIWYY
  • 2017年03月30日 10:44
  • 1788

VB灰色按钮激活器

  • 2013年03月31日 14:58
  • 5KB
  • 下载

点击按钮变成灰色不可再次点击

原文转载自http://www.santii.com/article/24.html 很多时候,当我们点击提交按钮,如果因为执行的程序太慢,或是网络问题,就会一直处于提交状态。 不了解的人,...
  • cg20
  • cg20
  • 2017年11月07日 10:41
  • 67

灰色按钮克星2.1

  • 2017年11月20日 23:12
  • 17KB
  • 下载

灰色按钮激活

  • 2011年12月20日 13:36
  • 368KB
  • 下载

css3实现的一些灰色的导航条按钮

以前做网页时候一般一些渐变的导航条和菜单效果都是用背景图片来实现想要的效果,今天用css3实现了一些灰色的漂亮的导航按钮效果,主要分为两种, 源代码下载地址:http://download.csdn...
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:VB 灰色按钮客星
举报原因:
原因补充:

(最多只允许输入30个字)