by LGans (2 Submissions)
Category: Custom Controls/Forms/Menus
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Mon 4th September 2000
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Rich Text Box Line Number and Characters
API Declarations
Name : CTextBoxEx.cls
Option Explicit
'The Functionality is Copied !!
'For people who are obsessed with editors
'Please tell me how to get the Column No (within the line index) the Caret is in !!
'(ie) If I am in Line no . 5 and the line length is 10 chars , If i press the
'arrow key the col.no within that particular row should vary (according to my keystrokes)
'As I am just 2 weeks old in VB!! I am not very sure abt event handling
'API function declarations
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 ReleaseCapture Lib "user32" () As Long
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
'Window messages sent to the textbox
Private Const EM_CANUNDO = &HC6
Private Const EM_GETFIRSTVISIBLELINE = &HCE
Private Const EM_GETLINE = &HC4
Private Const EM_GETLINECOUNT = &HBA
Private Const EM_GETMODIFY = &HB8
Private Const EM_LINEFROMCHAR = &HC9
Private Const EM_CHARFROMPOS = &HD7
'Private Const EM_POSFROMCHAR
Private Const EM_LINEINDEX = &HBB
Private Const EM_LINELENGTH = &HC1
Private Const EM_SETMODIFY = &HB9
Private Const EM_UNDO = &HC7
Private Const WM_VSCROLL = &H115
Private Const SB_LINEUP = 0
Private Const SB_LINEDOWN = 1
'local variables to hold property values - Inherit Properties
Private WithEvents mtxtBox As RichTextBox
Private Type POINTAPI
X As Long
Y As Long
End Type
Dim lRow As Long, lCol As Long, aLine, total As String
Dim cpos, lineno, curline As Long
Private pt As POINTAPI
Private mhWnd As Long 'the hWnd of the textbox
Public Function LineLen(CharPos As Long)
'Returns the number of character of the line that
'contains the character position specified by CharPos
LineLen = SendMessage(mhWnd, EM_LINELENGTH, CharPos, 0&)
End Function
Public Function GetLineFromChar(CharPos As Long) As Long
'Returns the zero based line number of the line
'that contains the specified character index
GetLineFromChar = SendMessage(mhWnd, EM_LINEFROMCHAR, CharPos, 0&)
End Function
Public Function LineCount() As Long
'Returns the number of lines in the textbox
LineCount = SendMessage(mhWnd, EM_GETLINECOUNT, 0&, 0&)
End Function
Public Sub capture()
'Call SetCapture(mhWnd)
End Sub
Public Sub release()
Call ReleaseCapture
End Sub
Public Function TopLine() As Long
'Returns the zero based line index of the first
'visible line in a multiline textbox.
'Or the position of the first visible character
'in a none multiline textbox
TopLine = SendMessage(mhWnd, EM_GETFIRSTVISIBLELINE, 0&, 0&)
End Function
Public Function CanUndo() As Boolean
'Returns True if it's possible to make an Undo
Dim lngRetVal As Long
lngRetVal = SendMessage(mhWnd, EM_CANUNDO, 0&, 0&)
CanUndo = (lngRetVal <> 0)
End Function
Public Function GetCharFromLine(LineIndex As Long)
'Returns the index of the first character of the line
'check if LineIndex is valid
If LineIndex < LineCount Then
GetCharFromLine = SendMessage(mhWnd, EM_LINEINDEX, LineIndex, 0&)
End If
End Function
Public Function GetLine(LineIndex As Long) As String
'Returns the text contained at the specified line
Dim bArray() As Byte 'byte array to contain the returned string
Dim lngLineLen As Long 'the length of the line
Dim sRetVal As String 'the return value
'Check the LineIndex value
If LineIndex >= LineCount Then
GetLine = ""
Exit Function
End If
'get the length of the line
lngLineLen = LineLen(GetCharFromLine(LineIndex))
If lngLineLen < 1 Then
GetLine = ""
Exit Function
End If
ReDim bArray(lngLineLen + 1)
'The first word of the array must contain
'the length of the line to return
bArray(0) = lngLineLen And 255
bArray(1) = lngLineLen \ 256
SendMessage mhWnd, EM_GETLINE, LineIndex, bArray(0)
'convert the byte array into a string
sRetVal = Left(StrConv(bArray, vbUnicode), lngLineLen)
'return the string
GetLine = sRetVal
End Function
Public Sub Undo()
VBcoders
RTB Name : ta
Private txtBox As CTextBoxEx
Private Sub Form_Load()
Set txtBox = New CTextBoxEx
Set txtBox.TextBox = ta
Call txtBox.capture
End Sub