Attribute VB_Name = "RTBCode"
Option Explicit

Private Const cFRMNAME = "RTBCode"

'This is a central point for adding messages.  All font interpretation
'and scroll changes are handled here
Public Sub RTBAddMessage(RTB As RichTextBox, sFontInfo As String, sFontName As String, nFontColor As Long, sMsg As String)

    ''''''On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = cFRMNAME & ".RTBAddMessage"
    
    Dim bWasAtEnd As Boolean
    Dim nStartSel As Long
    Dim nNewStartSel As Long
    Dim strMsg As String
    Dim sFinalFontOpt As String
    Dim sFinalFontName As String
    Dim nFinalFontColor As Long

    'Mark down the status BEFORE adding things
    bWasAtEnd = (RTB.SelStart = Len(RTB.Text))
    nStartSel = RTB.SelStart

    Dim sName As String
    Dim sRestMsg As String
    Dim sFOptions As String
    If InStr(1, sMsg, ":") > 0 Then
        sName = Left(sMsg, InStr(1, sMsg, ":") + 1)
        sFOptions = BoolToInt(g_bNameFontBold) & BoolToInt(g_bNameFontItalic) & _
                Pad(g_nNameFontSize, " ", 2) & BoolToInt(g_bNameFontStrikeThru) & _
                BoolToInt(g_bNameFontUnderline)

        'Call g_oRTBMessages.AddMessage(sFOptions, g_sNameFontName, g_nNameFontColor, sName, False)
        sRestMsg = Right(sMsg, Len(sMsg) - InStr(1, sMsg, ":") - 1)
    Else
        sRestMsg = sMsg
        sFOptions = g_sDefOptions
    End If

    RTB.SelStart = Len(RTB.Text)
    RTB.SelRTF = g_oRTBMessages.FormatForInsert(sFOptions, g_sNameFontName, g_nNameFontColor, sName, True)

    RTB.SelStart = Len(RTB.Text)
    
    If g_bSupressColors = True Then
        nFinalFontColor = g_nDefColor
    Else
        nFinalFontColor = nFontColor
    End If
    If g_bSupressFonts = True Then
        sFinalFontOpt = g_sDefOptions
        sFinalFontName = g_sDefFont
    Else
        sFinalFontOpt = sFontInfo
        sFinalFontName = sFontName
    End If
    RTB.SelRTF = g_oRTBMessages.FormatForInsert(sFinalFontOpt, sFinalFontName, nFinalFontColor, sRestMsg, (Not (Len(sName) > 0)))
        

    While RTBNumberOfLines(RTB) > g_nLinesInChat
        Call RTBEraseFirstLine(RTB)
    Wend


    'Were they at the bottom of the list?
    If bWasAtEnd = True Then
        'Keep them there!
        RTB.SelStart = Len(RTB.Text)
    'Otherwise put them back where they were
    Else
        'Keep their selected text where it was
        RTB.SelStart = nStartSel
    End If
    
    
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call ErrorTrapper(sRoutineName)
   
End Sub

Public Function RTBNumberOfLines(RTB As RichTextBox)

    ''''''On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = cFRMNAME & ".RTBNumberOfLines"
    
    
    Dim sText As String
    Dim nCount As Long
    Dim i As Long
    sText = RTB.Text
    i = 1
    
    While InStr(i, sText, Chr(13)) > 0
        i = InStr(i, sText, Chr(13)) + 1
        nCount = nCount + 1
    Wend
    
    RTBNumberOfLines = nCount + 1


    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call ErrorTrapper(sRoutineName)
   
End Function
Public Sub RTBSetText(RTB As RichTextBox, sFontInfo As String, sFontName As String, nFontColor As Long, sSearch As String, sMsg As String)

    ''''''On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = cFRMNAME & ".RTBSetText"
    
    
    Dim nSelStart As Long
    Dim nSelLen As Long
    Dim nWhereIn As Long
    
    nWhereIn = InStr(1, RTB.Text, sMsg)
    
    'Is this name italisized already?
    If nWhereIn > 0 Then
        nSelStart = RTB.SelStart
        nSelLen = RTB.SelLength
    
        RTB.SelStart = nWhereIn
        RTB.SelLength = Len(sSearch)
        
        RTB.SelBold = (Mid(sFontInfo, 1, 1) = 1)
        RTB.SelItalic = (Mid(sFontInfo, 2, 1) = 1)
        RTB.SelFontSize = Mid(sFontInfo, 3, 2)
        RTB.SelStrikeThru = (Mid(sFontInfo, 5, 1) = 1)
        RTB.SelUnderline = (Mid(sFontInfo, 6, 1) = 1)
        RTB.SelFontName = sFontName
        RTB.SelColor = nFontColor
        
        RTB.SelStart = nSelStart
        RTB.SelLength = nSelLen
    End If
    

    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call ErrorTrapper(sRoutineName)

End Sub
Public Sub RTBSetColorItalicised(RTB As RichTextBox, bItalicised As Boolean, nFontColor As Long, sSearch As String, sMsg As String)

    ''''''On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = cFRMNAME & ".RTBSetText"
    
    
    Dim nSelStart As Long
    Dim nSelLen As Long
    Dim nWhereIn As Long
    
    nWhereIn = InStr(1, RTB.Text, sMsg)
    
    'Is this name italisized already?
    If nWhereIn > 0 Then
        nSelStart = RTB.SelStart
        nSelLen = RTB.SelLength
    
        RTB.SelStart = nWhereIn
        RTB.SelLength = Len(sSearch)
        
        RTB.SelItalic = bItalicised
        RTB.SelColor = nFontColor
        
        RTB.SelStart = nSelStart
        RTB.SelLength = nSelLen
    End If
    

    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call ErrorTrapper(sRoutineName)

End Sub
Public Sub RTBAddNewMessage(RTB As RichTextBox, sMsg As String)

    ''''''On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = cFRMNAME & ".RTBAddNewMessage"
    
    
    RTB.TextRTF = Left(RTB.TextRTF, Len(RTB.TextRTF) - 9) & _
                    sMsg & " \par " & Right(RTB.TextRTF, 9)
   

    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call ErrorTrapper(sRoutineName)
           
End Sub
Public Sub RTBRemoveMessage(RTB As RichTextBox, sMsg As String)

    ''''''On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = cFRMNAME & ".RTBRemoveMessage"
    
    
    Dim nSelStart As Long
    Dim nSelLen As Long
    Dim nWhereIn As Long
    
    'Save where their name is
    nWhereIn = InStr(1, RTB.Text, sMsg)

    If nWhereIn > 0 Then
        nSelStart = RTB.SelStart
        nSelLen = RTB.SelLength
    
        RTB.SelStart = nWhereIn - 1
        RTB.SelLength = Len(sMsg)
        RTB.SelText = ""
        
        RTB.SelStart = nSelStart
        RTB.SelLength = nSelLen
    End If
   

    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call ErrorTrapper(sRoutineName)
                    
End Sub
Public Sub RTBEraseFirstLine(RTB As RichTextBox)

    ''''''On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = cFRMNAME & ".RTBEraseFirstLine"
    
    
    RTB.SelStart = 0
    RTB.SelLength = InStr(1, RTB.Text, Chr(10)) + 2
    RTB.SelText = ""
    
   
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call ErrorTrapper(sRoutineName)
    
End Sub
