The app just needs a single button and the following code:
Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function WindowFromPoint Lib "user32.dll" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) 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 Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Sub Command1_Click()
Dim hWnd As Long
Dim sClass As String
Dim SendTextClass As String
Dim ReadTextClass As String
Dim NicListClass As String
Dim SendTextIndex As Long
Dim ReaddTextIndex As Long
Dim NicListIndex As Long
Dim SendTextSearchQuadrant As Integer
Dim ReadTextSearchQuadrant As Integer
Dim NicListSearchQuadrant As Integer
Dim iSend As Long
Dim iRead As Long
Dim iNic As Long
sClass = "DlgGroupChat Window Class"
SendTextClass = "RichEdit20W"
ReadTextClass = "RichEdit20W"
NicListClass = "SysListView32"
SendTextSearchQuadrant = 2
ReadTextSearchQuadrant = 2
NicListSearchQuadrant = 5
SendTextIndex = 1
ReadTextIndex = 2
NicListIndex = 1
' Get chat room handle
hWnd = FindWindow(sClass, vbNullString)
' Get the different controls
iSend = ControlSearchBottomUp(hWnd, SendTextClass, SendTextIndex, SendTextSearchQuadrant)
iRead = ControlSearchBottomUp(hWnd, ReadTextClass, ReadTextIndex, ReadTextSearchQuadrant)
iNic = ControlSearchBottomUp(hWnd, NicListClass, NicListIndex, NicListSearchQuadrant)
' Display found controls
MsgBox ("Send Handle: " & CStr(iSend) & vbCrLf & "Read Handle: " & CStr(iRead) & vbCrLf & "NicList Handle: " & CStr(iNic))
End Sub
Function StripNulls(OriginalStr As String) As String
' This removes the extra Nulls so String comparisons will work
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = OriginalStr
End Function
Function ControlSearchBottomUp(ByVal wHndMain As Long, ByVal ControlClass As String, ByVal ControlIndex As Long, ByVal SearchQuadrant As Integer) As Long
Dim r As RECT
Dim retval As Long
Dim hWnd As Long
Dim wHndFound As Long
Dim wHndReturn As Long
Dim lpClassName As String
Dim iCurrentIndex As Long
Dim MaxLen As Long
Dim SearchX As Long
Dim SearchY As Long
Dim bFound As Boolean
MaxLen = 255
iCurrentIndex = 0
wHndReturn = 0
bFound = False
On Error GoTo ProcError
' Get the main window rect
retval = GetWindowRect(wHndMain, r)
' Select Search Quadrant 1-5
Select Case SearchQuadrant
Case 1
' Set Search Quadrant to Left + 10
SearchX = r.Left + 10
Case 2
' Set Search Quadrant to Left 1/4
SearchX = r.Left + ((r.Right - r.Left) / 4)
Case 3
' Set Search Quadrant to Center
SearchX = r.Left + ((r.Right - r.Left) / 2)
Case 4
' Set Search Quadrant to Right 1/4
SearchX = r.Right - ((r.Right - r.Left) / 4)
Case 5
' Set Search Quadrant to Right - 10
SearchX = r.Right - 10
Case Else
' Invalid Search Quadrant
' Return 0
ControlSearchBottomUp = 0
Exit Function
End Select
' Start searching from bottom
SearchY = r.Bottom
' Search for desired control
Do While Not bFound
' Move up 10
SearchY = SearchY - 10
' Do not search outside of parent window
If SearchY < r.Top Then
MsgBox ("Search Outside of Parent")
' control not found
bFound = False
' Stop looking
Exit Do
End If
' Get sub form from point
wHndFound = WindowFromPoint(SearchX, SearchY)
' Get class of sub form
lpClassName = Space(MaxLen)
GetClassName wHndFound, lpClassName, MaxLen
' Strip nulls from class name
lpClassName = StripNulls(lpClassName)
' Only process if class matches search
If LCase(lpClassName) = LCase(ControlClass) Then
If wHndFound wHndReturn Then
' increment current index by 1
iCurrentIndex = iCurrentIndex + 1
' New matching window class found
' so set handle for return
wHndReturn = wHndFound
' Only process if index matches search
If iCurrentIndex = ControlIndex Then
' The found class matches
bFound = True
End If
End If
End If
Loop
ProcError:
If bFound Then
ControlSearchBottomUp = wHndReturn
Else
ControlSearchBottomUp = 0
End If
End Function
.
