关于 SendMessage 使用的问题（在Text1中，转到指定行、设置光标位置、返回光标位置、获得光标所在行的位置）

Question

'1、怎么让下面的转到指定行 对 比较大的文件也可以  比如 200k的文件
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPrivate Const EM_LINEINDEX = &HBBPrivate Sub Command1_Click()
    Text1.SelStart = SendMessage(Text1.hwnd, EM_LINEINDEX, CLng(5), CLng(0))
End Sub'2、主要要解决的是 下面两个函数返回的是 汉字是当2个位置 字母1个位置  怎么样才能使 汉字返回的也是一个位置
'比如 光标  在 一个汉字后边 返回不是2 而是1'下面的部分用于通过API方式向控件赋值或读取属性值
Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" _
        (ByVal hWnd As Long, ByVal wMsg As Long, ByRef wParam As Long, ByRef lParam As Long) As Long
'When you are sending the EM_GETSEL message you are sending the variables _
 address(ByREF) so that the API can return the Selstart and SelEnd values _
 back to you.
'When you are sending the EM_SETSEL message you are sending the variables _
actual values(ByVal) since you are sending not receiving values.
Private Declare Function GetFocus Lib "USER32" () As Long
'GetFocus函数用于返回焦点控件的句柄
Private Const EM_GETSEL = &HB0
Private Const EM_SETSEL = &HB1
Private Const EM_GETLINECOUNT = &HBA
Private Const EM_LINEINDEX = &HBB
Private Const EM_LINELENGTH = &HC1
Private Const EM_LINEFROMCHAR = &HC9Public Function setTextBoxCur(TBX As TextBox, ByVal lnCur As Long, Optional ByVal SelLen As Long = 0)
'功能:用于设置文本框的光标位置,主要是为了把文本框的光标设置为大于32767的无符号整形值
'写这个函数是为了突破VB对于文本框光标的0-32767限制(VB/VBA的BUG)
'lnCur 的输入范围:0-65535,与文本框的字符串长度限制相同
'注:为了取得文本框的hWnd,必须把它设置为焦点控件并用GetFocus函数
'  同样的问题,如果你试图选择一个文本框的所有文本,
'  但是这个文本框中的文本内容长度大于32767并且你所需要选中的部分sellength长度大于32767时,ACCESS会报溢出错;
'  这个函数一起解决了用SelLength属性选择内容的问题.
 Dim hWnd As Long
   
' The TextBox control MUST HAVE THE FOCUS
  If TBX.Parent.ActiveControl.Name <> TBX.Name Then
     TBX.Parent.SetFocus
     TBX.SetFocus
  End If
  hWnd = GetFocus '由于只有窗体才有句柄属性,要对文本框操作,必须找到它的句柄
   
  lnCur = IIf(lnCur > -1, lnCur, 0)
  Call SendMessage(hWnd, EM_SETSEL, ByVal lnCur, ByVal lnCur + SelLen)
End FunctionPublic Function GetTextBoxCur(TBX As TextBox, ByRef lnCur As Long, Optional ByRef SelLen As Long = 0)
' 与上述setTextBoxCur相对应,用API来解决读取文本框中选中内容的光标位置和长度
 Dim hWnd As Long
 Dim lEnd As Long
   
  If TBX.Parent.ActiveControl.Name <> TBX.Name Then
     TBX.Parent.SetFocus
     TBX.SetFocus
  End If
  hWnd = GetFocus
   
  Call SendMessage(hWnd, EM_GETSEL, lnCur, lEnd)
  SelLen = lEnd - lnCur '返回选中文本长度
  GetTextBoxCur = lnCur '返回光标位置
   
End Function
'3、获得光标所在行的位置  网络上找到一个 只对 小文件可以 但是文件稍微大点 就出错 也是用SendMessage这个函数的

Answer 1

第一个问题，代码错了，正确的应该是：
    Dim lRet As Long
    lRet = SendMessage(Text1.hwnd, EM_LINEINDEX, 10, ByVal 0&)
    Debug.Print lRet
    SendMessage Text1.hwnd, EM_SETSEL, lRet, ByVal lRet
    Text1.SetFocus
我现在要吃饭了，剩下两个问题回头再看。

Answer 2

第一个问题：
    Dim lRet As Long
    
    '设置光标到指定行
    lRet = SendMessage(Text1.hwnd, EM_LINEINDEX, 10, ByVal 0&)
    SendMessage Text1.hwnd, EM_SETSEL, lRet, ByVal lRet
    Text1.SetFocus
第二个问题不太清楚，返回的是光标在整个文本中的位置呢（你的代码是这样实现的）？还是在当前行中的位置？
如果是前者，解决办法如下：
    
    '获得当前光标所在位置（汉字算1个位置）
    Dim lCur As Long
    Dim strBuffer As String
    Call SendMessage(Me.Text1.hwnd, EM_GETSEL, 0, lCur)
    
    strBuffer = String(lCur, vbNullChar)
    lstrcpyn strBuffer, Me.Text1.Text, lCur
    lCur = Len(strBuffer) '返回光标当前位置（中文算1个字符，并包含回车换行符）
第三个问题：
我使用了300多K的文本，仍然没有出错，可见，不是TextBox的问题，而是编码问题。

Answer 3

谢谢 第一个问题解决麻烦问下怎么设置光标到具体位置？主要是 这个api返回的是 以及设置是的汉字2个位置  字母一个位置但是vb6里却都是 1个 

Answer 4

第2个问题，你要提前把字符转换为 ansi 文本然后计算位置，取出文本，ansi文本＝ strconv（文本，vbfromunicode）这样依靠字符数定位就行了3. em_setsel 是有 65536的限制，可以用他的扩展版本 em_SetSelEx －－ 忘了是不是这样拼了
忘他是不是用wparam,lparam 来确定范围的了，这个东西能够确保大文本的选择就是，你再研究下

Answer 5

－－！  不行 300分看的我太眼馋了 我决定帮到你把分给我为止
我这就给你写个代码去，第2个问题叙述不清，再说清楚点，要靠字符定位的要求一般没有主动定位的
比如我要把textbox中的字符： 中国132 弄成sel状态，那么步骤应该是先查找到这个字符在文本框中的起始
位置，然后再len出长度，最后setsel，设置成选中状态，lz的第2个问题，应该在调用他的过程中解决真正的定位才是正确的

Answer 6

SendMessage返回的是MDBS编码的位置（我测试了一下，TextBox中的文本是MDBS），你要的是UNICODE编码还是ANSI编码的位置？

Answer 7

这是第3个问题的超大文本的选中方法
Private Type CHARRANGE
cpmin As Long  ' 将第 cpmin 个字符位置
cpmax As Long  ' 到 cpmax 个字符位置的文本标记成选中状态
End Type'注意,这个消息不同于 em_setsel 的起始位置 + 长度的标示方法
SendMessage(HandleOf(Rich)Textbox, EM_EXSETSEL, 0, 传址参数 Charrange)第2题等你回信息
分多给我点吧 , 来我的群详细讨论 18403077

Answer 8

您好，第一个问题  lyserver 回答正确了  要给他100分 

Answer 9

http://topic.csdn.net/u/20090421/16/94e0fba7-7ae2-490c-b0fe-278438696113.html两个其实是一样的

Answer 10

附带一个问题  就是  像 windows 自带的记事本一样 可以快速 得到 光标 所在 的列  所在 的行解决了

Answer 11

    '获得当前光标所在位置（汉字算1个位置） 
    Dim lCur As Long 
    Dim strBuffer As String 
    Call SendMessage(Me.Text1.hwnd, EM_GETSEL, 0, lCur) 
    
    strBuffer = String(lCur, vbNullChar) 
    lstrcpyn strBuffer, Me.Text1.Text, lCur 
    lCur = Len(strBuffer) '返回光标当前位置（中文算1个字符，并包含回车换行符） 
还是 汉字2个 字母一个  不可以

Answer 12

你的第2个问题的思路有问题,你该换个角度去做如果是查找,你首先把文本所有内容都取出,然后按字节找到位置,假如现在找到的位置是 10,然后再len出所查找的文本的 ansi 数据类型的文本长度,这就是sellenght的长度,要按照 ansi 数据类型处理,如果你是用vb的textbox的话

Answer 13

对了,取出的文本一定要先做 strconv() to ansi 之后,再进行比对查找

Answer 14

Private Sub Command1_Click()
Dim allString As String
allString = Text1
'一个文本框,里面添加些内容Dim mulBits() As Byte
mulBits = StrConv(allString, vbFromUnicode)
'取出文本框内容,并把这些内容转换为 ansi 字节流
Dim FindData() As Byte
FindData = StrConv("CreateSystemGUID", vbFromUnicode)
'查找这个字符串: CreateSystemGUIDDim i As Long, i1 As Long
'循环位置标记Dim FoundStartPos As Long
'找到的字符匹配字符串起始位置Do
    If FindData(0) = mulBits(i) Then
        For i1 = UBound(FindData) To 0 Step -1
            If FindData(i1) <> mulBits(i + i1) Then GoTo NextLop
        Next
            FoundStartPos = i
            Exit Do
    End IfNextLop:i = i + 1
If i >= UBound(mulBits) Then Exit Do
LoopText1.SetFocus
SendMessage Text1.hWnd, EM_SETSEL, ByVal FoundStartPos, ByVal FoundStartPos + UBound(FindData) + 1
'设置选定内容SendMessage Text1.hWnd, ByVal &HB7, ByVal 0&, ByVal 0& ' EM_SCROLLCARET
'将选定内容,放到可视范围之内End Sub

Answer 15

前一阵子写过代码着色,研究了几天,写完之后速度那个慢啊........
到不是我的代码有问题,是这些消息的处理问题,里面要设置的消息很多,取单行字符串,取可视矩形内所有字符串
设置sel,设置颜色,字体,用了 em_exsetsel ,这个消息有个问题,要么是系统不支持,要么是他的设置结果不会显示出来,因为利用这个消息实现的代码着色,成功了而sel效果,我是从来没看到可能这个消息就是不显示sel效果的,而且这个消息和别的消息似乎不会联动

Answer 16

以下代码具备具备查看（从上到下或从下到下）、替换、取行列坐标、设置和获取光标位置5项功能：Option ExplicitPrivate 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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Var() As Any) As LongPrivate Const WM_USER As Long = &H400
Private Const EM_LINEINDEX = &HBB
Private Const EM_SETSEL = &HB1
Private Const EM_GETSEL = &HB0
Private Const EM_GETLINE = &HC4
Private Const EM_LINEFROMCHAR = &HC9
Private Const EM_LINELENGTH = &HC1
Private Const EM_SETSELEX As Long = (WM_USER + 55)
Private Const EM_SETTARGETDEVICE = (WM_USER + 72)Private Type POINTAPI
        x As Long
        y As Long
End TypeDim m_nLength As Long '文本字符长度
Dim m_strReverse As String '反转后的文本'由于VB标准的TextBox控件只支持65536个字符，
'而Form 2.0的TextBox控件又SPY不到句柄，故使用了RichTextBox
Private Sub Form_Load()
    Dim hFile As Integer
    
    '允许使用RichTextBox的横向滚动条
    Call SendMessage(RichTextBox1.hwnd, EM_SETTARGETDEVICE, 0, 1)
    
    '读文件到RichTextBox
    hFile = FreeFile
    Open "g:\inst\小说\沧海凤歌.txt" For Binary As #hFile
    Me.RichTextBox1.Text = Input(LOF(hFile), hFile)
    Close #hFile
End Sub'设置光标位置（按字节计算，起始行和起始列为0）
Sub SetCurPos(ByVal nLine As Long, Optional ByVal nCol As Long = 0)
    Dim nPos As Long
    
    nPos = SendMessage(Me.RichTextBox1.hwnd, EM_LINEINDEX, nLine, ByVal 0&)
    SendMessage Me.RichTextBox1.hwnd, EM_SETSEL, nPos, ByVal nPos + nCol
    Me.RichTextBox1.SetFocus
End Sub'设置光标位置（按字符计算）
Sub SetCurPosCh(ByVal nLine As Long, Optional ByVal nCol As Long = 0)
    Dim strLine As String
    Dim nPos As Long, nLen As Long
    Dim byteBuffer() As Byte
    
    nPos = SendMessage(Me.RichTextBox1.hwnd, EM_LINEINDEX, nLine, ByVal 0&)
    nLen = SendMessage(Me.RichTextBox1.hwnd, EM_LINELENGTH, nPos, ByVal 0&) '取该行第一个字符所在的位置
    If nLen > 0 Then
        ReDim byteBuffer(1024)
        byteBuffer(1) = 4 '预设可接收1024字节的内容
        SendMessage Me.RichTextBox1.hwnd, EM_GETLINE, nLine, byteBuffer(0)
        nLen = LenB(StrConv(Left(StrConv(byteBuffer, vbUnicode), nCol), vbFromUnicode))
        SendMessage Me.RichTextBox1.hwnd, EM_SETSEL, nPos, ByVal nPos + nLen
        Me.RichTextBox1.SetFocus
        Erase byteBuffer
    End If
End Sub
'获得光标位置（按字节计算，起如行和起始列均为0）
Private Function GetCurPos(ptPos As POINTAPI) As Long
    Dim nLine As Long, nCol As Long
    
    Call SendMessage(Me.RichTextBox1.hwnd, EM_GETSEL, 0, ptPos)
    nLine = SendMessage(Me.RichTextBox1.hwnd, EM_LINEFROMCHAR, ptPos.x, ByVal 0&)  '获得行号
    nCol = ptPos.x - SendMessage(Me.RichTextBox1.hwnd, EM_LINEINDEX, -1, 0) '获得列号
    GetCurPos = ptPos.x '光标位置（按字节计算）
    ptPos.y = nLine
    ptPos.x = nCol
End Function'获得光标位置（按字符计算）
Private Function GetCurPosCh(ptPos As POINTAPI) As Long
    Dim nLine As Long, nCol As Long
    Dim byteBuffer() As Byte
    
    SendMessage Me.RichTextBox1.hwnd, EM_GETSEL, 0, ptPos
    nLine = SendMessage(Me.RichTextBox1.hwnd, EM_LINEFROMCHAR, ptPos.x, ByVal 0&)  '获得行号
    nCol = ptPos.x - SendMessage(Me.RichTextBox1.hwnd, EM_LINEINDEX, -1, 0)
    ReDim byteBuffer(1024)
    byteBuffer(1) = 4
    SendMessage Me.RichTextBox1.hwnd, EM_GETLINE, nLine, byteBuffer(0)
    ReDim Preserve byteBuffer(nCol)
    nCol = Len(StrConv(byteBuffer, vbUnicode)) - 1 '获得列号
    GetCurPosCh = Me.RichTextBox1.SelStart '光标位置（按字符计算）
    ptPos.y = nLine
    ptPos.x = nCol
    Erase byteBuffer
End Function'查找指定的内容（返回按字节计算的位置，起始位置为0）
Private Function FindText(ByVal strText, Optional ByVal lStart As Long = 0, Optional ByVal bFromBottom As Boolean) As Long
    Dim nPos As Long
    
    If Not bFromBottom Then
        nPos = Me.RichTextBox1.Find(strText, lStart)
        If nPos >= 0 Then SendMessage Me.RichTextBox1.hwnd, EM_GETSEL, 0, nPos
    ElseIf lStart < m_nLength Then
        strText = StrReverse(strText)
        nPos = m_nLength - InStr(m_nLength - lStart, m_strReverse, strText) - Len(strText) + 1
        Me.RichTextBox1.SelStart = nPos
        SendMessage Me.RichTextBox1.hwnd, EM_GETSEL, 0, nPos
        Me.RichTextBox1.SelLength = Len(strText)
    End If
    FindText = nPos
End Function'查找指定的内容（返回按字符计算的位置，起始位置为0）
Private Function FindTextCh(ByVal strText, Optional ByVal lStart As Long = 0, Optional ByVal bFromBottom As Boolean) As Long
    Dim nPos As Long    If Not bFromBottom Then
        nPos = Me.RichTextBox1.Find(strText, lStart)
    ElseIf lStart < m_nLength Then
        strText = StrReverse(strText)
        nPos = m_nLength - InStr(lStart + 1, m_strReverse, strText) - Len(strText) + 1
        Me.RichTextBox1.SelStart = nPos
        Me.RichTextBox1.SelLength = Len(strText)
    End If
    FindTextCh = nPos
End Function'替换当前所选定的内容（按字节位置）
Sub ReplaceText(ByVal strText As String)
    Me.RichTextBox1.SelText = strText
End Sub'获得反转后的文本
Private Sub RichTextBox1_Change()
    m_nLength = Len(Me.RichTextBox1.Text)
    m_strReverse = StrReverse(Me.RichTextBox1.Text)
End SubPrivate Sub RichTextBox1_SelChange()
    Dim ptPos As POINTAPI
    
    Call GetCurPosCh(ptPos)
    Debug.Print "光标位置：" & ptPos.y & "行，" & ptPos.x & "列。"
End Sub

Answer 17

这几个问题现在可以归结为  .SelStart  怎么用api代替的问题了
小文件用.SelStart 大文件（先用返回值） 超过范围就用返回的数字了，不用SelStart 也可以大至达到效果 而且速度也快点 不用拷贝来拷贝去 但是有个不好 就是不能 精确的从大文件的地方开始。

Answer 18

非常感谢  第二个问题也解决 了 网络上找了一个 第3个问题网络上有 但是怎么得到的结果 都是 1  1 啊  奇怪Option Explicit'************************************************************
'功能：取得TextBox、RichTextBox光标所在的行和列'支持中文，一个汉字算一列
'有问题请给我写邮件
'作者：Matrix
'邮件：[email protected]
'2003-01-24修正了马虎的错误
'************************************************************Public Const WM_USER = &H400
Public Const EM_EXGETSEL = WM_USER + 52Public Const EM_LINEFROMCHAR = &HC9
Public Const EM_LINEINDEX = &HBB
Public Const EM_GETSEL = &HB0Public Type CHARRANGE
    cpMin As Long
    cpMax As Long
End TypePublic Type POINTAPI
        x As Long
        y As Long
End TypePublic Declare Function SendMessage Lib "user32" Alias _
        "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As _
        Long, ByVal wParam As Long, lParam As Any) As LongPublic Declare Sub CopyMemory Lib "kernel32" Alias _
        "RtlMoveMemory" (pDst As Any, pSrc As Any, _
        ByVal ByteLen As Long)
'取得光标所在的行和列
Public Function GetCurPos(ByRef TextControl As Control) As POINTAPI
    Dim LineIndex As Long
    Dim SelRange As CHARRANGE
    Dim TempStr As String
    Dim TempArray() As Byte
    Dim CurRow As Long
    Dim CurPos As POINTAPI    TempArray = StrConv(TextControl.Text, vbFromUnicode)    '取得当前被选中文本的位置 适用于 RichTextBox
    'TextControl 用 EM_GETSEL 消息
    Call SendMessage(TextControl.hWnd, EM_EXGETSEL, 0, SelRange)    '根据参数wParam指定的字符位置返回该字符所在的行号
    CurRow = SendMessage(TextControl.hWnd, EM_LINEFROMCHAR, SelRange.cpMin, 0)    '取得指定行第一个字符的位置
    LineIndex = SendMessage(TextControl.hWnd, EM_LINEINDEX, CurRow, 0)    If SelRange.cpMin = LineIndex Then
        GetCurPos.x = 1
    Else        TempStr = String(SelRange.cpMin - LineIndex, 13)        '复制当前行开始到选择文本开始的文本
        CopyMemory ByVal StrPtr(TempStr), ByVal StrPtr(TempArray) + LineIndex, SelRange.cpMin - LineIndex
        TempArray = TempStr        '删除无用的信息
        ReDim Preserve TempArray(SelRange.cpMin - LineIndex - 1)        '转换为 Unicode
        TempStr = StrConv(TempArray, vbUnicode)        GetCurPos.x = Len(TempStr) + 1
    End If
    GetCurPos.y = CurRow + 1
End Function

Answer 19

Private Sub Command1_Click()
    Debug.Print GetCurPos(TxtText(0)).x, GetCurPos(TxtText(0)).y
End Sub