Docy

'  Run-time error '91': 
'  Object variable or With block variable not set
'
'
'>>> HTML CONTROL <<<
'
'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
'<html xmlns="http://www.w3.org/1999/xhtml">
'<head>
'<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
'<title>Whisper Control</title>
'</head>
'<body>
'<div id="chatwhisper"></div>
'</body>
'</html>
'

Option Explicit

Public PvtWindows() As New frmWhisper
Public PvtWindowState() As WichPvt

Type WichPvt
    name As String
    deleted As Boolean
End Type


Function FreePvtIndex() As Integer
    On Error GoTo Errhandler
    Dim i As Integer
    Dim ArrayCount As Integer
    ArrayCount = UBound(PvtWindows)
    
    For i = 1 To ArrayCount
        If PvtWindowState(i).deleted Then
            FreePvtIndex = i
            PvtWindowState(i).deleted = False
            Exit Function
        End If
    Next

    ReDim Preserve PvtWindows(ArrayCount + 1)
    ReDim Preserve PvtWindowState(ArrayCount + 1)
    FreePvtIndex = UBound(PvtWindows)

Exit Function
Errhandler:
    If VBA.Information.Err.Number = 9 Then
      Resume Next
    ElseIf VBA.Information.Err.Number > 400 Then
        Resume Next
    Else
        MsgBox "Error: " & vbCrLf & VBA.Information.Err.Description & vbCrLf & "Source: " & VBA.Information.Err.Source & vbCrLf & "Number: " & VBA.Information.Err.Number
    End If
End Function

Function GetPvtIndex(sNick As String) As Integer
    Dim i As Integer
    Dim ArrayCount As Integer
    ArrayCount = UBound(PvtWindows)
    For i = 1 To ArrayCount
        If Not PvtWindowState(i).deleted Then
            If PvtWindows(i).Caption = sNick Then
                GetPvtIndex = i
                Exit For
            End If
        End If
    Next

End Function

Function DoesPvtExists(sNick As String) As Boolean
On Error GoTo Errhandler
    Dim i As Integer
    Dim ArrayCount As Integer
    DoesPvtExists = False
    ArrayCount = UBound(PvtWindows)

    For i = 1 To ArrayCount
        If Not PvtWindowState(i).deleted Then
            If PvtWindows(i).Caption = sNick Then
                DoesPvtExists = True
                Exit For
            End If
        End If
    Next
    
Exit Function
Errhandler:
    If VBA.Information.Err = 9 Then
        Resume Next
    End If
End Function

Public Sub UserWhisper(tempNick As String, Optional sMsgs As String)
    Dim PvtStart As String, PvtEnd As String, PvtIndex As Integer
    If tempNick = sMyNick Then Exit Sub
    If sMsgs <> "" Then
        sMsgs = Mid(sMsgs, 3)
        sMsgs = Mid(sMsgs, InStr(1, sMsgs, ":", 1) + 1)
        sMsgs = Replace(sMsgs, vbCrLf, "")
    End If

    If Not DoesPvtExists(tempNick) Then
        PvtIndex = FreePvtIndex
        Call PvtWindows(PvtIndex).SetEventObject(frmMain)
        PvtWindows(PvtIndex).Tag = PvtIndex
        
        'test solution start
            Dim sApppChanger As String
            sApppChanger = "file:///" & Replace$(App.Path, "\", "/") & "/whisper.html"
        'test solution end
        
        PvtWindows(PvtIndex).IEtxtWhisper.Navigate sApppChanger
        Call PvtWindows(PvtIndex).Chatter(tempNick)
        If sMsgs <> "" Then
            PvtStart = "<font>"
            If tempNick <> "" Then
                PvtStart = "<b>" & sMyNick & ":</b>&nbsp;"
            End If
            PvtEnd = "</font>"
            PvtWindows(PvtIndex).IEtxtWhisper.Document.getElementById("chatwhisper").innerHTML = PvtWindows(PvtIndex).IEtxtWhisper.Document.getElementById("chatwhisper").innerHTML & PvtStart & sMsgs & PvtEnd & "<br />"
            PvtWindows(PvtIndex).IEtxtWhisper.Document.ParentWindow.ScrollBy 0, 50
        End If
        PvtWindows(PvtIndex).Show 'vbModal, Me
        PvtWindowState(PvtIndex).name = tempNick
        PvtWindows(PvtIndex).WindowState = vbNormal
    Else
        PvtWindows(GetPvtIndex(tempNick)).WindowState = vbNormal
        If sMsgs <> "" Then
            PvtStart = "<font>"
            If tempNick <> "" Then
                PvtStart = "<b>" & sMyNick & ":</b>&nbsp;"
            End If
            PvtEnd = "</font>"
            PvtWindows(PvtIndex).IEtxtWhisper.getElementById("chatwhisper").innerHTML = PvtWindows(PvtIndex).IEtxtWhisper.Document.getElementById("chatwhisper").innerHTML & PvtStart & sMsgs & PvtEnd & "<br />"
            PvtWindows(PvtIndex).IEtxtWhisper.getElementById("chatwhisper").innerHTML
        End If
    End If
End Sub