VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "Richtx32.ocx"
Begin VB.Form aimChatRoom 
   Caption         =   "Chat Room"
   ClientHeight    =   4575
   ClientLeft      =   2790
   ClientTop       =   2295
   ClientWidth     =   7695
   Icon            =   "aimChatRoom.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   4575
   ScaleWidth      =   7695
   Begin VB.Timer Timeout 
      Enabled         =   0   'False
      Interval        =   5000
      Left            =   6960
      Top             =   4200
   End
   Begin VB.TextBox TextBox1 
      Height          =   3135
      Left            =   120
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   7
      Top             =   120
      Width           =   5415
   End
   Begin VB.ListBox lstNames 
      Height          =   2535
      Left            =   5640
      Style           =   1  'Checkbox
      TabIndex        =   6
      Top             =   360
      Width           =   1935
   End
   Begin VB.CommandButton cmdSend 
      Caption         =   "Send"
      Height          =   495
      Left            =   5400
      TabIndex        =   1
      Top             =   3360
      Width           =   615
   End
   Begin VB.CommandButton cmdRemoteControl 
      Caption         =   "Remote Control"
      Height          =   375
      Left            =   6120
      TabIndex        =   3
      ToolTipText     =   "Start the Remote Controller, which will start an online session with the current user"
      Top             =   3720
      Width           =   1455
   End
   Begin VB.CommandButton cmdInvite 
      Caption         =   "Send Invitation"
      Height          =   375
      Left            =   6120
      TabIndex        =   2
      ToolTipText     =   "Start the Remote Controller, which will start an online session with the current user"
      Top             =   3240
      Width           =   1455
   End
   Begin RichTextLib.RichTextBox rtfSend 
      Height          =   615
      Left            =   120
      TabIndex        =   0
      Top             =   3360
      Width           =   5175
      _ExtentX        =   9128
      _ExtentY        =   1085
      _Version        =   393217
      ScrollBars      =   2
      DisableNoScroll =   -1  'True
      AutoVerbMenu    =   -1  'True
      TextRTF         =   $"aimChatRoom.frx":08CA
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Arial"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.Label Label1 
      Caption         =   $"aimChatRoom.frx":0941
      Height          =   375
      Left            =   120
      TabIndex        =   5
      Top             =   4080
      Width           =   5775
   End
   Begin VB.Label lblPeople 
      AutoSize        =   -1  'True
      Caption         =   "0 People"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Left            =   5640
      TabIndex        =   4
      Top             =   120
      Width           =   765
   End
End
Attribute VB_Name = "aimChatRoom"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'AIM code originally by
'Chad J. Cox (of DosFX) and Tom Grimshaw
'
'code modified by FollowTheWatch55 for VH

Option Explicit
Private PrevLen As Long

Private Sub cmdInvite_Click()
Dim NewInvite As New aimInvite
NewInvite.txtRoom.Text = Me.Caption
NewInvite.FormIndex = FormByHWnd(Me.hwnd)
NewInvite.Show
End Sub

Private Sub cmdRemoteControl_Click()
ClientSN = Me.Tag
RoomID = Me.Tag
ChatName = Me.Caption
ChatRoom = True
frmRemoteList.ConnectCount = 0
frmRemoteList.Show
End Sub

Private Sub cmdSend_Click()
    If rtfSend.Text <> "" And aimSignOn.wskAIM.State = sckConnected Then
      Call SendProc(2, "toc_chat_send " & Me.Tag & " " & Chr(34) & Normalize("<HTML>" & rtfSend.Text & "</HTML>") & Chr(34) & Chr(0))
      rtfSend.Text = ""
      rtfSend.SetFocus
    End If
End Sub

Private Sub Form_Load()
  Me.Left = (ScreenX / 2) - (Me.Width / 2)
  Me.Top = (ScreenY / 2) - (Me.Height / 2)
End Sub

Private Sub Form_Resize()
  If Me.WindowState <> 1 Then
    If Me.Width < 7815 Then Me.Width = 7815
    If Me.Height < 4980 Then Me.Height = 4980
    TextBox1.Width = Me.Width - 2400
    TextBox1.Height = Me.Height - 1845
    lblPeople.Left = Me.Width - 2175
    lstNames.Left = Me.Width - 2175
    lstNames.Height = Me.Height - 2325
    rtfSend.Width = Me.Width - 2640
    rtfSend.Top = Me.Height - 1620
    cmdSend.Left = Me.Width - 2415
    cmdSend.Top = Me.Height - 1620
    Label1.Top = Me.Height - 900
    cmdInvite.Left = Me.Width - 1695
    cmdInvite.Top = Me.Height - 1740
    cmdRemoteControl.Left = cmdInvite.Left
    cmdRemoteControl.Top = Me.Height - 1260
  End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Call SendProc(2, "toc_chat_leave " & Chr(34) & Me.Tag & Chr(34) & Chr(0))
End Sub

Private Sub lstNames_Click()
If SynthSpeech = True And UseSAPI5 = False And frmSession.chkEnableChar.Value = 1 And CharacterFile = "" Then MsgBox "Please choose a character file", vbOKOnly + vbInformation, "Virtual Hypnotist": lstNames.Selected(lstNames.ListIndex) = False: Exit Sub
If frmSession.chkEnableVideo.Value = 1 And VideoFile = "" Then MsgBox "Please choose a video file", vbOKOnly + vbInformation, "Virtual Hypnotist": lstNames.Selected(lstNames.ListIndex) = False: Exit Sub
If frmSession.chkEnableSubliminals.Value = 1 And SubliminalsFile = "" Then MsgBox "Please choose a subliminals file", vbOKOnly + vbInformation, "Virtual Hypnotist": lstNames.Selected(lstNames.ListIndex) = False: Exit Sub
If frmSession.chkEnableAudio.Value = 1 And AudioFile = "" Then MsgBox "Please choose an audio file", vbOKOnly + vbInformation, "Virtual Hypnotist": lstNames.Selected(lstNames.ListIndex) = False: Exit Sub
If frmSession.chkEnableCustom.Value = 1 And frmSession.txtCustomAudio.Text = "" Then MsgBox "Please choose a custom audio file by clicking the Session Types button", vbOKOnly + vbInformation, "Virtual Hypnotist": lstNames.Selected(lstNames.ListIndex) = False: Exit Sub

Dim I As Integer
If lstNames.Selected(lstNames.ListIndex) = True Then
    For I = 0 To lstNames.ListCount - 1
        If I <> lstNames.ListIndex Then lstNames.Selected(I) = False
    Next I
    ServerSN = lstNames.List(lstNames.ListIndex)
    ChatRoom = True
    RoomID = Me.Tag
    
    'notify server with ping
    TextBox1.Text = TextBox1.Text + "*** Contacting server " + ServerSN + "..." + vbCrLf
    If aimSignOn.wskAIM.State = sckConnected Then Call SendProc(2, "toc_chat_send " & Me.Tag & " " & Chr(34) & "<HTML>" & " vhcmd <ping> " + ServerSN + " /vhcmd " & "</HTML>" & Chr(34) & Chr(0))
    Timeout.Enabled = True
Else
    'notify server of drop
    TextBox1.Text = TextBox1.Text + "*** Dropping connection with " + ServerSN + vbCrLf
    If aimSignOn.wskAIM.State = sckConnected Then Call SendProc(2, "toc_chat_send " & Me.Tag & " " & Chr(34) & "<HTML>" & " vhcmd <drop> " + ServerSN + " /vhcmd " & "</HTML>" & Chr(34) & Chr(0))
    ServerSN = ""
    RoomID = ""
    InSession = False
    ChatRoom = False
End If
End Sub

Private Sub lstNames_DblClick()

Dim I As Integer
If lstNames.Selected(lstNames.ListIndex) = True Then
    For I = 0 To lstNames.ListCount - 1
        If I <> lstNames.ListIndex And lstNames.Selected(I) = True Then lstNames.Selected(lstNames.ListIndex) = False
    Next I
End If

  Dim lngFormIndex As Long
  If lstNames.ListIndex > -1 Then
    lngFormIndex& = FormByTag(LCase$(Replace(lstNames.Text, " ", "")))
    If lngFormIndex& > -1 Then
      Forms(lngFormIndex&).SetFocus
    Else
      Dim frmNewIM As New aimIM
      With frmNewIM
        .Caption = lstNames.Text
        .Tag = LCase$(Replace(lstNames.Text, " ", ""))
        .Show
      End With
    End If
  End If
End Sub

Private Sub rtfSend_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    Call cmdSend_Click
    KeyAscii = 0
End If
End Sub

Private Sub TextBox1_Change()
TextBox1.SelStart = PrevLen
TextBox1.SelLength = 0
PrevLen = Len(TextBox1.Text)
End Sub

Private Sub Timeout_Timer()
Timeout.Enabled = False
Dim I As Integer
If lstNames.Selected(lstNames.ListIndex) = True Then lstNames.Selected(lstNames.ListIndex) = False

TextBox1.Text = TextBox1.Text + "*** Server did not respond" + vbCrLf
End Sub

Public Sub ClearList()
Dim I As Integer
For I = 0 To lstNames.ListCount - 1
    lstNames.Selected(I) = False
Next I
End Sub
