module1.bas

来自「很好的教程原代码！」· BAS 代码 · 共 92 行

Attribute VB_Name = "Module1"
'以下程式在.Bas
 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
 Declare Function CallNextHookEx Lib "user32" _
 (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lparam As Any) 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 SetWindowText Lib "user32" Alias _
 "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
 Declare Function EnumChildWindows Lib "user32" _
 (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, _
 ByVal lparam 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

 Public Const HCBT_ACTIVATE = 5
 Public Const WH_CBT = 5

 Public hHook As Long
 Public MsgBoxTitle As String

 Public Sub EnableHook()
 If hHook = 0 Then
    hHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, 0, App.ThreadID)
 End If
 End Sub
 Public Sub FreeHook()
 If hHook <> 0 Then
    Call UnhookWindowsHookEx(hHook)
    hHook = 0
 End If
 End Sub

 Public Function HookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lparam As Long) As Long
 If nCode < 0 Then
    HookProc = CallNextHookEx(hHook, nCode, wParam, lparam)
    Exit Function
 End If
 '当MsgBox Activate之前去更改Button的标题
 If nCode = HCBT_ACTIVATE Then
    Dim str5 As String
    Dim len5 As Long, i As Long
    str5 = String(255, 0)
    len5 = 256
    i = GetWindowText(wParam, str5, len5)
    str5 = Left(str5, InStr(1, str5, Chr(0)) - 1)
    '如果Active Window上的标题是MsgBox上的标题
    '
    If str5 = MsgBoxTitle Then
       '取得MsgBox上的所有子window
       Call EnumChildWindows(wParam, AddressOf ChgButtonTitle, 0)
    End If
 End If
 HookProc = 0
 '令待完成的动作继续完成，若为1，则取消原本要完成的动作
 End Function

 Private Function ChgButtonTitle(ByVal hwnd As Long, ByVal lparam As Long) As Long
 Dim clsName As String, len5 As Long, i As Long
 Dim Title As String
 If hwnd = 0 Then
    ChgButtonTitle = 0
    Exit Function
 End If
 clsName = String(255, 0)
 len5 = 256
 i = GetClassName(hwnd, clsName, 256)
 clsName = Left(clsName, InStr(1, clsName, Chr(0)) - 1)
 Title = String(255, 0)
 i = GetWindowText(hwnd, Title, 256)
 Title = Left(Title, InStr(1, Title, Chr(0)) - 1)
 '找到Button型态的子Window，并更改其上的标题
 If clsName = "Button" Then
    If Title = "是(&Y)" Then
       Call SetWindowText(hwnd, "Yes(&Y)")
    Else
       If Title = "否(&N)" Then
      Call SetWindowText(hwnd, "No(&N)")
       End If
    End If
 End If
 ChgButtonTitle = 1
 '表示继续找下一个子Window
 End Function