[RESOLVED] get word(from textbox) on mousedown

[Max187Boucher]

i was trying to figure out this code by myself today and took me a bit before getting to this point

Private Function GetWord(TextBox_Name As TextBox) As String
Dim WordFound As String
Dim SplitWords() As String
Dim WordFoundSplit() As String
Dim DefaultStartPOS As Long
Dim StartPOS As Long
Dim WordPOS As Long
Dim EndPOS As Long
Dim i As Integer
 
On Error Resume Next
 
WordFound = ""
StartPOS = 0
EndPOS = 0
WordPOS = 0
 
DefaultStartPOS = TextBox_Name.SelStart
SplitWords = Split(TextBox_Name, Chr(32))
 
If DefaultStartPOS <= Len(SplitWords(0)) Then
   TextBox_Name.SelStart = 0
   TextBox_Name.SelLength = Len(SplitWords(0))
   WordFound = TextBox_Name.SelText
   TextBox_Name.SelLength = 0
   TextBox_Name.SelStart = DefaultStartPOS
   Me.Caption = WordFound
Else
   WordPOS = Len(SplitWords(0))
   
   For i = 1 To UBound(SplitWords)
      StartPOS = WordPOS
      WordPOS = WordPOS + Len(SplitWords(i)) + 1
      EndPOS = WordPOS
   
      If DefaultStartPOS <= EndPOS And DefaultStartPOS > StartPOS Then
         TextBox_Name.SelStart = WordPOS - Len(SplitWords(i))
         TextBox_Name.SelLength = Len(SplitWords(i))
         WordFound = TextBox_Name.SelText
         TextBox_Name.SelLength = 0
         TextBox_Name.SelStart = DefaultStartPOS
         WordFoundSplit = Split(WordFound, vbNewLine)
         WordFound = WordFoundSplit(0)
         Exit For
      End If
   Next
End If
 
GetWord = WordFound
End Function
 
Private Sub txtScript_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
lblWord.Caption = GetWord(txtScript)
End Sub

is there a easier formula or easier way to find the word you click on in a textbox(multiline)?

[4x2y]

Try this one

Private Function GetWord(ByVal strText As String, ByVal lngCursorPosition As Long) As String
 
    Dim j As Long
    Dim lngRightSpacePos As Long
    
    ' Get the position of first <Space> or <NewLine> comes AFTER the cursor position.
    For j = lngCursorPosition + 1 To Len(strText)
        If Mid$(strText, j, 1) = " " Or Mid$(strText, j, 2) = vbNewLine Then
            Exit For
        End If
    Next
    lngRightSpacePos = j ' Save the position
    
    
    ' Get the position of first <Space> or <NewLine> comes BEFORE the cursor position.
    For j = lngCursorPosition To 1 Step -1
        If Mid$(strText, j, 1) = " " Or Mid$(strText, j, 2) = vbNewLine Then
            Exit For
        End If
    Next
    
    GetWord = Mid$(strText, j + 1, lngRightSpacePos - j)
    
End Function

[VB-only]

A comment from a guy who used to code REXX on IBM mainframes. There were three very useful functions that are missing in VB. "Word, Words, and Strip".
The string function, 'Strip', returns a string with all extraneous multiple blanks(or optional char) removed, such that the string is segmented into 'words'.
The Long function 'Words' returns the number of words in a string.
The string function 'Word' returns the nth word from a string.

With these three functions, just about all string manipulation was possible. I had to recreate these functions for myself in VB.

[Max187Boucher]

vb-only that would be very useful to do the word, word, stip functions something i might think about doing, if you don't mind can you post me an example of your code or how you did your code maybe?

and 4x2y thanks for the code it works good only one little problem when i get the vbnewline for some reason the first word after vbnewline stays with the vbnewline which is only vbLF so i modified it like this

Private Function GetWord(ByVal strText As String, ByVal lngCursorPosition As Long) As String
Dim j As Long
Dim SplitWords() As String
Dim lngRightSpacePos As Long
' Get the position of first <Space> or <NewLine> comes AFTER the cursor position.
For j = lngCursorPosition + 1 To Len(strText)
If Mid$(strText, j, 1) = " " Or Mid$(strText, j, 2) = vbNewLine Then
Exit For
End If
Next
lngRightSpacePos = j ' Save the position
' Get the position of first <Space> or <NewLine> comes BEFORE the cursor position.
For j = lngCursorPosition To 1 Step -1
If Mid$(strText, j, 1) = " " Or Mid$(strText, j, 2) = vbNewLine Then
Exit For
End If
Next
 
Word = Mid$(strText, j + 1, lngRightSpacePos - j)
 
If Word = vbLf & Right(Word, Len(Word) - 1) Then
Word = Right(Word, Len(Word) - 1)
End If
 
GetWord = Word
End Function

can you change that a different way in your sub?
i tried to find out why but this is the solution i got to, and it works perfectly now

thanks!

[DrUnicode]

There is an API that finds the first character from cursor.
From there you should be able to search forward to get the word.

Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long

Private Type POINTAPI
	x As Long
	y As Long
End Type

Private Const EM_CHARFROMPOS As Long = &HD7

Function CharFromPos(ByVal hWnd As Long, ByVal xPixels As Long, ByVal yPixels As Long) As Long
   Dim tP As POINTAPI
   tP.X = xPixels
   tP.Y = yPixels
   CharFromPos = SendMessage(hWnd, EM_CHARFROMPOS, 0, tP)
End Property

[Max187Boucher]

i get -1 in return everytime i try your function DrUnicode

Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
 
Private Type POINTAPI
   X As Long
   Y As Long
End Type
 
Private Const EM_CHARFROMPOS As Long = &HD7
 
Function CharFromPos(ByVal hWnd As Long, ByVal xPixels As Long, ByVal yPixels As Long) As Long
   Dim tP As POINTAPI
   tP.X = xPixels
   tP.Y = yPixels
   CharFromPos = SendMessage(hWnd, EM_CHARFROMPOS, 0, tP)
End Function
 
Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.Caption = CharFromPos(Text1.hWnd, X, Y)
End Sub

[4x2y]

and 4x2y thanks for the code it works good only one little problem when i get the vbnewline for some reason the first word after vbnewline stays with the vbnewline which is only vbLF so i modified it like this

Private Function GetWord(ByVal strText As String, ByVal lngCursorPosition As Long) As String
Dim j As Long
Dim SplitWords() As String
Dim lngRightSpacePos As Long
' Get the position of first <Space> or <NewLine> comes AFTER the cursor position.
For j = lngCursorPosition + 1 To Len(strText)
If Mid$(strText, j, 1) = " " Or Mid$(strText, j, 2) = vbNewLine Then
Exit For
End If
Next
lngRightSpacePos = j ' Save the position
' Get the position of first <Space> or <NewLine> comes BEFORE the cursor position.
For j = lngCursorPosition To 1 Step -1
If Mid$(strText, j, 1) = " " Or Mid$(strText, j, 2) = vbNewLine Then
Exit For
End If
Next
 
Word = Mid$(strText, j + 1, lngRightSpacePos - j)
 
If Word = vbLf & Right(Word, Len(Word) - 1) Then
Word = Right(Word, Len(Word) - 1)
End If
 
GetWord = Word
End Function

can you change that a different way in your sub?
i tried to find out why but this is the solution i got to, and it works perfectly now

The solution is simple, just replace GetWord = Mid$(strText, j + 1, lngRightSpacePos - j) with GetWord = Mid$(strText, j + 1, lngRightSpacePos - j - 1)

Private Function GetWord(ByVal strText As String, ByVal lngCursorPosition As Long) As String
 
    Dim j As Long
    Dim lngRightSpacePos As Long
    
    ' Get the position of first <Space> or <NewLine> comes AFTER the cursor position.
    For j = lngCursorPosition + 1 To Len(strText)
        If Mid$(strText, j, 1) = " " Or Mid$(strText, j, 2) = vbNewLine Then
            Exit For
        End If
    Next
    lngRightSpacePos = j ' Save the position
    
    
    ' Get the position of first <Space> or <NewLine> comes BEFORE the cursor position.
    For j = lngCursorPosition To 1 Step -1
        If Mid$(strText, j, 1) = " " Or Mid$(strText, j, 2) = vbNewLine Then
            Exit For
        End If
    Next
    
    GetWord = Mid$(strText, j + 1, lngRightSpacePos - j - 1)
    
End Function

[DrUnicode]

Sorry, should have tested this first.
You can also use Text1.SelStart whcih appears to return the same as Function CharFromPos.

Option Explicit

Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long

Private Const EM_CHARFROMPOS As Long = &HD7

Function CharFromPos(ByVal hWnd As Long, ByVal xPixels As Long, ByVal yPixels As Long) As Long
   Dim lngRet As Long
   Dim lngVal As Long

   lngVal = MakeDWord(CInt(xPixels), CInt(yPixels))
   CharFromPos = LOWORD(SendMessage(hWnd, EM_CHARFROMPOS, 0, ByVal lngVal))
End Function

Function MakeDWord(LOWORD As Integer, HIWORD As Integer) As Long
   MakeDWord = (HIWORD * &H10000) Or (LOWORD And &HFFFF&)
End Function

Function LOWORD(DWord As Long) As Integer
   If DWord And &H8000& Then
      LOWORD = DWord Or &HFFFF0000
   Else
      LOWORD = DWord And &HFFFF&
   End If
End Function

Private Sub Form_Load()
   Me.Show
   Text1.Text = "Hello" & vbCrLf & "World"
End Sub

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   Dim lChar As Long
   Dim sChar As String
   Dim iChar As Integer
   
   lChar = CharFromPos(Text1.hWnd, X \ Screen.TwipsPerPixelX, Y \ Screen.TwipsPerPixelY)
   sChar = Mid$(Text1.Text, lChar + 1, 1)
   If Len(sChar) Then
      iChar = Asc(sChar)
   Else
      iChar = 0
   End If
   Me.Caption = lChar & ", " & sChar & ", " & iChar
End Sub

[4x2y]

There is an API that finds the first character from cursor.
From there you should be able to search forward to get the word.

Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long

Private Type POINTAPI
	x As Long
	y As Long
End Type

Private Const EM_CHARFROMPOS As Long = &HD7

Function CharFromPos(ByVal hWnd As Long, ByVal xPixels As Long, ByVal yPixels As Long) As Long
   Dim tP As POINTAPI
   tP.X = xPixels
   tP.Y = yPixels
   CharFromPos = SendMessage(hWnd, EM_CHARFROMPOS, 0, tP)
End Property

This work for RichTextBox not TextBox, beside it doesn't help to get the word under the cursor because it just return the cursor position inside the RichTextBox, it is simulate RichTextBox1.SelStart

[Max187Boucher]

thanks alot guys now i understand how it works better
Drunicode thanks for the API
4x2y thanks for your code also... my code had me a bit confused at some point but with your code now is easier to read !