Find controls from point [VB6]

4 thoughts on “Find controls from point [VB6]”

1. @NVYE wrote:

   I have no idea what you’re trying to do … but it looks like you have done some hard-work here.

   A lot of those still using VB6 are using direct mapping (parent – child) of controls to find the send text and read text windows as well as the nic list. The problem with the direct mapping is that ever since some time in Pal9 black nicks have a different map then paid nics. It also looked like in Pal 10, they were starting to have different maps for black rooms verses paid rooms.

   This was making a lot of problems for people to find the control handles reliably. So rather than enum all the controls in the pal room window, i found a way to find the controls by checking the window in a line. So if the line passes through the control, then you can use it to find the control.

   You can see the original VB2010 code over on im-integrations.com

   Log in to Reply

2. I have no idea what you’re trying to do … but it looks like you have done some hard-work here.

   Log in to Reply

3. Look at the code NVYE. It eliminates all the searching for index(s) and does all the work for you. Quite revolutionary IMO.

   Log in to Reply

4. 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

    

   Log in to Reply