VB and VBA Users Source Code: Limiting the number of lines a MultiLine TextBox can hold
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Limiting the number of lines a MultiLine TextBox can hold
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Friday, September 28, 2001
Hits:
873
Category:
Windows API
Article:
The following code demonstrates how to limit the number of lines that can be stored in a multiline textbox. 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 'Purpose : Restricts the number of lines a Multiline textbox can hold. 'Inputs : tbLimit The textbox to check the number of lines. ' lMaxNumLines The maximum number of lines in the textbox. 'Outputs : Returns True if suceeded in flashing the window. 'Author : Andrew Baker 'Date : 28/Sep/2001 'Notes : The TextBox must be a MultiLine textbox 'Example : Would use typically called from textbox change event: 'Private Sub Text1_Change() ' 'Limits the number of line to 2 ' TextBoxLimitLines Text1, 2 ' Const c_lngMaxLines As Long = 100 'End Sub Function TextBoxLimitLines(tbLimit As TextBox, lMaxNumLines As Long) As Boolean Dim lLength As Long, sText As String Const EM_GETLINECOUNT = &HBA, EM_LINELENGTH = &HC1 Const EM_SETSEL = &HB1, EM_REPLACESEL = &HC2 On Error GoTo ErrFailed With tbLimit 'Loop until the number of lines is less than or equal to 'the maximum number of lines Do If SendMessage(.hwnd, EM_GETLINECOUNT, 0&, ByVal 0&) > lMaxNumLines Then sText = .Text If Right$(sText, 2) = vbNewLine Then 'Delete a line feed .Text = Left$(sText, Len(sText) - 2) .SelStart = Len(sText) - 2 Else 'Delete a character .Text = Left$(sText, Len(sText) - 1) .SelStart = Len(sText) - 1 End If Else 'Number of lines is not exceeded Exit Do End If Loop End With TextBoxLimitLines = True Exit Function ErrFailed: Debug.Print "Error in TextBoxLimitLines: " & Err.Description TextBoxLimitLines = False End Function
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
