这个循环有什么用?

Question

Option ExplicitPrivate Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim pos As Long, lc As Long
    Dim Line As Integer, CharPos As Integer
    
    pos = X / Screen.TwipsPerPixelX + Y / Screen.TwipsPerPixelY * 65536 '这里为什么用缇?是为了把它弄到高字节去
    'Edit controls: The low word of lParam contains the horizontal coordinate. The high word contains the vertical coordinate.
    lc = SendMessage(Text1.hwnd, EM_CHARFROMPOS, 0, ByVal pos)
    
    Line = lc \ 65536
    CharPos = lc Mod 65536
    
    MsgBox " = " & GetLine(Text1, Line) & vbCrLf & "单词= " & GetWord(Text1, CharPos)
End SubFunction GetWord(txt As TextBox, pos As Integer) As String
    Dim bArr() As Byte, pos1 As Integer, pos2 As Integer, i As Integer
    
    bArr = StrConv(txt.Text, vbFromUnicode) '什么时候是系统缺省码?    pos1 = 0: pos2 = UBound(bArr)
    
    
    For i = pos - 1 To 0 Step -1 '这个循环有什么用?
        If IsDelimiter(bArr(i)) Then
            pos1 = i + 1 '结束的位置
            Exit For
        End If
    Next
        For i = pos To UBound(bArr) ''这个循环有什么用?
        If IsDelimiter(bArr(i)) Then
            pos2 = i - 1 '开始的位置
            Exit For
        End If
    Next
    
    If pos2 > pos1 Then ''这个循环有什么用?
        ReDim bArr2(pos2 - pos1) As Byte
        For i = pos1 To pos2
            bArr2(i - pos1) = bArr(i)
        Next
    
        GetWord = StrConv(bArr2, vbUnicode)
    Else
        GetWord = ""
    End If
End FunctionFunction IsDelimiter(ByVal Char As Byte) As Boolean
    Dim S As String
    
    S = Chr(Char) '返回 String，其中包含有与指定的字符代码相关的字符 。
    IsDelimiter = False
    If S = " " Or S = "," Or S = "." Or S = "?" Or S = vbCr Or S = vbLf Then
        IsDelimiter = True '如有标点符号,它就是正确的,也就产用他判断词句的标志
    End If
End FunctionFunction GetLine(txt As TextBox, ByVal Line As Integer) As String
    Dim S As String, Length As Integer, pos As Long
    
    GetLine = ""
    pos = SendMessage(txt.hwnd, EM_LINEINDEX, Line, ByVal 0&)
    Length = SendMessage(txt.hwnd, EM_LINELENGTH, pos, ByVal 0&)
    S = String(Length, Chr(0))
    RtlMoveMemory ByVal S, Length, 2
    If SendMessage(Text1.hwnd, EM_GETLINE, Line, ByVal S) > 0 Then
        GetLine = S
    End If
End FunctionPrivate Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim pos As Long, lc As Long
    Dim Line As Integer, CharPos As Integer
    
    pos = X / Screen.TwipsPerPixelX + Y / Screen.TwipsPerPixelY * 65536
    lc = SendMessage(Text1.hwnd, EM_CHARFROMPOS, 0, ByVal pos)
    
    Line = lc \ 65536
    CharPos = lc Mod 65536
    
    Text1.ToolTipText = GetWord(Text1, CharPos)
End Sub

Answer 1

Option Explicit Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 
    Dim pos As Long, lc As Long 
    Dim Line As Integer, CharPos As Integer 
     
    pos = X / Screen.TwipsPerPixelX + Y / Screen.TwipsPerPixelY * 65536 
    '这里为什么用缇?是为了把它弄到高字节去 
    '现转换为像素  pos =y<<16+x 
    'Edit controls: The low word of lParam contains the horizontal coordinate. The high word contains the vertical coordinate. 
    lc = SendMessage(Text1.hwnd, EM_CHARFROMPOS, 0, ByVal pos) 
    '发送消息 EM_CHARFROMPOS 
    Line = lc \ 65536 
    CharPos = lc Mod 65536 
    'CharPos 返回的低位字节是位置ANSI编码的哦 
    MsgBox " = " & GetLine(Text1, Line) & vbCrLf & "单词= " & GetWord(Text1, CharPos) 
End Sub Function GetWord(txt As TextBox, pos As Integer) As String 
    Dim bArr() As Byte, pos1 As Integer, pos2 As Integer, i As Integer 
     
    bArr = StrConv(txt.Text, vbFromUnicode) '什么时候是系统缺省码? 
    '转换为ansi
    pos1 = 0: pos2 = UBound(bArr) 
     
    获得离鼠标位置最近的单词结尾 
    For i = pos - 1 To 0 Step -1 '这个循环有什么用? 从鼠标位置向前遍历字符串
        If IsDelimiter(bArr(i)) Then 
            pos1 = i + 1 '结束的位置 
            Exit For 
        End If 
    Next 
     
    '获得单词开头 
    For i = pos To UBound(bArr) ''这个循环有什么用? 从字符串开始向后遍历字符串
        If IsDelimiter(bArr(i)) Then 
            pos2 = i - 1 '开始的位置 
            Exit For 
        End If 
    Next 
    
    通过循环把字符串复制到新的byte数组 可以改用memcopy更加直观
    If pos2 > pos1 Then ''这个循环有什么用? 
        ReDim bArr2(pos2 - pos1) As Byte 
        For i = pos1 To pos2 
            bArr2(i - pos1) = bArr(i) 
        Next 
     
        GetWord = StrConv(bArr2, vbUnicode) '转换回unicode字符串
    Else 
        GetWord = "" 
    End If 
End Function Function IsDelimiter(ByVal Char As Byte) As Boolean 
    Dim S As String 
     
    S = Chr(Char) '返回 String，其中包含有与指定的字符代码相关的字符 。 
    IsDelimiter = False 
    If S = " " Or S = "," Or S = "." Or S = "?" Or S = vbCr Or S = vbLf Then 
        IsDelimiter = True '如有标点符号,它就是正确的,也就产用他判断词句的标志 
    End If 
End Function Function GetLine(txt As TextBox, ByVal Line As Integer) As String 
    Dim S As String, Length As Integer, pos As Long 
     
    GetLine = "" 
    pos = SendMessage(txt.hwnd, EM_LINEINDEX, Line, ByVal 0&) 
    Length = SendMessage(txt.hwnd, EM_LINELENGTH, pos, ByVal 0&) 
    S = String(Length, Chr(0)) 
    RtlMoveMemory ByVal S, Length, 2 
    If SendMessage(Text1.hwnd, EM_GETLINE, Line, ByVal S) > 0 Then 
        GetLine = S 
    End If 
End Function Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 
    Dim pos As Long, lc As Long 
    Dim Line As Integer, CharPos As Integer 
     
    pos = X / Screen.TwipsPerPixelX + Y / Screen.TwipsPerPixelY * 65536 
    lc = SendMessage(Text1.hwnd, EM_CHARFROMPOS, 0, ByVal pos) 
     
    Line = lc \ 65536 
    CharPos = lc Mod 65536 
     
    Text1.ToolTipText = GetWord(Text1, CharPos) 
End Sub 参考这个api 说明The EM_CHARFROMPOS message retrieves information about the character closest to a specified point in the client area of an edit control. You can send this message to either an edit control or a rich edit control.Syntax
To send this message, call the SendMessage function as follows. 
lResult = SendMessage(      // returns LRESULT in lResult     (HWND) hWndControl,      // handle to destination control     (UINT) EM_CHARFROMPOS,      // message ID     (WPARAM) wParam,      // = 0; not used, must be zero    (LPARAM) lParam      // = (LPARAM) () lParam; );   
ParameterswParam
This parameter is not used. 
lParam
Specifies the coordinates of a point in the control's client area. The coordinates are in screen units and are relative to the upper-left corner of the control's client area. 
Rich edit controls: This is a pointer to a POINTL structure that contains the horizontal and vertical coordinates. Edit controls: The low-order word contains the horizontal coordinate. The high-order word contains the vertical coordinate. Return ValueRich edit controls: The return value specifies the zero-based character index of the character nearest the specified point. The return value indicates the last character in the edit control if the specified point is beyond the last character in the control. 
Edit controls: The low-order word specifies the zero-based index of the character nearest the specified point. This index is relative to the beginning of the control, not the beginning of the line. If the specified point is beyond the last character in the edit control, the return value indicates the last character in the control. The high-order word specifies the zero-based index of the line that contains the character. For single-line edit controls, this value is zero. The index indicates the line delimiter if the specified point is beyond the last visible character in a line. ResRich Edit: Supported in Microsoft® Rich Edit 1.0 and later. For information about the compatibility of rich edit versions with the various system versions, see About Rich Edit Controls.