VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsEmotes"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'{\rtf1\ansi\ansicpg1252\deff0\deftab720{\fonttbl
'                {\f0\fswiss MS Sans Serif;}{\f1\froman\fcharset2 Symbol;}{\f2\fswiss Tahoma;}{\f3\fswiss Tahoma;}{\f4\fswiss MS Sans Serif;}{\f5\fswiss Times New Roman;}{\f6\fswiss\fcharset2 Webdings;}{\f7\fswiss\fcharset2 Wingdings;}{\f8\fswiss System;}
'                                        }
'{\colortbl\red0\green0\blue0;\red128\green255\blue128;\red0\green64\blue0;\red255\green128\blue128;}
'\deflang1033\horzdoc{\*\fchars }{\*\lchars }
'\plain\f5\fs16\cf0 Dev: Hello \par
'\plain\f5\fs16\cf0 Dev:\plain\f7\fs24\cf2\b  DoneTesting
'\plain\f5\fs16\cf0\ul\strike Dev: \par
'\plain\f6\fs22\cf1  JoeShmoe \par

Option Explicit

Private Const m_cNAME As String = "clsEmotes"

'Steping through the graphics
Private nIndex As Long

'Picture swap out array
Private saPicTextRTF() As String

Private Const cRED = 1
Private Const cGREEN = 2
Private Const cBLUE = 3

'Fonts
Private strFonts As String
Private saFontPos() As String
'Colors
Private strColors As String
Private naColPos() As Long
'Messages
Private strTextRTF As String

Public Function Name() As String

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = "clsEmotes.Name"
    'Call WriteProcStart(sRoutineName)
    
    
    Name = "clsEmotes"
    
    
    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Function
Public Function ConvertEmotes(sMsg As String) As String

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".ConvertEmotes"
    Call WriteProcStart(sRoutineName)
        
        
    Dim nValue As Long
    Dim sL As String
    Dim sR As String
    Dim bDoneSwapping As Boolean
    Dim i As Long
    Dim nStart As Long
    Dim sNewMsg As String
    Dim bLeftOk As Boolean
    Dim bRightOk As Boolean
    
    sNewMsg = sMsg
    'bDoneSwapping = False
    
    'Convert in user loaded macros
    For i = 1 To UBound(saPicTextRTF, 2) - 1
    
        nStart = InStr(1, sNewMsg, saPicTextRTF(1, i), vbTextCompare) - 1
        While nStart > -1
                
            'Find out if the characters to the left or right of the text are characters
            If nStart = 0 Then
                bLeftOk = True
            Else
                nValue = Asc(UCase(Mid(sNewMsg, nStart, 1)))
                bLeftOk = (nValue < Asc("A") Or nValue > Asc("Z"))
            End If
            If nStart + Len(saPicTextRTF(1, i)) = Len(sNewMsg) Then
                bRightOk = True
            Else
                nValue = Asc(UCase(Mid(sNewMsg, nStart + Len(saPicTextRTF(1, i)) + 1, 1)))
                bRightOk = (nValue < Asc("A") Or nValue > Asc("Z"))
            End If
                
            'Do we swap this one out?
            If bLeftOk = True And bRightOk = True Then
                sNewMsg = Left(sNewMsg, InStr(nStart + 1, UCase(sNewMsg), UCase(saPicTextRTF(1, i))) - 1) & _
                    saPicTextRTF(2, i) & _
                    Right(sNewMsg, Len(sNewMsg) - InStr(nStart + 1, UCase(sNewMsg), UCase(saPicTextRTF(1, i))) - Len(saPicTextRTF(1, i)) + 1)
            End If
            'Do we loop again?
            nStart = InStr(nStart + 2, sNewMsg, saPicTextRTF(1, i), vbTextCompare) - 1
            If nStart > Len(sNewMsg) Then nStart = -1
        Wend
        
    Next i
    

    'Convert in system power macros
    bDoneSwapping = False
    While bDoneSwapping = False
        bDoneSwapping = True
    
        'Random generator
        If InStr(1, sNewMsg, "[RANDOM") > 0 Then
            sR = Mid(sNewMsg, InStr(1, sNewMsg, "[RANDOM") + 7)
            If InStr(1, sR, "]") > 0 Then
                sL = Left(sR, InStr(1, sR, "]") - 1)
            End If
            If IsNumeric(sL) = True Then
                nValue = Int((CInt(sL) * Rnd) + 1)
                bDoneSwapping = False
                sNewMsg = Left(sNewMsg, InStr(1, sNewMsg, "[RANDOM") - 1) & _
                            nValue & _
                            Mid(sNewMsg, InStr(1, sNewMsg, "[RANDOM") + 7 + InStr(1, sR, "]"))
            End If
        End If

        'Newline insert
        If InStr(1, sNewMsg, "[NEWLINE]") > 0 Then
            bDoneSwapping = False
            sNewMsg = Left(sNewMsg, InStr(1, sNewMsg, "[NEWLINE]") - 1) & _
                        " \par " & _
                        Mid(sNewMsg, InStr(1, sNewMsg, "[NEWLINE]") + 9)
        End If

        'Tab insert
        If InStr(1, sNewMsg, "[TAB]") > 0 Then
            bDoneSwapping = False
            sNewMsg = Left(sNewMsg, InStr(1, sNewMsg, "[TAB]") - 1) & _
                        Chr(9) & _
                        Mid(sNewMsg, InStr(1, sNewMsg, "[TAB]") + 5)
        End If
        
''        'HP insert
''        If InStr(1, sNewMsg, "[MYHP]") > 0 Then
''            bDoneSwapping = False
''            sNewMsg = Left(sNewMsg, InStr(1, sNewMsg, "[MYHP]") - 1) & _
''                        GetPlayer(g_nMyNumber).nHP & _
''                        Mid(sNewMsg, InStr(1, sNewMsg, "[MYHP]") + 6)
''        End If
        
        'Name insert
        If InStr(1, sNewMsg, "[NAME]") > 0 Then
            bDoneSwapping = False
            sNewMsg = Left(sNewMsg, InStr(1, sNewMsg, "[NAME]") - 1) & _
                        GenerateNewName & _
                        Mid(sNewMsg, InStr(1, sNewMsg, "[NAME]") + 6)
        End If
        
    
    Wend
    
    ConvertEmotes = sNewMsg
           
       
    Call WriteProcStop(sRoutineName) ' ConvertEmotes)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Function
Private Sub Class_Initialize()

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".Class_Initialize"
    Call WriteProcStart(sRoutineName)
        
        
    Call LoadEmotes
               
       
    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Sub
Public Sub LoadEmotes()

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".LoadEmotes"
    Call WriteProcStart(sRoutineName)
        
        
    ReDim Preserve naColPos(0 To 4, 0 To 0) As Long
    ReDim Preserve saFontPos(0) As String
    ReDim saPicTextRTF(1 To 4, 1 To 1) As String

    Dim nFreeFIni As Long
    Dim nFreeF As Long
    Dim sEmote As String
    Dim sFileName As String
    Dim sLineIn As String
    Dim sComment
    Dim sChar
    Dim nBrackets As Long

    If Dir(g_cDNDONLINEDIR & "Emotes.ini") <> "" Then
        nFreeFIni = FreeFile
        Open g_cDNDONLINEDIR & "Emotes.ini" For Input As nFreeFIni
    
        While Not EOF(nFreeFIni)
            Input #nFreeFIni, sEmote, sFileName, sComment
                                            
            'Was their actually anything their for this e-mote?
            If Len(Trim(sEmote)) > 0 Or Len(Trim(sFileName)) > 0 Or Len(Trim(sComment)) > 0 Then
            
                'Reset then add the emote
                sLineIn = ""
                sChar = ""
                'Record their comment & conv text
                saPicTextRTF(4, UBound(saPicTextRTF, 2)) = sFileName
                saPicTextRTF(3, UBound(saPicTextRTF, 2)) = sComment
                saPicTextRTF(1, UBound(saPicTextRTF, 2)) = sEmote
                            
                If UCase(Right(sFileName, 4)) = ".TXT" Then
                            'Did we find the graphic file?
                            If Dir(g_cEMOTESDIR & sFileName) <> "" Then
                               
                                nFreeF = FreeFile
                                Open g_cEMOTESDIR & sFileName For Input As #nFreeF
                                    While EOF(nFreeF) = False
                                        Input #nFreeF, sLineIn
                                        saPicTextRTF(2, UBound(saPicTextRTF, 2)) = saPicTextRTF(2, UBound(saPicTextRTF, 2)) & sLineIn
                                    Wend
                                Close #nFreeF
                                
                            End If
                
                ElseIf UCase(Right(sFileName, 4)) = ".RTF" Then
                            'Did we find the graphic file?
                            If Dir(g_cEMOTESDIR & sFileName) <> "" Then
                            
                                nFreeF = FreeFile
                                Open g_cEMOTESDIR & sFileName For Input As #nFreeF
                                  
                                    While EOF(nFreeF) = False And InStr(1, saPicTextRTF(2, UBound(saPicTextRTF, 2)), "\wmetafile") = 0
                                        sChar = ""
                                        sLineIn = ""
                                        nBrackets = 0
                                        
                                        'Read all the header info in
                                        While EOF(nFreeF) = False And InStr(1, sLineIn, "\pict") = 0 'Or InStr(1, sLineIn, "\wmetafile") = 0)
                                            Input #nFreeF, sLineIn
                                        Wend
                                        saPicTextRTF(2, UBound(saPicTextRTF, 2)) = Right(sLineIn, Len(sLineIn) - InStr(1, sLineIn, "{\pict") + 1) & Chr(13) & Chr(10)
                                        
                                        nBrackets = GetBracketCount(saPicTextRTF(2, UBound(saPicTextRTF, 2)))
                                        
                                        'Load in the actual graphic
                                        While EOF(nFreeF) = False And nBrackets > 0 'sChar <> "}"
                                            sChar = StrConv(InputB$(1, nFreeF), vbUnicode)
                                            If sChar = "{" Then
                                                nBrackets = nBrackets + 1
                                            End If
                                            If sChar = "}" Then
                                                nBrackets = nBrackets - 1
                                            End If
                                            
                                            'Finish writting down their picture
                                            saPicTextRTF(2, UBound(saPicTextRTF, 2)) = saPicTextRTF(2, UBound(saPicTextRTF, 2)) & sChar
                                        Wend
                                    
                                        saPicTextRTF(2, UBound(saPicTextRTF, 2)) = "{" & saPicTextRTF(2, UBound(saPicTextRTF, 2)) & "}"
                                    
                                    'End If
                                    Wend
                                    
                                Close #nFreeF
                                
                            End If
                Else
                    saPicTextRTF(2, UBound(saPicTextRTF, 2)) = sFileName
                End If
                                        
                'Check to make sure this is a valid replacement
                If InStr(1, saPicTextRTF(1, UBound(saPicTextRTF, 2)), saPicTextRTF(2, UBound(saPicTextRTF, 2))) > 0 Then
                    'They have the search string in the replace string... infinite loop
                    Call MsgBox("Emote " & sEmote & " is not valid.  The search text is in the replacement text.", vbExclamation, "Emote Load Error")
                    saPicTextRTF(2, UBound(saPicTextRTF, 2)) = "{\b [INVALID]}"
                    
                End If
                
                'Make room in the array for the next element
                ReDim Preserve saPicTextRTF(1 To 4, 1 To UBound(saPicTextRTF, 2) + 1) As String
        
            End If
            
        Wend
        
        Close nFreeFIni
        
    Else
        Call MsgBox("I'm sorry, the Emotes.ini file is not located in your DNDOnline" & _
                      "directory.  No Emotes will be available during this DNDOnline session.", vbCritical + vbOKOnly, "Error Loading Emotes!")
    End If
               
       
    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Sub
Public Function GetBracketCount(sMsg As String) As Long

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".GetBracketCount"
    Call WriteProcStart(sRoutineName)
    
    
    Dim i As Long
    Dim nBCount As Long
    nBCount = 0
    
    For i = 1 To Len(sMsg)
        If Mid(sMsg, i, 1) = "{" Then
            nBCount = nBCount + 1
        ElseIf Mid(sMsg, i, 1) = "}" Then
            nBCount = nBCount - 1
        End If
    Next i
    
    GetBracketCount = nBCount
    

    Call WriteProcStop(sRoutineName) ' GetBracketCount)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Function
Public Sub MoveFirstEmote()

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".MoveFirstEmote"
    Call WriteProcStart(sRoutineName)
    
    
    nIndex = 1
    
    
    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Sub
Public Function GetEmoteIndex() As Long

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".GetEmoteIndex"
    Call WriteProcStart(sRoutineName)
    
    
    GetEmoteIndex = nIndex
    
    
    Call WriteProcStop(sRoutineName) ' GetEmoteIndex)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
        
End Function
Public Function EmoteEOF() As Boolean

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".EmoteEOF"
    Call WriteProcStart(sRoutineName)
    
    
    EmoteEOF = (nIndex < 1 Or nIndex > UBound(saPicTextRTF, 2) - 1)
    
    
    Call WriteProcStop(sRoutineName) ' EmoteEOF)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Function
Public Function Count() As Long

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".Count"
    Call WriteProcStart(sRoutineName)
    
    
    Count = UBound(saPicTextRTF, 2) - 1
    
    
    Call WriteProcStop(sRoutineName) ' Count)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Function
Public Sub MoveNextEmote()

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".MoveNextEmote"
    Call WriteProcStart(sRoutineName)
    
    
    nIndex = nIndex + 1
        
    
    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Sub
Public Function GetEmoteText() As String

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".GetEmoteText"
    Call WriteProcStart(sRoutineName)
    
    
    If EmoteEOF = True Then
        GetEmoteText = "Invalid"
    Else
        GetEmoteText = saPicTextRTF(1, nIndex)
    End If
        
    
    Call WriteProcStop(sRoutineName) ' GetEmoteText)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Function
Public Function GetEmoteGraphic() As String

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".GetEmoteGraphic"
    Call WriteProcStart(sRoutineName)
    
    
    If EmoteEOF = True Then
        GetEmoteGraphic = "Invalid"
    Else
        GetEmoteGraphic = saPicTextRTF(2, nIndex)
    End If
        
    
    Call WriteProcStop(sRoutineName) ' GetEmoteGraphic)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Function
Public Function GetEmoteName() As String

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".GetEmoteName"
    Call WriteProcStart(sRoutineName)
    

    If EmoteEOF = True Then
        GetEmoteName = "Invalid"
    Else
        GetEmoteName = saPicTextRTF(3, nIndex)
    End If
        
    
    Call WriteProcStop(sRoutineName) ' GetEmoteName)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Function
Public Function GetItemEmoteText(nInd As Long) As String

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".GetItemEmoteText"
    Call WriteProcStart(sRoutineName)
    
    
    GetItemEmoteText = saPicTextRTF(1, nInd)
        
    
    Call WriteProcStop(sRoutineName) ' GetItemEmoteText)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Function
Public Function GetItemEmoteGraphic(nInd As Long) As String

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".GetItemEmoteGraphic"
    Call WriteProcStart(sRoutineName)
    
    
    GetItemEmoteGraphic = saPicTextRTF(2, nInd)
        
    
    Call WriteProcStop(sRoutineName) ' GetItemEmoteGraphic)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Function
Public Function GetItemEmoteFileName(nInd As Long) As String

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".GetItemEmoteFileName"
    Call WriteProcStart(sRoutineName)
    
    
    GetItemEmoteFileName = saPicTextRTF(4, nInd)
        
    
    Call WriteProcStop(sRoutineName) ' GetItemEmoteFileName)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Function

Public Function GetItemEmoteName(nInd As Long) As String

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".GetItemEmoteName"
    Call WriteProcStart(sRoutineName)
    
    
    GetItemEmoteName = saPicTextRTF(3, nInd)
        
    
    Call WriteProcStop(sRoutineName) ' GetItemEmoteName)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Function

'Public Sub RTBSetProperties(RTB As RichTextBox, bItalicised As Boolean, nFontColor As Long, sSearch As String, sMsg As String)
'
'    On Error GoTo ErrorHandler
'    Dim sRoutineName As String
'    sRoutineName = m_cNAME & ".RTBSetProperties"
'    Call WriteProcStart(sRoutineName)' RTB.Name, bItalicised, nFontColor, sSearch, sMsg)
'
'
'    Dim nSelStart As Long
'    Dim nSelLen As Long
'    Dim nWhereIn As Long
'
'    nWhereIn = InStr(1, RTB.Text, sMsg) - 1
'
'    '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
'
'
'    Call WriteProcStop(sRoutineName)
'    'Exit the sub... on an error we will jump over this function
'    Exit Sub
'ErrorHandler:
'    call LogErrorToFile(sroutinename & "." & err.description):Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount   ()
'
'End Sub
