Create a new module and paste this source code into it. Change the name of the module to basPublish. If you have any questions, email us at help@codeoftheweek.com
'----------------------------------------------------------------------
'
' Module Name: cMultilineTextBox
' Written By: C&D Programming Corp.
' Create Date: 11/99
' Copyright: Copyright 1999 by C&D Programming Corp. Source
' code may not be reproduced except for use in a
' compiled executable. All rights reserved. If
' you would like to reprint any or all of this
' code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
'
' To use this class you must set the TextBoxControl property before
' using any of the properties.
'
'
'
Option Explicit
'
' These are all the documented edit box messages
' Several of them are unecessary since VB has built-in
' properties for managing things like password characters
'
' We have included all of them here for completeness
'
Private Const EM_EMPTYUNDOBUFFER = &HCD
Private Const EM_CANUNDO = &HC6
Private Const EM_UNDO = &HC7
Private Const EM_GETMODIFY = &HB8
Private Const EM_SETMODIFY = &HB9
Private Const EM_FMTLINES = &HC8
Private Const EM_GETFIRSTVISIBLELINE = &HCE
Private Const EM_GETHANDLE = &HBD
Private Const EM_GETLINE = &HC4
Private Const EM_GETLINECOUNT = &HBA
Private Const EM_GETPASSWORDCHAR = &HD2
Private Const EM_GETRECT = &HB2
Private Const EM_GETSEL = &HB0
Private Const EM_GETTHUMB = &HBE
Private Const EM_GETWORDBREAKPROC = &HD1
Private Const EM_LIMITTEXT = &HC5
Private Const EM_LINEFROMCHAR = &HC9
Private Const EM_LINEINDEX = &HBB
Private Const EM_LINELENGTH = &HC1
Private Const EM_LINESCROLL = &HB6
Private Const EM_REPLACESEL = &HC2
Private Const EM_SCROLL = &HB5
Private Const EM_SCROLLCARET = &HB7
Private Const EM_SETHANDLE = &HBC
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const EM_SETREADONLY = &HCF
Private Const EM_SETRECT = &HB3
Private Const EM_SETRECTNP = &HB4
Private Const EM_SETSEL = &HB1
Private Const EM_SETTABSTOPS = &HCB
Private Const EM_SETWORDBREAKPROC = &HD0
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 mTextBox As TextBox
Public Property Set TextBoxControl(txt As TextBox)
Set mTextBox = txt
End Property
Public Property Get TextBoxControl() As TextBox
Set TextBoxControl = mTextBox
End Property
'
' if scroll bars are turned off and word wrap
' occurs this function counts a word wrapped line as 2 or more lines. You
' can think of this as the number of visible lines in the text box.
'
Public Property Get LineCount() As Long
On Error GoTo Handler
LineCount = SendMessage(TextBoxControl.hwnd, EM_GETLINECOUNT, 0, 0)
Exit Property
Handler:
Err.Raise Err.Number, "LineCount", Err.Description
End Property
'
' line numbers start at one. same rules apply as for the LineCount property.
'
Public Property Get CurrentLineNumber() As Long
On Error GoTo Handler
Dim lLine As Long
lLine = SendMessage(TextBoxControl.hwnd, EM_LINEFROMCHAR, -1, 0)
If lLine = -1 Then
Err.Raise 5, "CurrentLineNumber", "Error retrieving the line number"
End If
CurrentLineNumber = lLine + 1
Exit Property
Handler:
Err.Raise Err.Number, "CurrentLineNumber", Err.Description
End Property
'
' line length is one based.
'
Public Property Get LineLength(Optional ByVal lLineNumber As Long = -1)
On Error GoTo Handler
'If lLineNumber = -1 Then
' lLineNumber = CurrentLineNumber - 1
'End If
LineLength = SendMessage(TextBoxControl.hwnd, EM_LINELENGTH, lLineNumber, 0)
Exit Property
Handler:
Err.Raise Err.Number, "LineLength", Err.Description
End Property
'
' line position is one based.
'
Public Property Get LinePosition(Optional ByVal lLineNumber As Long = -1)
Dim lPos As Long
On Error GoTo Handler
If lLineNumber = -1 Then
lLineNumber = CurrentLineNumber - 1
End If
lPos = SendMessage(TextBoxControl.hwnd, EM_LINEINDEX, lLineNumber, 0)
LinePosition = TextBoxControl.SelStart - lPos + 1
Exit Property
Handler:
Err.Raise Err.Number, "LinePosition", Err.Description
End Property