Find controls from point [VB6]

Over on im-integrations.com we have been looking at ways to find the paltalk controls more reliably and that won’t need to be updated every time they release a new version of paltalk. What we have come up with is using the Win32API WindowFromPoint and scanning the window bottom to top for the desired control.
QuadrantGrid
Above it shows grid lines (spacing not to scale) over the window that I am referring to as SearchQuadrants. The idea is that you pick 1 of the lines that passes through the control you want and then use it to find the control. So for the bottom to top scan I will demo, we have 5 SearchQuadrants:

1 = Left + 10
2 = Left + 1/4 window width
3 = Center
4 = Right – 1/4 window width
5 = Right – 10

So unless the Paltalk interface gets a drastic remake, we can use the following SearchQuadrants and indexs.

SendTextSearchQuadrant = 2
ReadTextSearchQuadrant = 2
NicListSearchQuadrant = 5
SendTextIndex = 1
ReadTextIndex = 2
NicListIndex = 1

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

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

     

Leave a Reply

You must Register or Login to comment on Find controls from point [VB6]