Visual Basic > Forms

Limiting the number of lines a MultiLine TextBox can hold

Limiting the number of lines a MultiLine TextBox can hold

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.
'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