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 展开
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 展开
5个回答
展开全部
' 注意:
' 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
' 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列
追答
看了楼下的几个,的确发现高手很多..至于你选中的那个答案反而是最没看头...
等你程序写多了,你会发现到这一点的。
展开全部
楼上的答案都太复杂了,还用到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是文本框控件名称,返回光标所在列位置
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是文本框控件名称,返回光标所在列位置
本回答被提问者采纳
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
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是个好东西啊,现在开始学学吧
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是个好东西啊,现在开始学学吧
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
用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
一.建立一个模块,下面代码到模块中:
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
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
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
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
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询
广告 您可能关注的内容 |