vb 光标所在位置

text1现有一段文本abccbaaaabbb假如selstart=7那么光标在第2行第2列想写一个函数自动获取光标所在位置不知道怎么写...100分求...如以上例子,... 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
展开
 我来答
HotMousE
2012-04-19 · TA获得超过146个赞
知道小有建树答主
回答量:212
采纳率:100%
帮助的人:178万
展开全部
' 注意:
' 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列
追答
看了楼下的几个,的确发现高手很多..至于你选中的那个答案反而是最没看头...

等你程序写多了,你会发现到这一点的。
微测检测5.10
2023-05-10 广告
您好!建议咨 深圳市微测检测有限公司,已建立起十余个专业实验室,企业通过微测检测就可以获得一站式的测试与认 证解决方案;(EMC、RF、MFi、BQB、QI、USB、安全、锂电池、快充、汽车电子EMC、汽车手机互 联、语音通话质量),认证遇... 点击进入详情页
本回答由微测检测5.10提供
百度网友bdb9803
推荐于2017-09-21 · TA获得超过1.1万个赞
知道大有可为答主
回答量:1.1万
采纳率:53%
帮助的人:1亿
展开全部
楼上的答案都太复杂了,还用到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是文本框控件名称,返回光标所在列位置
本回答被提问者采纳
已赞过 已踩过<
你对这个回答的评价是?
评论 收起
zx001z7d53
2012-04-19 · TA获得超过2万个赞
知道大有可为答主
回答量:2.4万
采纳率:52%
帮助的人:5656万
展开全部
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是个好东西啊,现在开始学学吧
已赞过 已踩过<
你对这个回答的评价是?
评论 收起
ljl88900
2012-04-19 · TA获得超过2661个赞
知道大有可为答主
回答量:2197
采纳率:100%
帮助的人:2632万
展开全部
用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
已赞过 已踩过<
你对这个回答的评价是?
评论 收起
chinaboyzyq
2012-04-19 · TA获得超过1.3万个赞
知道大有可为答主
回答量:1.3万
采纳率:89%
帮助的人:3265万
展开全部
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
已赞过 已踩过<
你对这个回答的评价是?
评论 收起
收起 更多回答(3)
推荐律师服务: 若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询

为你推荐:

下载百度知道APP,抢鲜体验
使用百度知道APP,立即抢鲜体验。你的手机镜头里或许有别人想知道的答案。
扫描二维码下载
×

类别

我们会通过消息、邮箱等方式尽快将举报结果通知您。

说明

0/200

提交
取消

辅 助

模 式