textbox问题%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

cnvb007 2003-05-20 08:58:03
多行TEXTBOX，有滚动条，若滚动条在中间某一位置，如何取得当前可以看见的第一行是那一行（行号），最后可见的是那一行（行号）？还有可见的第一个字的位置（所在文章中的位置）？可见的最后一个字的位置（所在文章中的位置）？
...全文
79 12 打赏 收藏 转发到动态 举报
写回复
用AI写文章
12 条回复
切换为时间正序
请发表友善的回复…
发表回复
cnvb007 2003-05-23
  • 打赏
  • 举报
 回复
换成richtextbox为什么不准确那？怎么办？
junwhj 2003-05-22
  • 打赏
  • 举报
 回复
这种情况下不能使用selstart，可以用下面的程序取得Text

src = StrConv(Text1.Text, vbFromUnicode)
ReDim arr(CharIndex2 - CharIndex1) As Byte
Call CopyMemory(arr(0), src(CharIndex1), CharIndex2 - CharIndex1)
MsgBox StrConv(arr, vbUnicode)
rainstormmaster 2003-05-22
  • 打赏
  • 举报
 回复
如果文本框中有中文和英文的话，返回值还是不准确。可以简单的用.selstart测试一下。
rainstormmaster 2003-05-21
  • 打赏
  • 举报
 回复
to： junwhj(junwhj.myrice.com)
你的代码不能处理中文吧：）

下面的代码和junwhj(junwhj.myrice.com)的有同样的问题
Option Explicit
Private Const EM_GETFIRSTVISIBLELINE = &HCE
Private Const EM_GETRECT = &HB2
Private Const EM_CHARFROMPOS = &HD7
Private Const WM_GETFONT = &H31
Private Const EM_GETLINE = &HC4
Private Const EM_GETLINECOUNT = &HBA
Private Const EM_FMTLINES = &HC8
Private Const EM_LINEINDEX = &HBB
Private Const EM_LINELENGTH = &HC1
Private Const EM_LINEFROMCHAR = &HC9
Private Declare Sub RtlMoveMemory Lib "KERNEL32" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal hDc As Long, lpMetrics As TEXTMETRIC) As Long
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 Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDc As Long, ByVal hObject As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDc As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type TEXTMETRIC
tmHeight As Long
tmAscent As Long
tmDescent As Long
tmInternalLeading As Long
tmExternalLeading As Long
tmAveCharWidth As Long
tmMaxCharWidth As Long
tmWeight As Long
tmOverhang As Long
tmDigitizedAspectX As Long
tmDigitizedAspectY As Long
tmFirstChar As Byte
tmLastChar As Byte
tmDefaultChar As Byte
tmBreakChar As Byte
tmItalic As Byte
tmUnderlined As Byte
tmStruckOut As Byte
tmPitchAndFamily As Byte
tmCharSet As Byte
End Type
Private Type TextOffset
FirstLine As Long
FirstCharOffset As Long
LastLine As Long
LastCharOffset As Long
End Type

Private Function getvisiblelines(mTextbox As TextBox) As Long
Dim Rc As RECT
#If Win32 Then
Dim hDc As Long
Dim lFont As Long
Dim oldFont As Long
Dim dl As Long
#Else
Dim hDc As Integer
Dim lFont As Integer
Dim oldFont As Integer
Dim dl As Integer
#End If
Dim Tm As TEXTMETRIC
Dim lc As Long
lc = SendMessage(mTextbox.hWnd, EM_GETRECT, 0, Rc)
lFont = SendMessage(mTextbox.hWnd, WM_GETFONT, 0, ByVal 0&)
hDc = GetDC(mTextbox.hWnd)
If lFont <> 0 Then
oldFont = SelectObject(hDc, lFont)
End If
dl = GetTextMetrics(hDc, Tm)
If lFont <> 0 Then
oldFont = SelectObject(hDc, lFont)
End If
getvisiblelines = (Rc.Bottom - Rc.Top) / Tm.tmHeight
dl = ReleaseDC(mTextbox.hWnd, hDc)


End Function
Private Sub Command4_Click()
Dim MYTEXTOFF As TextOffset
MYTEXTOFF = getTextOffset(Text1)
Debug.Print "可见的第一行的行号:"; MYTEXTOFF.FirstLine
Debug.Print "可见的第一个字的位置:"; MYTEXTOFF.FirstCharOffset
Debug.Print "可见的最后一行的行号:"; MYTEXTOFF.LastLine
Debug.Print "可见的最后一个字的位置:"; MYTEXTOFF.LastCharOffset
End Sub


Private Sub Form_Load()
Dim Str As String
Dim I As Integer

Str = "Line0"
For I = 1 To 99
Str = Str & vbCrLf & "Line" & I
Next I
Text1.Text = Str

End Sub
Private Function getTextOffset(mTextbox As TextBox) As TextOffset
Dim mFirstLine As Long
Dim mFirstCharOffset As Long
Dim mLastLine As Long
Dim mLastCharOffset As Long
mFirstLine = SendMessage(mTextbox.hWnd, EM_GETFIRSTVISIBLELINE, 0, ByVal 0&)
getTextOffset.FirstLine = mFirstLine
mFirstCharOffset = SendMessage(mTextbox.hWnd, EM_LINEINDEX, mFirstLine, ByVal 0&)
getTextOffset.FirstCharOffset = mFirstCharOffset
Dim LineCount As Long
LineCount = SendMessage(mTextbox.hWnd, EM_GETLINECOUNT, 0, ByVal 0&)
Dim VisLine As Long
VisLine = getvisiblelines(mTextbox)
If mFirstLine + VisLine - 1 >= LineCount Then
mLastLine = LineCount
Else
mLastLine = mFirstLine + VisLine - 1
End If
getTextOffset.LastLine = mLastLine
mLastCharOffset = SendMessage(mTextbox.hWnd, EM_LINEINDEX, mLastLine, ByVal 0&)
Dim LLength As Long
LLength = SendMessage(mTextbox.hWnd, EM_LINELENGTH, mLastLine, ByVal 0&)
mLastCharOffset = mLastCharOffset + LLength
getTextOffset.LastCharOffset = mLastCharOffset
End Function
junwhj 2003-05-21
  • 打赏
  • 举报
 回复
Option Explicit

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 Declare Function GetScrollInfo Lib "user32" _
(ByVal hWnd As Long, _
ByVal n As Long, _
lpScrollInfo As SCROLLINFO) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)

Private Type SCROLLINFO
cbSize As Long
fMask As Long
nMin As Long
nMax As Long
nPage As Long
nPos As Long
nTrackPos As Long
End Type

Private Const SB_VERT = 1
Private Const SIF_PAGE = &H2
Private Const EM_LINELENGTH = &HC1
Private Const EM_LINEINDEX = &HBB
Private Const EM_GETFIRSTVISIBLELINE = &HCE
Private Const EM_GETLINECOUNT = &HBA


Private Sub Form_Load()
Dim Str As String
Dim i As Integer

Str = "第0行"
For i = 1 To 99
Str = Str & vbCrLf & "第" & i & "行"
Next i
Text1.Text = Str
End Sub

Private Sub Command1_Click()
Dim LineNo1 As Long, LineNo2 As Long
Dim CharIndex1 As Long, CharIndex2 As Long
Dim Length As Long
Dim SI As SCROLLINFO
Dim arr() As Byte, src() As Byte

'取得垂直滚动条的nPage值
SI.cbSize = Len(SI)
SI.fMask = SIF_PAGE
Call GetScrollInfo(Text1.hWnd, SB_VERT, SI)

'可见的第一行的行号
LineNo1 = SendMessage(Text1.hWnd, EM_GETFIRSTVISIBLELINE, ByVal 0&, ByVal 0&)
'可见的第一个字符的位置
CharIndex1 = SendMessage(Text1.hWnd, EM_LINEINDEX, LineNo1, ByVal 0&)

'可见的最后一行的行号
If SI.nPage > 0 Then
LineNo2 = LineNo1 + SI.nPage - 1
Else
LineNo2 = SendMessage(Text1.hWnd, EM_GETLINECOUNT, ByVal 0&, ByVal 0&) - 1
End If
'可见的最后一个字符的位置
CharIndex2 = SendMessage(Text1.hWnd, EM_LINEINDEX, LineNo2, ByVal 0&)
Length = SendMessage(Text1.hWnd, EM_LINELENGTH, CharIndex2, ByVal 0&)
CharIndex2 = CharIndex2 + Length

Debug.Print "可见的第一行的行号:"; LineNo1
Debug.Print "可见的第一个字的位置:"; CharIndex1
Debug.Print "可见的最后一行的行号:"; LineNo2
Debug.Print "可见的最后一个字的位置:"; CharIndex2
Debug.Print

'处理中文
src = StrConv(Text1.Text, vbFromUnicode)
ReDim arr(CharIndex2 - CharIndex1) As Byte
Call CopyMemory(arr(0), src(CharIndex1), CharIndex2 - CharIndex1)
MsgBox StrConv(arr, vbUnicode)
End Sub

junwhj 2003-05-20
  • 打赏
  • 举报
 回复
Option Explicit

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 Declare Function GetScrollInfo Lib "user32" _
(ByVal hWnd As Long, _
ByVal n As Long, _
lpScrollInfo As SCROLLINFO) As Long

Private Type SCROLLINFO
cbSize As Long
fMask As Long
nMin As Long
nMax As Long
nPage As Long
nPos As Long
nTrackPos As Long
End Type

Private Const SB_VERT = 1
Private Const SIF_PAGE = &H2
Private Const EM_LINELENGTH = &HC1
Private Const EM_LINEINDEX = &HBB
Private Const EM_GETFIRSTVISIBLELINE = &HCE


Private Sub Form_Load()
Dim Str As String
Dim I As Integer

Str = "Line0"
For I = 1 To 99
Str = Str & vbCrLf & "Line" & I
Next I
Text1.Text = Str
End Sub

Private Sub Command1_Click()
Dim LineNo1 As Long, LineNo2 As Long
Dim CharIndex1 As Long, CharIndex2 As Long
Dim Length As Long
Dim SI As SCROLLINFO

'取得垂直滚动条的nPage值
SI.cbSize = Len(SI)
SI.fMask = SIF_PAGE
Call GetScrollInfo(Text1.hWnd, SB_VERT, SI)

'可见的第一行的行号
LineNo1 = SendMessage(Text1.hWnd, EM_GETFIRSTVISIBLELINE, ByVal 0&, ByVal 0&)
'可见的第一个字符的位置
CharIndex1 = SendMessage(Text1.hWnd, EM_LINEINDEX, LineNo1, ByVal 0&)

'可见的最后一行的行号
LineNo2 = LineNo1 + SI.nPage - 1
'可见的最后一个字符的位置 + 1
CharIndex2 = SendMessage(Text1.hWnd, EM_LINEINDEX, LineNo2, ByVal 0&)
Length = SendMessage(Text1.hWnd, EM_LINELENGTH, CharIndex2, ByVal 0&)
CharIndex2 = CharIndex2 + Length

Debug.Print "可见的第一行的行号:"; LineNo1
Debug.Print "可见的第一个字的位置:"; CharIndex1
Debug.Print "可见的最后一行的行号:"; LineNo2
Debug.Print "可见的最后一个字的位置:"; CharIndex2
Debug.Print
End Sub

boywang 2003-05-20
  • 打赏
  • 举报
 回复
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 Const EM_GETFIRSTVISIBLELINE = &HCE
Public Property Get GetFirstLineVisible() As Long
GetFirstLineVisible = SendMessage(rtfMain.hwnd, EM_GETFIRSTVISIBLELINE, 0&, 0&)
End Property
深渊的水影 2003-05-20
  • 打赏
  • 举报
 回复
gz
rainstormmaster 2003-05-20
  • 打赏
  • 举报
 回复
先通过SendMessage函数发送EM_GETFIRSTVISIBLELINE消息可以获得文本框中第一个可见行的行号。然后用SendMessage函数发送EM_GETRECT和WM_GETFONT分别得到文本内部格式化矩形的大小（很容易）和文本所用字体的高度（稍麻烦），进而通过简单相除得到文本框有多少行可见，剩下的就是你根据需要计算了。（实在不会，可给我发站内短信）
Maconel 2003-05-20
  • 打赏
  • 举报
 回复
gz
Rozre 2003-05-20
  • 打赏
  • 举报
 回复
up
zjcxc 2003-05-20
  • 打赏
  • 举报
 回复
好像看见过用API函数可以
My97DatePicker文件包和使用例子
解压后，将这个文件夹放到项目某个目录... <asp:TextBox ID="tbSJ" Font-Size="Medium" runat="server" Width="145px" class="Wdate" onFocus="new WdatePicker(this,'%Y-%M-%D %h:%m',true,'default')"></asp:TextBox>
My97DatePicker文件包
My97DatePicker文件包，解压后，将这个... <asp:TextBox ID="tbSJ" Font-Size="Medium" runat="server" Width="145px" class="Wdate" onFocus="new WdatePicker(this,'%Y-%M-%D %h:%m',true,'default')"></asp:TextBox>
排列组合验证（15选6）V1.02-20200420-2109.7z
20200420使用VB6.0求15选6的全组合数（解决定长字符串可包含 1 到大约 64K的问题） 最近需要求组合数（买双色球生成号码用^_） 以前在大学专门学习过VB6.0，今后会迁移到VC6.0。 预计会在2020.5.1强化一下MFC，就...
repeater的简单使用
<asp:TextBox ID="TextBox1" runat="server" Text='<%#Eval("EmployeeName") %>' Width="100"></asp:TextBox> <asp:Label ID="Label3" runat="server" Text='<%#Eval("Password") %>'></asp:Label></td> ...
birt 日历控件已经实现 。资源包括：Calendar.js ，具体实现步骤：操作步骤.txt 。
birt 日历控件已经实现 。 1、首先需要引入一个Calendar.js脚本，将此脚本放置于WebRoot>webcontent>birt>ajax>utility下 2、先在FramesetFragment.jsp中对梅花雨控件进行引用. ...（希望有好的方法能解决这个问题）
VB基础类

7,762

社区成员

197,608

社区内容

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章