1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
| Option Explicit
Private Declare PtrSafe Function EnumWindows Lib "user32" (ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type TOOLINFO
cbSize As Long
uFlags As Long
hwnd As LongPtr
uId As Long
RECT As RECT
hinst As Long
lpszText As String
End Type
Private Const TTM_GETTEXT As Long = &H438
'---------------------------------------------
'
Sub main()
EnumWindows lpEnumFunc:=AddressOf enumFunc, lParam:=0&
End Sub
'call back
Private Function enumFunc(ByVal hwnd As LongPtr, ByVal lParam As Long) As Boolean
Dim buffer As String: buffer = Space$(Number:=256)
Dim lRet As Long: lRet = GetClassName(hwnd:=hwnd, lpClassName:=buffer, nMaxCount:=256)
Dim className As String: className = Left$(String:=buffer, Length:=lRet)
If className = "tooltips_class32" Then
Debug.Print hwnd, toolTipText(hwnd:=hwnd, lParam:=lParam)
End If
enumFunc = True
End Function
'
Private Function toolTipText(ByVal hwnd As LongPtr, ByVal lParam As Long) As String
Dim buffer As String: buffer = Space$(Number:=256)
Dim ti As TOOLINFO
With ti
.cbSize = Len(ti)
.hwnd = hwnd
'.uId = nId
.lpszText = StrPtr(Ptr:=buffer) 'buffer pointer
End With
Dim lRet As Long: lRet = SendMessage(hwnd:=hwnd, wMsg:=TTM_GETTEXT, wParam:=256, lParam:=ByVal ti)
toolTipText = Left(String:=buffer, Length:=lRet)
End Function |
Partager