王朝百科
分享
 
 
 

VB SendMessage

王朝百科·作者佚名  2010-08-26  
宽屏版  字体: |||超大  

'--------------------------------

'扩展文本框功能

Public Const EM_GETSEL = &HB0

Public Const EM_LINEFROMCHAR = &HC9

Public Const EM_LINEINDEX = &HBB

Public Const EM_GETLINE = &HC4

Public Const EM_GETLINECOUNT = &HBA

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public Declare Function SendMessages Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long

'获得文本的行数

Public Function GetTextLines(txtHwnd As Long) As Long

GetTextLines = SendMessage(txtHwnd, EM_GETLINECOUNT, 0, 0)

End Function

'功能描述:获得指定文本的光标

Public Sub GetCaretPos(ByVal TextHwnd As Long, LineNo As Long, ColNo As Long)

Dim i As Long, j As Long

Dim lParam As Long, wParam As Long

Dim k As Long

'首先向文本框传递EM_GETSEL消息以获取从起始位置到

'光标所在位置的字符数

i = SendMessage(TextHwnd, EM_GETSEL, wParam, lParam)

j = i / 2 ^ 16

'再向文本框传递EM_LINEFROMCHAR消息根据获得的字符

'数确定光标以获取所在行数

LineNo = SendMessage(TextHwnd, EM_LINEFROMCHAR, j, 0)

LineNo = LineNo + 1

'向文本框传递EM_LINEINDEX消息以获取所在列数

k = SendMessage(TextHwnd, EM_LINEINDEX, -1, 0)

ColNo = j - k + 1

End Sub

'功能描述:获得指定行的文本

Public Function ReadLine(ByVal TextHwnd As Long, intLine As Long) As String

Dim m_sLineString As String

Dim m_intRet As Long

m_sLineString = Space$(1056)

m_intRet = SendMessages(TextHwnd, EM_GETLINE, intLine, ByVal m_sLineString)

ReadLine = Left(m_sLineString, m_intRet)

End Function

'获得光标处的字符

Public Function GetWord(ByVal TextHwnd As Long) As String

'打开错误处理陷阱

On Error GoTo ErrGoto

'---------------------------------

'代码正文

Dim LineNo As Long

Dim ColNo As Long

Dim strData As String

Dim i As Integer

Dim intAsc As Integer

Dim intBegin As Integer, intEnd As Integer

GetCaretPos TextHwnd, LineNo, ColNo

strData = ReadLine(TextHwnd, LineNo - 1)

'---------------------------

'修正含有汉字的列数

intCharNum = 0

For i = 0 To Len(strData) - 1

If Asc(Mid(strData, i + 1, 1)) < 0 Then

intCharNum = intCharNum + 2

Else

intCharNum = intCharNum + 1

End If

If intCharNum >= ColNo Then

Exit For

End If

Next i

ColNo = i + 1

'-----------------------------

If Len(strData) > 0 Then

For i = ColNo - 1 To 1 Step -1

intAsc = Asc(Mid(strData, i, 1))

If Not ((intAsc >= Asc("a") And intAsc <= Asc("z")) Or (intAsc >= Asc("A") And intAsc <= Asc("Z")) Or (intAsc >= Asc("0") And intAsc <= Asc("9")) Or intAsc = Asc("_")) Then

intBegin = i + 1

Exit For

End If

Next i

For i = ColNo To Len(strData)

intAsc = Asc(Mid(strData, i, 1))

If Not ((intAsc >= Asc("a") And intAsc <= Asc("z")) Or (intAsc >= Asc("A") And intAsc <= Asc("Z")) Or (intAsc >= Asc("0") And intAsc <= Asc("9")) Or intAsc = Asc("_")) Then

intEnd = i - 1

Exit For

End If

Next i

If intBegin <= 0 Then intBegin = 1

If intEnd <= 0 Then intEnd = Len(strData)

If intEnd > intBegin Then

GetWord = Trim(Mid(strData, intBegin, intEnd - intBegin + 1))

Else

GetWord = ""

End If

Else

GetWord = ""

End If

'----------------------

Exit Function

'----------------------

ErrGoto:

GetWord = ""

End Function

 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
如何用java替换看不见的字符比如零宽空格&#8203;十六进制U+200B
 干货   2023-09-10
网页字号不能单数吗,网页字体大小为什么一般都是偶数
 干货   2023-09-06
java.lang.ArrayIndexOutOfBoundsException: 4096
 干货   2023-09-06
Noto Sans CJK SC字体下载地址
 干货   2023-08-30
window.navigator和navigator的区别是什么?
 干货   2023-08-23
js获取referer、useragent、浏览器语言
 干货   2023-08-23
oscache遇到404时会不会缓存?
 干货   2023-08-23
linux下用rm -rf *删除大量文件太慢怎么解决?
 干货   2023-08-08
刀郎新歌破世界纪录!
 娱乐   2023-08-01
js实现放大缩小页面
 干货   2023-07-31
生成式人工智能服务管理暂行办法
 百态   2023-07-31
英语学习:过去完成时The Past Perfect Tense举例说明
 干货   2023-07-31
Mysql常用sql命令语句整理
 干货   2023-07-30
科学家复活了46000年前的虫子
 探索   2023-07-29
英语学习:过去进行时The Past Continuous Tense举例说明
 干货   2023-07-28
meta name="applicable-device"告知页面适合哪种终端设备:PC端、移动端还是自适应
 干货   2023-07-28
只用css如何实现打字机特效?
 百态   2023-07-15
css怎么实现上下滚动
 干货   2023-06-28
canvas怎么画一个三角形?
 干货   2023-06-28
canvas怎么画一个椭圆形?
 干货   2023-06-28
canvas怎么画一个圆形?
 干货   2023-06-28
canvas怎么画一个正方形?
 干货   2023-06-28
中国河南省郑州市金水区蜘蛛爬虫ip大全
 干货   2023-06-22
javascript简易动态时间代码
 干货   2023-06-20
感谢员工的付出和激励的话怎么说?
 干货   2023-06-18
 
>>返回首页<<
 
 
静静地坐在废墟上,四周的荒凉一望无际,忽然觉得,凄凉也很美
© 2005- 王朝网络 版权所有