VBAdvisor announcement: 终于解决获取某一行的unicode文本（GetTextLine），网上流传的方法都不行

[VBAdvisor]

'本annocement只有高级VB程序员才明白其中的道理，才明白VB Unicode的重要性及难点之所在

Private Declare Function SendMessageLongA Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, _
                                                                             ByVal wMsg As Long, _
                                                                             ByVal wParam As Long, _
                                                                             ByVal lParam As Long) As Long

Private Declare Function SendMessageLongW Lib "user32" Alias "SendMessageW" (ByVal hwnd As Long, _
                                                                             ByVal wMsg As Long, _
                                                                             ByVal wParam As Long, _
                                                                             ByVal lParam As Long) As Long

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

Private Declare Function IsWindowUnicode Lib "user32.dll" (ByVal hwnd As Long) As Long

Public Property Get GetTextFromLine(Optional ByVal LineIndex As Long = -1&) As String

' returns the text for an entire line
    ' Passing -1 will retrieve the value for the line having the cursor (SelStart)
    Dim lValue As Long, arrString() As Byte
    Const EM_GETLINE As Long = &HC4
    
    If LineIndex = -1 Then LineIndex = CurrentLine
    lValue = SendMessage(m_hWndEB, EM_LINEINDEX, LineIndex, 0&)
    
    If lValue > -1 Then
        lValue = SendMessage(m_hWndEB, EM_LINELENGTH, lValue, 0&)
        If lValue Then
            If IsWindowUnicode(m_hWndEB) Then
             GetTextFromLine = String$(lValue, 0)
             CopyMemory ByVal StrPtr(GetTextFromLine), lValue, 4&
             SendMessageLongW m_hWndEB, EM_GETLINE, LineIndex, StrPtr(GetTextFromLine)
             If lValue = 1 Then GetTextFromLine = Left$(GetTextFromLine, 1)
            Else
             If lValue < 4 Then
                 ReDim arrString(0 To 3)
             Else
                 ReDim arrString(0 To lValue - 1)
             End If
             CopyMemory arrString(0), lValue, 4&
             SendMessageLongA m_hWndEB, EM_GETLINE, LineIndex, VarPtr(arrString(0))   
             If lValue < 4 Then ReDim Preserve arrString(0 To lValue - 1)
             GetTextFromLine = StrConv(arrString, vbUnicode)
            End If
        End If
    End If
End Property

'以前的方法在locale ID为英文是不能返回中文
Public Property Get GetLine(ByVal whichLine As Long) As String

Dim nLen As Long, bArr() As Byte, bArr2() As Byte, lReturn As Long

    lReturn = SendMessage(m_hWndEB, EM_LINEINDEX, whichLine, ByVal 0&)
    nLen = SendMessage(m_hWndEB, EM_LINELENGTH, lReturn, ByVal 0&)
    If nLen > 0 Then
        ReDim bArr(2 * nLen + 1) As Byte, bArr2(2 * nLen - 1) As Byte
        Call CopyMemory(bArr(0), 2 * nLen, 2) '准备一个存储器，传递消息之前先在存储器的前两个字节填入存储器的长度

        Call SendMessage(m_hWndEB, EM_GETLINE, whichLine, bArr(0))

        Call CopyMemory(bArr2(0), bArr(0), 2 * nLen)

        GetLine = String$(UBound(bArr2) + 1, vbNullChar)
        CopyMemory ByVal GetLine, bArr2(0), UBound(bArr) + 1

    Else
        GetLine = vbNullString
    End If

End Property

[VBAdvisor]

Public Property Get CurrentLine() As Long

    CurrentLine = LineForCharacterIndex(SelStart)

End Property

Public Property Get LineForCharacterIndex(lindex As Long) As Long

    LineForCharacterIndex = SendMessageLongA(m_hWndEB, EM_LINEFROMCHAR, lindex, 0)

End Property

Public Property Get SelStart() As Long

Dim lEnd    As Long
Dim lStart  As Long

    If m_hWndEB Then
        SendMessageLongA m_hWndEB, EM_GETSEL, VarPtr(SelStart), VarPtr(lEnd)
    End If

End Property

[VBAdvisor]

大家看看VBAdvisor的blog

http://hi.baidu.com/vbadvisor/blog