Question

vb 光标所在位置

text1 现有一段文本
abc
cba
aaa
bbb
假如selstart=7
那么光标在第2行第2列
想写一个函数自动获取光标所在位置
不知道怎么写...
100分求...
如以上例子,下面的函数返回值应该=2,而不是7
msgbox abc(text1)

简单的说就是想判断某一行光标所在行的那一列,而不是整个文本所在列
text1 现有一段文本
abc
cba
aaa
bbb

假如selstart=4
那么光标在第2行第0列

函数abc返回值就应该是0

Answer 1

' 注意:
' 1. 这里纠正了一个认识上的误区。
' 您说: 假如selstart=7,那么光标在第2行第2列
' 如果您的列坐标是从0开始的，那么行坐标也应该是从0开始
' 那么实际的位置应是第1行，第2列
'
' 2. 您说: selstart=4, 那么光标在第2行第0列
' 实际测试: 在vb6环境中，selstart=4时，光标是在第0行第3列，目前以下代码是按此规则来获得位置
' 若需要满足您说的条件时，请寻找并恢复函数GetPoint中以下三行已注释的代码
' Result.x = 0:
' Result.y = Result.y + 1
' IsCharCr = True

Option Explicit

' 坐标结构
Private Type Point
x As Long ' 横向坐标(列)
y As Long ' 纵向坐标(行)
End Type

' 函数: 从字符串中获取坐标位置
' 参数: Text 检查的字符串
' StartIndex 文字的位置
Private Function GetPoint(Text As String, StartIndex As Long) As Point

' 变量声明
Dim Result As Point ' 坐标信息
Dim i As Long ' 当前扫描的位置
Dim iChar As String ' 当前扫描的字符
Dim IsCharCr As Boolean ' 标记上一个是否为换行符

' 初始化
Result.x = 0
Result.y = 0
IsCharCr = False

' 获得需要扫描的字符串
Text = Left(Text, StartIndex)

' 扫描文本
For i = 1 To Len(Text)
iChar = Mid(Text, i, 1)

Select Case iChar
Case vbCr ' 0x0A 换行符
'Result.x = 0:
'Result.y = Result.y + 1
'IsCharCr = True

Case vbLf ' 0x10 回车符
If Not IsCharCr Then
Result.x = 0:
Result.y = Result.y + 1
End If
IsCharCr = False

Case Else ' 其他
IsCharCr = False
Result.x = Result.x + 1

End Select

Next

' 返回
GetPoint = Result

End Function

' 函数: 从TextBox控件中获取坐标位置(对GetPoint函数的封装)
' 参数: Control TextBox类型控件
Private Function GetPointByTextBox(Control As TextBox) As Point

GetPointByTextBox = GetPoint(Control.Text, Control.SelStart)

End Function

' 测试代码
Private Sub Command1_Click()

Dim pt As Point
Text1.SelStart = 7
pt = GetPointByTextBox(Text1)
Call MsgBox("行:" & pt.y & ", 列:" & pt.x)
Call Text1.SetFocus

End Sub

追问

不好意思,回车符算2字节
所以是第2行第2列

追答

看了楼下的几个，的确发现高手很多..至于你选中的那个答案反而是最没看头...

等你程序写多了，你会发现到这一点的。

追问

拜托,现在求的是能用,而不是别的什么.大大小小的程序我写了不知有几千个程序了上万代码的都写过.代码写出来不是要好看.而是实用.简洁.算法与计算要快.才是王道

追答

快有2快。
1. 写的快，直接给出函数库，直接调用。
2. 运行的快，楼下2个运行效率，和你选的那个，根本不是一个级别的。

目前对你而言，你求的是直接可以调用的函数，
对你而言，abc函数里的内容行数都不重要。因为你只是调用者的角色。
而这个函数的效率对你反而很重要，因为当你要处理大批量的文字时，你就会发现到两者的差异。

举个例子:
Windows自带的NotePad.Exe，你打开一个小文本文件，替换里面的文字。
得，一点问题都没很流畅。
但如果当你打开的文本文件加大，提升到1M，其实也不算大吧。对不
你再替换里面的文字试试。

Answer 2

楼上的答案都太复杂了，还用到API，这是最简单的，实际验证通过！

Function abc(ByVal txt As TextBox) As Long
Dim s() As String, a As Long, b As String
a = txt.SelStart
If a > 0 Then
b = Left(txt.Text, a)
s = Split(b, vbCrLf)
abc = Len(s(UBound(s)))
End If
End Function

文本框记得加上滚动条，这样调用：
Print abc(Text1) 'Text1是文本框控件名称，返回光标所在列位置

Answer 3

Const EM_GETSEL = &HB0
Const EM_LINEFROMCHAR = &HC9
Const EM_LINEINDEX = &HBB
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

Public Sub GetCaretPos(ByVal TextHwnd As Long, LineNo As Long, ColNo As Long)
LineNo = SendMessage(TextHwnd, EM_LINEFROMCHAR, j, 0)
LineNo = LineNo + 1

I = SendMessage(TextHwnd, EM_GETSEL, wParam, lParam)
j = I / 2 ^ 16
k = SendMessage(TextHwnd, EM_LINEINDEX, -1, 0)
ColNo = j - k + 1
End Sub

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim LineNo As Long, ColNo As Long
Call GetCaretPos(Text1.hwnd, LineNo, ColNo)
Label1.Caption = LineNo
Label2.Caption = ColNo
End Sub
API是个好东西啊，现在开始学学吧

Answer 4

用Api函数可以准确判断
一.建立一个模块,下面代码到模块中:
Option Explicit

Private Const EM_GETLINECOUNT = &HBA
Private Const EM_GETSEL = &HB0
Private Const EM_LINEFROMCHAR = &HC9
Private Const EM_LINEINDEX = &HBB

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

Public Function GetCaretPos(ByVal TextHwnd As Long, Optional LineNo As Long, Optional ColNo As Long) As Long
Dim j As Long
Dim lParam As Long, wParam As Long
Dim k As Long

j = SendMessage(TextHwnd, EM_GETSEL, wParam, lParam) / (2 ^ 16)
'行
LineNo = SendMessage(TextHwnd, EM_LINEFROMCHAR, j, 0) + 1
'列
k = SendMessage(TextHwnd, EM_LINEINDEX, -1, 0)
ColNo = j - k
GetCaretPos = ColNo
End Function
二.函数调用举例:

Private Sub Text1_Click()
Me.Caption = GetCaretPos(Text1.hwnd) & "列"
End Sub

Answer 5

Option Explicit
Const EM_GETSEL = &HB0
Const EM_LINEFROMCHAR = &HC9
Const EM_LINEINDEX = &HBB

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 Function abc(Text As TextBox) As Long

Dim I As Long, j As Long
Dim lParam As Long, wParam As Long
Dim k As Long

I = SendMessage(Text.hwnd, EM_GETSEL, wParam, lParam)
j = I / 2 ^ 16
k = SendMessage(Text.hwnd, EM_LINEINDEX, -1, 0)
abc = j - k

End Function

Private Sub Command1_Click()
MsgBox abc(Text1)
End Sub