frmChatTool.frm

 VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "richtx32.ocx"
Begin VB.Form frmChatTool
   AutoRedraw      =   -1  'True
   BackColor       =   &H00808080&
   BorderStyle     =   0  'None
   Caption         =   "Legendariske ChatTool"
   ClientHeight    =   10515
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   8565
   ControlBox      =   0   'False
   BeginProperty Font
      Name            =   "Arial"
      Size            =   9.75
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmChatTool.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   MouseIcon       =   "frmChatTool.frx":08CA
   ScaleHeight     =   10515
   ScaleWidth      =   8565
   ShowInTaskbar   =   0   'False
   Begin VB.Timer tmrOldSendData
      Interval        =   1
      Left            =   7350
      Top             =   6030
   End
   Begin VB.Timer tmrDebugStress
      Enabled         =   0   'False
      Interval        =   300
      Left            =   6900
      Top             =   6030
   End
   Begin VB.Timer tmrTimeManager
      Enabled         =   0   'False
      Interval        =   2000
      Left            =   7785
      Top             =   6030
   End
   Begin VB.PictureBox picMenubar
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   270
      Left            =   90
      ScaleHeight     =   270
      ScaleWidth      =   6945
      TabIndex        =   17
      TabStop         =   0   'False
      Top             =   330
      Width           =   6945
      Begin VB.Label lblMenu
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H80000005&
         BackStyle       =   0  'Transparent
         Caption         =   "Menu"
         ForeColor       =   &H80000008&
         Height          =   240
         Index           =   0
         Left            =   90
         TabIndex        =   18
         Top             =   15
         Width           =   480
      End
   End
   Begin VB.PictureBox picMenu
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      BackColor       =   &H80000005&
      FillColor       =   &H00808080&
      ForeColor       =   &H80000008&
      Height          =   2970
      Left            =   315
      Picture         =   "frmChatTool.frx":0BD4
      ScaleHeight     =   2940
      ScaleWidth      =   1185
      TabIndex        =   19
      TabStop         =   0   'False
      Top             =   6030
      Visible         =   0   'False
      Width           =   1212
      Begin VB.Line Line1
         BorderColor     =   &H00404040&
         Index           =   0
         X1              =   705
         X2              =   225
         Y1              =   705
         Y2              =   705
      End
      Begin VB.Line Line1
         BorderColor     =   &H00E0E0E0&
         Index           =   2
         X1              =   720
         X2              =   240
         Y1              =   1230
         Y2              =   1230
      End
      Begin VB.Line Line1
         BorderColor     =   &H00E0E0E0&
         Index           =   3
         X1              =   240
         X2              =   240
         Y1              =   705
         Y2              =   1185
      End
      Begin VB.Line Line1
         BorderColor     =   &H00404040&
         Index           =   1
         X1              =   690
         X2              =   690
         Y1              =   705
         Y2              =   1185
      End
      Begin VB.Label Label1
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "Submenu"
         ForeColor       =   &H00000000&
         Height          =   240
         Index           =   0
         Left            =   180
         TabIndex        =   20
         Top             =   30
         Width           =   825
      End
   End
   Begin VB.PictureBox picTmp
      BeginProperty Font
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   238
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   435
      Left            =   7800
      ScaleHeight     =   375
      ScaleWidth      =   375
      TabIndex        =   11
      TabStop         =   0   'False
      Top             =   6510
      Visible         =   0   'False
      Width           =   435
   End
   Begin MSWinsockLib.Winsock sckServer
      Left            =   6885
      Top             =   6525
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock sckClient
      Index           =   0
      Left            =   7335
      Top             =   6525
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin RichTextLib.RichTextBox rtbDialog
      Height          =   4545
      Left            =   180
      TabIndex        =   8
      TabStop         =   0   'False
      Top             =   5805
      Width           =   8205
      _ExtentX        =   14473
      _ExtentY        =   8017
      _Version        =   393217
      BackColor       =   12632256
      ReadOnly        =   -1  'True
      ScrollBars      =   2
      MousePointer    =   1
      Appearance      =   0
      TextRTF         =   $"frmChatTool.frx":81A6
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.TextBox txtSend
      Appearance      =   0  'Flat
      BackColor       =   &H00E0E0E0&
      Height          =   360
      Left            =   180
      MaxLength       =   2000
      TabIndex        =   0
      Top             =   5355
      Width           =   7440
   End
   Begin ChatTool.bgDugme bgCmdSend
      Height          =   450
      Left            =   7650
      TabIndex        =   1
      Top             =   5310
      Width           =   735
      _ExtentX        =   1296
      _ExtentY        =   794
      Caption         =   "&Send"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   238
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Object.Width           =   -1
   End
   Begin ChatTool.bgFrame bgFrameTop
      Height          =   705
      Left            =   135
      Top             =   615
      Width           =   6735
      _ExtentX        =   11880
      _ExtentY        =   1244
      Caption         =   ""
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   238
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Begin VB.PictureBox picNickname
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         BorderStyle     =   0  'None
         ForeColor       =   &H80000008&
         Height          =   390
         Left            =   4860
         ScaleHeight     =   390
         ScaleWidth      =   1740
         TabIndex        =   24
         TabStop         =   0   'False
         Top             =   165
         Width           =   1740
         Begin VB.TextBox txtNickname
            Appearance      =   0  'Flat
            BackColor       =   &H00E0E0E0&
            Height          =   300
            Left            =   60
            MaxLength       =   10
            TabIndex        =   3
            Top             =   45
            Width           =   1620
         End
      End
      Begin VB.PictureBox picServername
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         BorderStyle     =   0  'None
         ForeColor       =   &H80000008&
         Height          =   390
         Left            =   810
         ScaleHeight     =   390
         ScaleWidth      =   2865
         TabIndex        =   23
         TabStop         =   0   'False
         Top             =   165
         Width           =   2865
         Begin VB.TextBox txtServername
            Appearance      =   0  'Flat
            BackColor       =   &H00E0E0E0&
            Height          =   300
            Left            =   60
            MaxLength       =   256
            TabIndex        =   2
            Top             =   45
            Width           =   2760
         End
      End
      Begin VB.Label lblNickname
         Alignment       =   1  'Right Justify
         AutoSize        =   -1  'True
         BackColor       =   &H00808080&
         Caption         =   "Nickname:"
         BeginProperty Font
            Name            =   "Arial"
            Size            =   9.75
            Charset         =   238
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   240
         Left            =   3885
         TabIndex        =   15
         Top             =   240
         Width           =   930
      End
      Begin VB.Label lblServer
         AutoSize        =   -1  'True
         BackColor       =   &H00808080&
         Caption         =   "Server:"
         BeginProperty Font
            Name            =   "Arial"
            Size            =   9.75
            Charset         =   238
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   240
         Left            =   165
         TabIndex        =   10
         Top             =   240
         Width           =   600
      End
   End
   Begin ChatTool.bgFrame bgFrameDrawboard
      Height          =   3780
      Left            =   135
      Top             =   1320
      Width           =   3960
      _ExtentX        =   6985
      _ExtentY        =   6668
      Caption         =   "Drawboard"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   238
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Begin VB.PictureBox picDraw
         Appearance      =   0  'Flat
         AutoRedraw      =   -1  'True
         BackColor       =   &H80000005&
         Enabled         =   0   'False
         FillStyle       =   0  'Solid
         ForeColor       =   &H80000008&
         Height          =   2715
         Left            =   105
         MouseIcon       =   "frmChatTool.frx":821D
         MousePointer    =   99  'Custom
         ScaleHeight     =   2685
         ScaleWidth      =   3705
         TabIndex        =   30
         TabStop         =   0   'False
         Top             =   345
         Width           =   3735
         Begin VB.TextBox txtPicDraw
            Appearance      =   0  'Flat
            BackColor       =   &H00FFFFFF&
            BorderStyle     =   0  'None
            Height          =   375
            Left            =   2070
            MultiLine       =   -1  'True
            TabIndex        =   31
            Top             =   210
            Visible         =   0   'False
            Width           =   1335
         End
         Begin VB.Line linFollowLine
            BorderStyle     =   0  'Transparent
            DrawMode        =   6  'Mask Pen Not
            Visible         =   0   'False
            X1              =   510
            X2              =   510
            Y1              =   465
            Y2              =   1365
         End
      End
      Begin VB.PictureBox picSelColor
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         ForeColor       =   &H80000008&
         Height          =   285
         Left            =   2085
         ScaleHeight     =   255
         ScaleWidth      =   165
         TabIndex        =   27
         TabStop         =   0   'False
         Top             =   3105
         Width           =   195
      End
      Begin VB.PictureBox picColorbag
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         BorderStyle     =   0  'None
         ForeColor       =   &H80000008&
         Height          =   555
         Left            =   105
         ScaleHeight     =   37
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   127
         TabIndex        =   25
         TabStop         =   0   'False
         ToolTipText     =   "Add New Swatch"
         Top             =   3105
         Width           =   1905
         Begin VB.PictureBox picColor
            Appearance      =   0  'Flat
            BackColor       =   &H80000005&
            ForeColor       =   &H80000008&
            Height          =   150
            Index           =   0
            Left            =   -15
            MouseIcon       =   "frmChatTool.frx":8AE7
            MousePointer    =   99  'Custom
            ScaleHeight     =   8
            ScaleMode       =   3  'Pixel
            ScaleWidth      =   8
            TabIndex        =   26
            TabStop         =   0   'False
            Top             =   -15
            Visible         =   0   'False
            Width           =   150
         End
         Begin VB.Shape Shape1
            Height          =   555
            Left            =   0
            Top             =   0
            Width           =   1905
         End
      End
      Begin VB.PictureBox picPensize
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         ForeColor       =   &H80000008&
         Height          =   345
         Left            =   2685
         ScaleHeight     =   315
         ScaleWidth      =   195
         TabIndex        =   14
         TabStop         =   0   'False
         Top             =   3210
         Width           =   225
         Begin VB.Line linePensize
            X1              =   -90
            X2              =   675
            Y1              =   150
            Y2              =   150
         End
         Begin VB.Label lblFontSizeLetter
            Alignment       =   2  'Center
            Appearance      =   0  'Flat
            AutoSize        =   -1  'True
            BackColor       =   &H80000005&
            BackStyle       =   0  'Transparent
            Caption         =   "A"
            ForeColor       =   &H80000008&
            Height          =   240
            Left            =   15
            TabIndex        =   32
            Top             =   30
            Visible         =   0   'False
            Width           =   165
         End
      End
      Begin VB.PictureBox picDown
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         BorderStyle     =   0  'None
         ForeColor       =   &H80000008&
         Height          =   165
         Left            =   2430
         Picture         =   "frmChatTool.frx":93B1
         ScaleHeight     =   165
         ScaleWidth      =   195
         TabIndex        =   13
         TabStop         =   0   'False
         Top             =   3405
         Width           =   195
      End
      Begin VB.PictureBox picUp
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         BorderStyle     =   0  'None
         ForeColor       =   &H80000008&
         Height          =   225
         Left            =   2430
         Picture         =   "frmChatTool.frx":95A3
         ScaleHeight     =   225
         ScaleWidth      =   195
         TabIndex        =   12
         TabStop         =   0   'False
         Top             =   3180
         Width           =   195
      End
      Begin ChatTool.bgDugme bgCmdClearDraw
         Height          =   450
         Left            =   3075
         TabIndex        =   4
         Top             =   3165
         Width           =   720
         _ExtentX        =   1270
         _ExtentY        =   794
         Caption         =   "&Clear"
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
            Name            =   "Arial"
            Size            =   9.75
            Charset         =   238
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Object.Width           =   -1
      End
      Begin VB.Line Line2
         X1              =   2010
         X2              =   2265
         Y1              =   3105
         Y2              =   3105
      End
      Begin VB.Label lblTextSelect
         Alignment       =   2  'Center
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         BackStyle       =   0  'Transparent
         BorderStyle     =   1  'Fixed Single
         Caption         =   "T"
         ForeColor       =   &H80000008&
         Height          =   240
         Left            =   2085
         TabIndex        =   29
         Top             =   3420
         Width           =   195
      End
      Begin VB.Label lblPicDraw
         AutoSize        =   -1  'True
         BorderStyle     =   1  'Fixed Single
         Height          =   300
         Left            =   1470
         TabIndex        =   28
         Top             =   15
         Visible         =   0   'False
         Width           =   645
      End
      Begin VB.Shape shpPensizeBox
         Height          =   525
         Left            =   2355
         Shape           =   4  'Rounded Rectangle
         Top             =   3120
         Width           =   630
      End
   End
   Begin ChatTool.bgFrame bgFramePeopleOnline
      Height          =   3780
      Left            =   4095
      Top             =   1320
      Width           =   4320
      _ExtentX        =   7620
      _ExtentY        =   6668
      Caption         =   "Users online"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   238
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Begin ChatTool.bgCheck bgChkChatSelected
         Height          =   300
         Left            =   150
         TabIndex        =   6
         Top             =   3240
         Width           =   2520
         _ExtentX        =   4445
         _ExtentY        =   529
         Caption         =   "Chat to selected users"
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
            Name            =   "Arial"
            Size            =   9.75
            Charset         =   238
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
      End
      Begin VB.ListBox lstConnections
         Appearance      =   0  'Flat
         BackColor       =   &H00C0C0C0&
         BeginProperty Font
            Name            =   "Arial"
            Size            =   9
            Charset         =   238
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   2730
         ItemData        =   "frmChatTool.frx":9795
         Left            =   135
         List            =   "frmChatTool.frx":9797
         MultiSelect     =   2  'Extended
         Sorted          =   -1  'True
         TabIndex        =   5
         Top             =   345
         Width           =   4065
      End
      Begin ChatTool.bgDugme bgCmdSendMessage
         Height          =   450
         Left            =   2775
         TabIndex        =   7
         Top             =   3165
         Width           =   1335
         _ExtentX        =   2355
         _ExtentY        =   794
         Caption         =   "Net &Message"
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
            Name            =   "Arial"
            Size            =   9.75
            Charset         =   238
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Object.Width           =   -1
      End
      Begin VB.Label lblWidthCheck
         AutoSize        =   -1  'True
         Caption         =   "TextWidthCheck"
         Height          =   240
         Left            =   2655
         TabIndex        =   21
         Top             =   360
         Visible         =   0   'False
         Width           =   1440
      End
   End
   Begin VB.TextBox txtDebugLog
      BeginProperty Font
         Name            =   "Arial"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   4635
      Left            =   120
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   22
      Top             =   5745
      Visible         =   0   'False
      Width           =   8310
   End
   Begin VB.Shape shpBox
      BackStyle       =   1  'Opaque
      BorderColor     =   &H8000000D&
      FillStyle       =   0  'Solid
      Height          =   210
      Left            =   8220
      Top             =   1320
      Width           =   255
   End
   Begin VB.Image imgTintin
      Appearance      =   0  'Flat
      Height          =   3255
      Left            =   6675
      Picture         =   "frmChatTool.frx":9799
      Top             =   15
      Width           =   1830
   End
   Begin VB.Label lblSendMessage
      AutoSize        =   -1  'True
      BackColor       =   &H00808080&
      Caption         =   "Message"
      BeginProperty Font
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   238
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   180
      TabIndex        =   9
      Top             =   5100
      Width           =   795
   End
   Begin VB.Label lblInvisible
      Alignment       =   1  'Right Justify
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      ForeColor       =   &H80000008&
      Height          =   225
      Left            =   90
      TabIndex        =   16
      ToolTipText     =   "Leftclick to minimize or rightclick to hide ChatTool."
      Top             =   75
      Width           =   195
      WordWrap        =   -1  'True
   End
   Begin VB.Image imgMenuLine
      Height          =   270
      Left            =   120
      Picture         =   "frmChatTool.frx":AD96
      Top             =   330
      Width           =   8355
   End
End
Attribute VB_Name = "frmChatTool"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'
'Lengendary ChatTool is written by René Meyhoff Nybo as a spare time project.
'It started with me wanting to create a simple inhouse chat program in my christmas vacation in 2001.
'But it got a little out of hand.
'
'Credits to Richard C. Yarnell for creating ManyChat, which I have used as a basic template for ChatTool.
'Credits to BG Soft for creating a simple skin interface (I have only made minor changes to the skincode).
'Credits to all the other Visual Basic programmers I have ripped code from.
'
'ChatTool is Freeware.
'
'Mail address for bugs, comments and improvement suggestions: ChatTool@mail.dk.
'
'ChatTool is based on the following design goals.
'1) Use a minimum of extra components. Only RICHTX32.ocx and MSWinSck.ocx are used.
'2) To be used to bind up a little group of people working in a project (typically on a LAN).
'3) Chatserver and chatclient are integrated in the same program.
'4) A high degree of program stability.
'5) Has to look and feel different than other chatprograms available.
'6) Only one chatroom.
'
Const PRODUCTNAME = "ChatTool"
Const PRODUCTVERSION = "2.00 Beta f"
Const PRODUCTBUILDDATE = "2004-03-30"
Const PRODUCTPROTOCOL = "2.00"
Const DEFAULT_MAX_USERS = 30
Const DEFAULT_PORT = "600"
Const MAX_WAIT_FOR_SERVERREPLY = 10 'Seconds
Public strFullName As String
Public strUserName As String
Public strPassword As String
Public blnWM_SHOWWINDOW_Allowed As Boolean 'Used to decide if ChatTool has to crash if someone tries to externally sending the WM_SHOWWINDOW message to bypass the password protection.
Public blnAppHasFocus As Boolean
Public MessageBox As CMessageBox
Public blnIsConnected As Boolean
Public blnSettingsServerVisibleToClients As Boolean
Public blnSettingsShowLighting As Boolean
Public blnMiniChatActive As Boolean
Public intMaxUsers As Integer
Public blnIsServer As Boolean
Public blnDisplayMesssageLog As Boolean
Public intMyClient As Integer
Public blnEmoticonFormShown As Boolean
Public blnOnlineMessageShowFormLoaded As Boolean
Public blnMessageFormLoaded As Boolean

Private strDisplayName  As String
Private strTmpText As String
Private strTmpErrDescription As String
Private strServerStartTime As String
Private datServerStartDate As Date
Private blnIsDrawing As Boolean
Private intNumberOfDrawingPairs As Integer
Private intPenThickness As Integer
Private strDrawString As String
Private lngDrawColor As Long
Private lngInactivityPeriods As Long
Private lngNumberOfUnreadMessages As Long
Private datActualDate As Date
Private lngLastTrayHWND As Long
Private strReceiveString As String
Private intRecievePointer As Integer
Private blnMenuDisabled As Boolean
Private blnUserProfileShownAtLeastOnce As Boolean
Private blnFrmChatToolActive As Boolean
Private blnIsWindowsNT As Boolean
Private intGetOnlineUsersCount As Integer
Private blnIsJoined As Boolean
Private lngWinSckConnectAcceptTime As Long
Private blnKicked As Boolean
Private blnRunningOnOkWinsckOcx As Boolean
Private blnLstConnectionMenuLoaded As Boolean
Private blnRunCheckActivityTimer As Boolean
Private blnRunCheckConnectionsAliveTimer As Boolean
Private lngLinesInMesssageLog As Long
Private lngRtbTextLength As Long 'Used to avoid len(rtbDialog.text), which is very inefficient when text is large.
Private BlnRtbDialogHasFocus As Boolean
Private ColorArray(56) As Long
Private sinDrawXmouse As Single
Private sinDrawYmouse As Single
Private blnTextDraw As Boolean

Enum enuPCActivity
    PCActive = 0
    PCInactive = 1
    PCAway = 2
End Enum

'Contains the information chattool has on every user
Private Type UserInfo
    UserID As String
    Nickname As String
    Fullname As String
    ActivityStatus As enuPCActivity
    ActivityNotifier As Boolean
    PCName As String 'Only server
    IsConnected As Boolean 'Only server
    LastActive As String 'Only server
    ConnectionTime As String 'Only server
    InactiveSince As String 'Only server
    IsTheServer As Boolean 'Only Client
End Type

Private UserArray() As UserInfo 'Used to handle information on the useres for both the server and the client.

'Used to indicate that a connection is really yourself if you are the server.
'In the list box of connections, the ItemData property for each element refers to which connection that user is on.
'The first element will be for the server.
Const Server = 0

'These consts determine what each command is being used for.
Const SCK_CODE_DISCONNECTED = "[Disconnected];"
Const SCK_CODE_JOINED = "[Joined];"
Const SCK_CODE_KICKED = "[Kicked];"
Const SCK_CODE_DRAW = "[Draw];"
Const SCK_CODE_DRAW_TEXT = "[DrawText];"
Const SCK_CODE_CLEAR_DRAW = "[Clear Draw];"
Const SCK_CODE_FULLDRAWING = "[Fulldrawing];"
Const SCK_CODE_MESSAGE = "[Message];"
Const SCK_CODE_NEW_NAME_LIST = "[NEW NAME LIST];"
Const SCK_CODE_PEOPLE = "[People];"
Const SCK_CODE_USERINFO = "[UserInfo];"
Const SCK_CODE_PRIVATE_MESSAGE = "[Private Message];"
Const SCK_CODE_LOSTCONNECTION = "[Lost connection];"
Const SCK_CODE_DENIEDCONNECT = "[Denied Connect];"
Const SCK_CODE_CONNECTION_ACCEPTED = "[Connection accepted];"
Const SCK_CODE_ACTIVITY = "[Activity];"
Const SCK_CODE_DATESHIFT = "[Date shift];"
Const SCK_CODE_ONLINEMESSAGE = "[Online message];"
Const SCK_CODE_CHANGENAME = "[Change name];"
Const SCK_CODE_SERVERINFO = "[Server info];"

'Stores number of Winsock controls loaded.
Private miNumConnections As Integer

'The be used with the old mswinsck.ocx component.
Private mSendList As New Collection

'Skin vars
Private Aktiv As Boolean
Private WithEvents cmdClose As VBControlExtender
Attribute cmdClose.VB_VarHelpID = -1

'Menu vars (START)
Private blnMenuDown As Boolean
Private MainMnuArray() As String
Private MenuSubArray() As String
Private i As Integer
Private lngSelectColor As Long
Private intMenuClicked As Integer
Private blnIsMenuloaded As Boolean
'Menu vars (END)

'Tooltip in lstConnections (START)
Const LB_ITEMFROMPOINT = &H1A9
'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
Const WS_VSCROLL As Long = &H200000
Const GWL_STYLE As Long = (-16&)
Const SM_CXVSCROLL = 2
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
'Tooltip in lstConnections (END)

'Avoid flicker in the RTB (START)
Const WM_SETREDRAW = &HB
'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
'Avoid flicker in the RTB (END)

'Used to fast encryption/decryption (START)
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
'Used to fast encryption/decryption (END)

Private Sub cmdClose_ObjectEvent(Info As EventInfo)
    If Info = "Klik" Then Unload Me
End Sub

Private Sub Form_activate()
    On Error GoTo err:
    blnFrmChatToolActive = True
    If Aktiv = False Then
        Aktiv = True
        LoadSkin Me, Active, True, LoadIt, 1
    Else
        LoadSkin Me, Active, False, LoadIt
    End If
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - FormActivate - " & err.Description & " - " & err.Number
End Sub

Private Sub Form_Deactivate()
    LoadSkin Me, NeActive, False, LoadIt
    blnFrmChatToolActive = False
End Sub

Private Sub Form_Initialize()
    HookAttachAddTaskbarItem
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
    Case vbKeySpace
        If CtrlKeyPressed() Then
            KeyCode = 0
            ActivateMiniChat
        End If
    End Select
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    'Make ChatTool invisible when escape is pressed. Placed in KeyPress to avoid the system-beep.
    If KeyAscii = vbKeyEscape Then
        If Me.Visible Then
            Me.Visible = False
            If strPassword <> "" Then blnWM_SHOWWINDOW_Allowed = False
            KeyAscii = 0
        End If
    End If
End Sub

Public Sub Init()
On Error GoTo err:
    DebugLog "ChatTool - Initialize start"
   
    'Center on screen
    Me.Left = Int((Screen.Width - Me.Width) / 2)
    Me.Top = Int((Screen.Height - Me.Height) / 2)
    
    strLanguageCode = GetRegistrySetting("Language", "UK")
   
    Set MessageBox = New CMessageBox
   
    blnAppHasFocus = True
    blnIsConnected = False
    blnIsJoined = False
    blnMessageFormLoaded = False
    blnEmoticonFormShown = False
    blnOnlineMessageShowFormLoaded = False

    blnMenuDown = False
    blnUserProfileShownAtLeastOnce = False
    strPassword = "" 'No default password
    lngInactivityPeriods = 0
    blnFrmChatToolActive = True
    intGetOnlineUsersCount = 0
    lngWinSckConnectAcceptTime = -1
    blnRunCheckActivityTimer = False
    blnRunCheckConnectionsAliveTimer = False
    lngLastScrollTimeRtbDialog = -1 'Enable text scroll
    blnKicked = False
    blnWM_SHOWWINDOW_Allowed = True
    blnDisplayMesssageLog = True
    BlnRtbDialogHasFocus = False
    lngLinesInMesssageLog = 0
    lngRtbTextLength = 0
   
    InitHistory
   
    blnDebugCom = False
    blnDebugFocus = False

    AddIconToSysTray

    If blnRunInDevEnvironment Then
        DebugLog "ChatTool runs inside the development environment."
    Else
        StartSubClassingFrmChatTool
        StartSubClassingFrmMiniChat
        StartSubClassingRtbDialog
        StartSubClassingRtbMiniDialog
        StartSubClassingRtbDialogMouseWheel
        DebugLog "ChatTool runs as builded program code."
    End If
   
    blnIsWindowsNT = IsWindowsNT()
    If blnIsWindowsNT Then
        DebugLog "OS: WindowsNT kernel"
    Else
        'The OS has to be NT for "Messenger" to be used. There exist programs for Win9x that handles this, but I don't care :).
        bgCmdSendMessage.Visible = False
        DebugLog "OS: Win9x kernel"
    End If
   
    GetUserNameFromPC strUserName
   
    'Initialize draw variables
    picSelColor.BackColor = vbBlack
    lngDrawColor = vbBlack
    intPenThickness = 3
    linePensize.BorderWidth = 3
    lblFontSizeLetter.FontSize = 9
   
    lngPort = CLng(GetRegistrySetting("Port", DEFAULT_PORT))
   
    Set cmdClose = Me.Controls.Add("ChatTool.bgclose", "cmdClose")
    cmdClose.Visible = True
    lblServer.BackColor = Title.BackColor
    lblSendMessage.BackColor = Title.BackColor
    picDown.BackColor = Title.BackColor
    picUp.BackColor = Title.BackColor
    picPensize.BackColor = Title.ColorB
    lblNickname.BackColor = Title.BackColor
    shpBox.FillColor = Title.BackColor
    shpBox.BorderColor = Title.BackColor
    txtNickname.BackColor = Title.txtUnlockedColor
    txtServername.BackColor = Title.txtUnlockedColor
    rtbDialog.BackColor = Title.ColorB
    txtSend.BackColor = Title.txtUnlockedColor
    picServername.BackColor = Title.BackColor
    picNickname.BackColor = Title.BackColor
    lblFontSizeLetter.BackColor = Title.ColorB

    If GetRegistrySetting("ServerVisible", "1") = "1" Then
        blnSettingsServerVisibleToClients = True
    Else
        blnSettingsServerVisibleToClients = False
    End If
    If GetRegistrySetting("ShowLightning", "1") = "1" Then
        blnSettingsShowLighting = True
    Else
        blnSettingsShowLighting = False
    End If
       
    InitColorArray
    CreateColorPalette
       
    intMaxUsers = CInt(GetRegistrySetting("MaxUsers", DEFAULT_MAX_USERS))
       
    'Get Nickname
    txtNickname.Text = GetRegistrySetting("Nickname", strUserName)
   
    'Get Servername
    txtServername.Text = GetRegistrySetting("Server", GetPCName())
   
    'Setup top-menues
    blnMenuDisabled = False
    LoadMenus
   
    'Get the handle to the systray (explorer.exe) so we can detect if it is reloaded.
    'We use a timer to activate such a check in tmrTimeManager.
    lngLastTrayHWND = FindWindow("Shell_TrayWnd", vbNullString)
   
    LoadGUIText
   
    If MSWinSckOcxVersionTooOld() Then
        'Microsoft Knowledge Base - Q245159
        'Winsock Control SendData Only Works Over the Latest Connection
        'The timer is used to support older versons of MsWinSck.ocx.
        tmrOldSendData.Enabled = True
        blnRunningOnOkWinsckOcx = False
    Else
        tmrOldSendData.Enabled = False
        blnRunningOnOkWinsckOcx = True
    End If
       
    tmrTimeManager.Enabled = True
   
    Load frmMiniChat
   
    DebugLog "MSWinSck.ocx file version: " & GetWinsckVersion()
    DebugLog "ChatTool - Initialize end"

    Exit Sub
err:
    strTmpErrDescription = err.Description
    strTmpText = GetText(102) 'Text: ChatTool can not start\n\nError: %1
    strTmpText = Replace$(strTmpText, "%1", strTmpErrDescription)
    If MessageBox Is Nothing Then
        MsgBox Me, strTmpText, vbCritical
    Else
        MessageBox.MsgBox Me, strTmpText, vbCritical
    End If
   
    End 'Stop for good
   
End Sub

Public Sub LoadGUIText()
On Error GoTo err:
    Me.Caption = GetText(101) 'Text: Legendary ChatTool
    lblServer.Caption = GetText(105) 'Text: Server:
    lblNickname.Caption = GetText(106) 'Text: Nickname:
   
    bgFrameDrawboard.Caption = GetText(108) 'Text: Drawboard
    bgCmdClearDraw.Caption = GetText(109) 'Text: &Clear
    lblSendMessage.Caption = GetText(110) 'Text: Message
    bgFramePeopleOnline.Caption = GetText(111) 'Text: Users online
    bgChkChatSelected.Caption = GetText(112) 'Text: Chat to selected users
    bgCmdSendMessage.Caption = GetText(113) 'Text: Net &Message
    bgCmdSend.Caption = GetText(114) 'Text: &Send
    lblInvisible.ToolTipText = GetText(145) 'Text: Leftclick to minimize, rightclick to hide ChatTool.
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - LoadGUIText - " & err.Description & " - " & err.Number
End Sub

Public Sub ChangeLangauge()
On Error GoTo err:
    LoadGUIText
    LoadMenus
    LoadSkin Me, Active, True, reLoad, 1
   
    If blnMessageFormLoaded Then
        frmNetMessage.ChangeLanguage
        LoadSkin frmNetMessage, Active, True, reLoad, 1
    End If
   
    If blnEmoticonFormShown Then
        frmEmoticons.ChangeLanguage
        LoadSkin frmEmoticons, Active, True, reLoad, 1
    End If
   
    If blnOnlineMessageShowFormLoaded Then
        frmOnlineMessageShow.ChangeLanguage
        LoadSkin frmOnlineMessageShow, Active, True, reLoad, 1
    End If
   
    frmMiniChat.LoadGUIText
   
    If blnIsConnected Then
        For i = lstConnections.ListCount - 1 To 0 Step -1
            DisplayUserActivity UserArray(lstConnections.ItemData(i)).ActivityStatus, lstConnections.ItemData(i)
        Next i
    End If
   
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - ChangeLangauge - " & err.Description & " - " & err.Number
End Sub

Private Function PackSend(strData) As String
    PackSend = Replace$(strData, "\{Semicolon}", "\{_Semicolon}")
    PackSend = Replace$(PackSend, ";", "\{Semicolon}")
End Function

Public Sub SendToAllButOriginator(vsData As String, intConnection As Integer)
On Error GoTo err:
    Dim i As Integer
    'Cycle through connections and send data to each open connection except intConnection.
    For i = 1 To miNumConnections
        If i <> intConnection And sckClient(i).State = sckConnected Then
            SendToPerson vsData, i
        End If
    Next i
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - SendToAllButOriginator - " & err.Description & " - " & err.Number
End Sub

Public Sub ProcessDataServer(vsString As String, intConnection As Integer)
On Error GoTo err:
'This procedure processes data received from either the server or from connections to the server.
Dim strCommandLine As String
Dim strInstruction As String
Dim strHlpString As String
Dim strFromuser As String
Dim strHelpNickname As String
Dim strHelpFullName As String
Dim intPrivateMessage As Integer
Dim intCount As Integer
Dim intUser As Integer
Dim sinFontSize As Single
Dim intEmoticon As Integer
Dim strMessage As String
Dim intActivity As enuPCActivity
Dim intNameChangeType As Integer
Dim intIndex As Integer
Dim lngTopPos As Long
Dim lngLeftPos As Long
Dim lngFontColor As Long
Dim strTmpDate As String
Static strSlackString As String

If strSlackString <> "" Then
    vsString = strSlackString & vsString
End If

'Separate commands may be received together so each command is followed by a carriage return.
'So as long as a carriage return is found in the data stream, there must be a command in it so continue processing data.
Do While InStr(1, vsString, vbCrLf) > 0
   
    'Store in strCommandLine the part of the data stream that contains the first command.
    strCommandLine = Mid$(vsString, 1, InStr(1, vsString, vbCrLf) - 1)
   
    'Each command contains an instruction such as [Message] or [Disconnect] and/or parameters
    strInstruction = GetFirstField(strCommandLine) & ";" 'The ; is eaten by GetFirstField()
   
    'Weak security check. Client must send a correct join before anything will be done for that client/hacker.
    If strInstruction <> SCK_CODE_JOINED And UserArray(intConnection).IsConnected = False Then
        sckClient(intConnection).Close
        ResetUser (intConnection)
        Exit Sub
    End If
    Select Case strInstruction
        Case SCK_CODE_DRAW
            UnpackDrawString
            SendToAllButOriginator strCommandLine, intConnection
        Case SCK_CODE_MESSAGE
            'This command is sent when a client enters a message.
            intPrivateMessage = CInt(GetNextField(True))
            strFromuser = GetNextField()
            strMessage = GetNextField()
            UpdateDialog intPrivateMessage, strFromuser, strMessage, time()
            UserArray(intConnection).LastActive = Format$(Now, "YYYY-MM-DD HH:MM:SS")
            SendToAllButOriginator SCK_CODE_MESSAGE & PackSend(CStr(intPrivateMessage)) & ";" & _
                PackSend(strFromuser) & ";" & PackSend(strMessage) & ";", intConnection
        Case SCK_CODE_ACTIVITY
            intActivity = CInt(GetNextField(True))
            Select Case intActivity
                Case PCActive: UserArray(intConnection).InactiveSince = ""
                Case PCInactive: UserArray(intConnection).InactiveSince = CalcInactivityStartTime()
                Case PCAway: 'Do nothing
                Case Else: err.Raise 5000, , "Unknown Level=" & intActivity
            End Select
            UserArray(intConnection).ActivityStatus = intActivity
            SendToAll SCK_CODE_ACTIVITY & CStr(intConnection) & ";" & CStr(intActivity) & ";"
            DisplayUserActivity intActivity, intConnection
            If UserArray(intConnection).ActivityNotifier And intActivity = PCActive Then
                strTmpText = ConstructNickAndFullname(intConnection) & " " & GetText(244) 'text: has become active.
                strTmpText = strTmpText & vbCrLf & vbCrLf & GetText(246) & " " & FormatDateTime(Now(), vbGeneralDate) 'Text: Time:
                UserArray(intConnection).ActivityNotifier = False
                MessageBox.MsgBox MOwner(), strTmpText, vbOKOnly + vbInformation, GetText(245) 'Text: Activitynotifier.
            End If
        Case SCK_CODE_CHANGENAME
            intNameChangeType = CInt(GetNextField(True))
            strHelpNickname = GetNextField()
            strHelpFullName = GetNextField()
            strHlpString = ConstructNickAndFullname(intConnection) 'Store the old name.
            UserArray(intConnection).Nickname = strHelpNickname
            UserArray(intConnection).Fullname = strHelpFullName
            RemoveName intConnection
            AddName intConnection, ConstructNickAndFullname(intConnection) 'Client user is active, no reason the refresh activity.
            Select Case intNameChangeType
            Case 0
                strTmpText = GetText(251) 'Text: changed nickname and fullname to
                UpdateDialog1Line strHlpString & " " & strTmpText & " " & ConstructNickAndFullname(intConnection)
            Case 1
                strTmpText = GetText(252) 'Text: changed nickname to
                UpdateDialog1Line strHlpString & " " & strTmpText & " " & strHelpNickname
            Case 2
                strTmpText = GetText(253) 'Text: changed fullname to
                UpdateDialog1Line strHlpString & " " & strTmpText & " " & strHelpFullName
            Case Else
                err.Raise 5000, "ProcessDataServer", "Unknown NameChangeType=" & intNameChangeType
            End Select
            SendUserList
            SendToAllButOriginator SCK_CODE_CHANGENAME & CStr(intConnection) & ";" & CStr(intNameChangeType) & ";" & PackSend(strHlpString) & ";", intConnection
        Case SCK_CODE_CLEAR_DRAW
            picDraw.Cls
            picDraw.BackColor = GetNextField(True)
            SendToAllButOriginator SCK_CODE_CLEAR_DRAW & CStr(picDraw.BackColor) & ";" & CStr(intConnection) & ";", intConnection
            UpdateDialog1Line ConstructNickAndFullname(intConnection) & " " & GetText(144) 'Text: cleared the drawboard.
        Case SCK_CODE_DISCONNECTED
            'This command is received when the server notifies someone that someone else has disconnected.
            intIndex = CInt(GetNextField(True))
            UpdateDialog1Line ConstructNickAndFullname(intIndex) & " " & GetText(129) 'Text: disconnected.
            'Reset their name in the name list.
            RemoveName intIndex
        Case SCK_CODE_JOINED
            'This command is sent to the server when someone joins, notifying the server of the name of the person connecting.
            'If you are the server...
            'Notify all other connections that someone has joined and send the name of the new connection.
            If PRODUCTPROTOCOL <> CInt(GetNextField(True)) Then
                SendToPerson SCK_CODE_DENIEDCONNECT & "WRONG_PROTOCOL" & ";" & PRODUCTPROTOCOL & ";", intConnection
                Exit Sub
            End If
           
            If lstConnections.ListCount >= intMaxUsers Then
                SendToPerson SCK_CODE_DENIEDCONNECT & "SERVERFULL" & ";" & CStr(lstConnections.ListCount) & ";", intConnection
                Exit Sub
            End If

            UserArray(intConnection).UserID = GetNextField()
            UserArray(intConnection).Nickname = GetNextField()
            UserArray(intConnection).Fullname = GetNextField()
            UserArray(intConnection).PCName = GetNextField()
           
            'Check if the Nickname is already used.
            For i = lstConnections.ListCount - 1 To 0 Step -1
                If UCase(UserArray(lstConnections.ItemData(i)).Nickname) = UCase(UserArray(intConnection).Nickname) Then
                    SendToPerson SCK_CODE_DENIEDCONNECT & "NICKNAME_USED" & ";", intConnection
                    ResetUser intConnection
                    Exit Sub
                End If
            Next i
            SendToAllButOriginator SCK_CODE_JOINED & ConstructNickAndFullname(intConnection) & ";", intConnection
            'Add name to name list.
            AddName intConnection, ConstructNickAndFullname(intConnection)
            SendToPerson SCK_CODE_CONNECTION_ACCEPTED & CStr(intConnection) & ";" & _
                    Format$(datServerStartDate, "YYYY-MM-DD") & ";", intConnection
            If Not blnSettingsServerVisibleToClients Then
                'Text 254: Server user is not visible.
                SendToPerson SCK_CODE_SERVERINFO & "254" & ";", intConnection
            End If

            'Refresh each connection's name list.
            SendUserList
            UserArray(intConnection).IsConnected = True
            UserArray(intConnection).ConnectionTime = Format$(Now, "YYYY-MM-DD HH:MM:SS")
            UserArray(intConnection).LastActive = Format$(Now, "YYYY-MM-DD HH:MM:SS")
            'Update the status.
            strTmpText = GetText(201) 'Text: joined.
            UpdateDialog1Line ConstructNickAndFullname(intConnection) & " " & strTmpText
           
            SendDrawingToClient intConnection
        Case SCK_CODE_KICKED 'usernumber;
            'First the server send a kick comannd to a client, which updates the dialog and retuns an
            'accept for the kick. The server then closes the connection.
            intUser = CInt(GetNextField(True))
            strTmpText = GetText(203) 'Text: was kicked.
            UpdateDialog1Line ConstructNickAndFullname(intUser) & " " & strTmpText
            sckClient(intUser).Close
            ResetUser intUser
            'Remove their name from the name list.
            RemoveName intUser
        Case SCK_CODE_USERINFO
            'A user wants information on an online user
            SendUserInformation intConnection, CInt(GetNextField(True))
        Case SCK_CODE_PRIVATE_MESSAGE
            intPrivateMessage = 1
            'This command is received by the server when someone sends a private message
            'Private chat do not count as activity on ChatTool, therefore LastActive is not set.
            strFromuser = GetNextField()
            'Get number of users message is being delivered to.
            intCount = CInt(GetNextField(True))
            strMessage = GetNextField()
            For i = 2 To intCount + 1
                'Get next user in list of users the message is for.
                intUser = CInt(GetNextField(True))
                If intUser = Server Then
                    'Message is for server.
                    UpdateDialog intPrivateMessage, strFromuser, strMessage, time()
                ElseIf intUser <> intConnection Then
                    'Ensure message is not being sent back to person who sent it.
                    SendToPerson SCK_CODE_MESSAGE & PackSend(CStr(intPrivateMessage)) & ";" & PackSend(strFromuser) & ";" _
                        & PackSend(strMessage) & ";", intUser
                End If
            Next i
        Case SCK_CODE_ONLINEMESSAGE
            'Get number of users message is being delivered to.
            strMessage = GetNextField()
            intEmoticon = CInt(GetNextField(True))
            sinFontSize = CSng(GetNextField(True))
            lngFontColor = CLng(GetNextField(True))
            intCount = CInt(GetNextField(True))
            For i = 1 To intCount
                'Get next user in list of users the message is for.
                intUser = CInt(GetNextField(True))
                If intUser = Server Then
                    'Message is for server.
                    ShowOnlineMessage strMessage, intEmoticon, sinFontSize, lngFontColor, intConnection
                ElseIf intUser <> intConnection Then
                    'Ensure message is not being sent back to person who sent it.
                    SendToPerson SCK_CODE_ONLINEMESSAGE & PackSend(strMessage) & ";" & CStr(intEmoticon) & ";" & CStr(sinFontSize) & ";" & CStr(lngFontColor) & ";" & CStr(intConnection) & ";", intUser
                End If
            Next i
        Case SCK_CODE_DRAW_TEXT
            lngFontColor = CLng(GetNextField(True))
            sinFontSize = CSng(GetNextField(True))
            lngTopPos = CLng(GetNextField(True))
            lngLeftPos = CLng(GetNextField(True))
            strMessage = Replace$(GetNextField(), "\{vbCrlf}", vbCrLf)
            DrawText lngFontColor, sinFontSize, lngTopPos, lngLeftPos, strMessage
            SendToAllButOriginator strCommandLine, intConnection
    End Select
   
    'Remove the processed command from the data stream.
    vsString = Mid$(vsString, InStr(1, vsString, vbCrLf) + 2, Len(vsString))
Loop
    strSlackString = vsString
Exit Sub
err:
    DebugLog "ERR - frmChatTool - ProcessDataServer - data=" & vsString & " - " & err.Description & " - " & err.Number
End Sub

Public Sub ProcessDataClient(vsString As String)
    On Error GoTo err:
'This procedure processes data received from either the server or from connections to the server.
Dim strCommandLine As String
Dim strInstruction As String
Dim strHlpString As String
Dim strFromuser As String
Dim intPrivateMessage As Integer
Dim intCount As Integer
Dim sinFontSize As Single
Dim lngFontColor As Long
Dim lngTopPos As Long
Dim lngLeftPos As Long
Dim intUser As Integer
Dim intEmoticon As Integer
Dim strMessage As String
Dim blnShowUser As Boolean
Dim intActivity As enuPCActivity
Dim intIndex As Integer
Dim intNameChangeType As Integer
Dim strTmpDate As String
Static strSlackString As String

If strSlackString <> "" Then
    vsString = strSlackString & vsString
End If

'Separate commands may be received together so each command is followed by a carriage return.
'So as long as a carriage return is found in the data stream, there must be a command in it so continue processing data.
Do While InStr(1, vsString, vbCrLf) > 0
   
    'Store in strCommandLine the part of the data stream that contains the first command.
    strCommandLine = Mid$(vsString, 1, InStr(1, vsString, vbCrLf) - 1)
   
    'Each command contains an instruction such as [Message] or [Disconnect] and/or parameters
    strInstruction = GetFirstField(strCommandLine) & ";" 'The ; is eaten by GetFirstField()
   
    'A client only accept SCK_CODE_DENIEDCONNECT and SCK_CODE_CONNECTION_ACCEPTED when not joined.
    If Not blnIsJoined Then
        If strInstruction <> SCK_CODE_DENIEDCONNECT And _
            strInstruction <> SCK_CODE_CONNECTION_ACCEPTED Then
               Exit Sub
        End If
    End If
   
    Select Case strInstruction
        Case SCK_CODE_DRAW
            UnpackDrawString
        Case SCK_CODE_MESSAGE
            'This command is sent when someone enters a message.
            intPrivateMessage = CInt(GetNextField(True))
            strFromuser = GetNextField()
            strMessage = GetNextField()
            UpdateDialog intPrivateMessage, strFromuser, strMessage, time()
        Case SCK_CODE_ACTIVITY
            intIndex = CInt(GetNextField(True))
            intActivity = CInt(GetNextField(True))
            UserArray(intIndex).ActivityStatus = intActivity
            DisplayUserActivity intActivity, intIndex
            If UserArray(intIndex).ActivityNotifier And intActivity = PCActive Then
                UserArray(intIndex).ActivityNotifier = False
                strTmpText = ConstructNickAndFullname(intIndex) & " " & GetText(244) 'text: has become active.
                strTmpText = strTmpText & vbCrLf & vbCrLf & GetText(246) & " " & FormatDateTime(Now(), vbGeneralDate) 'Text: Time:
                MessageBox.MsgBox MOwner(), strTmpText, vbOKOnly + vbInformation, GetText(245) 'Text: Activitynotifier.
            End If
        Case SCK_CODE_FULLDRAWING
            ProcessDrawLine GetNextField()
        Case SCK_CODE_CHANGENAME
            intIndex = CInt(GetNextField(True))
            intNameChangeType = CInt(GetNextField(True))
            strHlpString = GetNextField()
            Select Case intNameChangeType
            Case 0
                strTmpText = GetText(251) 'Text: changed nickname and fullname to
                UpdateDialog1Line strHlpString & " " & strTmpText & " " & ConstructNickAndFullname(intIndex)
            Case 1
                strTmpText = GetText(252) 'Text: changed nickname to
                UpdateDialog1Line strHlpString & " " & strTmpText & " " & UserArray(intIndex).Nickname
            Case 2
                strTmpText = GetText(253) 'Text: changed fullname to
                UpdateDialog1Line strHlpString & " " & strTmpText & " " & UserArray(intIndex).Fullname
            Case Else
                err.Raise 5000, "ProcessDataClient", "Unknown NameChangeType=" & intNameChangeType
            End Select
        Case SCK_CODE_LOSTCONNECTION
            intIndex = CInt(GetNextField(True))
            UpdateDialog1Line ConstructNickAndFullname(intIndex) & " " & GetText(103) 'Text: lost the connection to the chatserver.
            'Remove their name from the name list.
            RemoveName intIndex
            ResetUser intIndex
        Case SCK_CODE_CONNECTION_ACCEPTED
            intMyClient = CInt(GetNextField(True))
            strTmpDate = GetNextField()
            strTmpText = GetText(218) 'Text: Welcome to ChatTool. The Chatserver is started %2 %1 (%3)
            strTmpText = Replace$(strTmpText, "%1", Format$(strTmpDate, "D"))
            strTmpText = Replace$(strTmpText, "%2", GetMonthName(Format$(strTmpDate, "MM")))
            strTmpText = Replace$(strTmpText, "%3", Format$(strTmpDate, "YYYY"))
            UpdateDialog3Lines strTmpText
            blnIsJoined = True
            ConnectionOKGUI
        Case SCK_CODE_CLEAR_DRAW
            'This command is sent when someone presses the Clear button to clear the picture box.
            picDraw.Cls
            picDraw.BackColor = GetNextField(True)
            intIndex = CInt(GetNextField(True))
            If intIndex <> -1 Then
                UpdateDialog1Line ConstructNickAndFullname(intIndex) & " " & GetText(144) 'Text: cleared the drawboard.
            End If
        Case SCK_CODE_DISCONNECTED
            'This command is received when the server notifies someone that someone else has disconnected.
            intIndex = CInt(GetNextField(True))
            UpdateDialog1Line ConstructNickAndFullname(intIndex) & " " & GetText(129) 'Text: disconnected.
            'Reset their name in the name list.
            RemoveName intIndex
            ResetUser intIndex
        Case SCK_CODE_JOINED
            strTmpText = GetText(201) 'Text: joined.
            UpdateDialog1Line GetNextField() & " " & strTmpText
        Case SCK_CODE_DENIEDCONNECT 'deniedconnectype;
            Select Case GetNextField()
            Case "NICKNAME_USED"
                strTmpText = GetText(202) 'Text: Nickname %1 is already in use.
                strTmpText = Replace$(strTmpText, "%1", txtNickname.Text)
                UpdateDialog1Line strTmpText
            Case "WRONG_PROTOCOL"
                strTmpText = GetText(239) 'Text: Wrong communication protocol. The chatserver uses protocol: %1.
                strTmpText = Replace$(strTmpText, "%1", GetNextField())
                UpdateDialog1Line strTmpText
            Case "SERVERFULL"
                strTmpText = GetText(241) 'Text: The chatserver is full (%1 users).
                strTmpText = Replace$(strTmpText, "%1", GetNextField())
                UpdateDialog1Line strTmpText
            Case Else
                strTmpText = GetText(242) 'Text: Connection is denied.
                UpdateDialog1Line strTmpText
            End Select
            DisconnectFromServer False
        Case SCK_CODE_KICKED 'usernumber;
            'First the server send a kick comannd to a client, which updates the dialog and retuns an
            'accept for the kick. The server then closes the connection.
            intUser = CInt(GetNextField(True))
            If intUser = intMyClient Then
                blnKicked = True
                blnRunCheckConnectionsAliveTimer = False
                SendToSERVER SCK_CODE_KICKED & CStr(intMyClient) & ";"
                strTmpText = GetText(210) 'Text: You were kicked.
                UpdateDialog1Line strTmpText
            Else
                strTmpText = GetText(203) 'Text: was kicked.
                UpdateDialog1Line ConstructNickAndFullname(intUser) & " " & strTmpText
            End If
            'Remove their name from the name list.
            RemoveName intUser
            ResetUser intIndex
        Case SCK_CODE_SERVERINFO
            strHlpString = GetNextField() 'Textid.
            UpdateDialog1Line GetText(CLng(strHlpString))
        Case SCK_CODE_NEW_NAME_LIST
            'This command is sent by the server before refreshing the name list.
            lstConnections.Clear
        Case SCK_CODE_PEOPLE
            intIndex = GetNextField(True)
            If intIndex >= UBound(UserArray()) Then
                ReDim Preserve UserArray(intIndex + 10)
            End If
            UserArray(intIndex).UserID = GetNextField()
            UserArray(intIndex).Nickname = GetNextField()
            UserArray(intIndex).Fullname = GetNextField()
            UserArray(intIndex).ActivityStatus = GetNextField()
            blnShowUser = True
            If GetNextField() = "Server" Then
                UserArray(intIndex).IsTheServer = True
                'If 'Server' an extra field is delivered, with info on the
                'blnSettingsServerVisibleToClients setting from the chatserver.
                If GetNextField() = "0" Then
                    blnShowUser = False
                End If
            Else
                UserArray(intIndex).IsTheServer = False
            End If
            If blnShowUser Then
                AddName intIndex, ConstructNickAndFullname(intIndex) & IIf(UserArray(intIndex).IsTheServer, " (S)", "")
                DisplayUserActivity UserArray(intIndex).ActivityStatus, intIndex
            End If
        Case SCK_CODE_USERINFO
            'We receive information on an online user
            Load frmUserInfo
            frmUserInfo.strActualServerTime = GetNextField()
            frmUserInfo.strChatname = GetNextField()
            frmUserInfo.strFullName = GetNextField()
            frmUserInfo.strUserName = GetNextField()
            frmUserInfo.strPCName = GetNextField()
            frmUserInfo.strConnectionTime = GetNextField()
            frmUserInfo.strLastActiveChatToolTime = GetNextField()
            frmUserInfo.strPCInactivityTime = GetNextField()
            frmUserInfo.Init
        Case SCK_CODE_ONLINEMESSAGE
            strMessage = GetNextField()
            intEmoticon = CInt(GetNextField(True))
            sinFontSize = CSng(GetNextField(True))
            lngFontColor = CLng(GetNextField(True))
            intUser = CInt(GetNextField(True))
            ShowOnlineMessage strMessage, intEmoticon, sinFontSize, lngFontColor, intUser
        Case SCK_CODE_DRAW_TEXT
            lngFontColor = CLng(GetNextField(True))
            sinFontSize = CInt(GetNextField(True))
            lngTopPos = CLng(GetNextField(True))
            lngLeftPos = CLng(GetNextField(True))
            strMessage = Replace$(GetNextField(), "\{vbCrlf}", vbCrLf)
            DrawText lngFontColor, sinFontSize, lngTopPos, lngLeftPos, strMessage
        Case SCK_CODE_DATESHIFT
            strTmpDate = GetNextField()
            strTmpText = GetText(235) 'Text: Dateshift to %2 %1 (%3).
            strTmpText = Replace$(strTmpText, "%1", GetMonthName(Format$(strTmpDate, "MM")))
            strTmpText = Replace$(strTmpText, "%2", Format$(strTmpDate, "D"))
            strTmpText = Replace$(strTmpText, "%3", Format$(strTmpDate, "YYYY"))
            UpdateDialog3Lines strTmpText
    End Select
   
    'Remove the processed command from the data stream.
    vsString = Mid$(vsString, InStr(1, vsString, vbCrLf) + 2, Len(vsString))
Loop
    strSlackString = vsString
Exit Sub
err:
    DebugLog "ERR - frmChatTool - ProcessDataClient - data=" & vsString & " - " & err.Description & " - " & err.Number
End Sub

Private Function GetFirstField(strFirstField As String) As String
    intRecievePointer = 1
    strReceiveString = strFirstField
    GetFirstField = GetNextField()
End Function

Private Function GetNextField(Optional blnIsValue As Boolean = False) As String
On Error GoTo err:
    Dim i As Integer
    i = intRecievePointer
    intRecievePointer = InStr(intRecievePointer, strReceiveString, ";")
    If intRecievePointer = 0 Then
        If blnIsValue Then
            GetNextField = "0"
        Else
            GetNextField = ""
        End If
        intRecievePointer = 32000
    Else
        GetNextField = Mid$(strReceiveString, i, intRecievePointer - i)
        GetNextField = Replace$(GetNextField, "\{Semicolon}", ";")
    End If
    intRecievePointer = intRecievePointer + 1
    Exit Function
err:
    DebugLog "ERR - frmChatTool - GetNextField - " & err.Description & " - " & err.Number
    GetNextField = ""
End Function

Private Sub UnpackDrawString()
On Error GoTo err:
    Dim lngColor As Long
    Dim intTmpPenSize As Integer
    Dim intNumberOfXYPairs As Integer
    Dim fromX As Integer
    Dim fromY As Integer
    Dim toX As Integer
    Dim toY As Integer
    Dim i As Integer
   
    lngColor = CLng(GetNextField(True))
    intTmpPenSize = CInt(GetNextField())
    intNumberOfXYPairs = CInt(GetNextField(True))
    fromX = CInt(GetNextField(True))
    fromY = CInt(GetNextField(True))
    toX = fromX
    toY = fromY
   
    picDraw.DrawWidth = intTmpPenSize
    picDraw.Line (fromX, fromY)-(toX, toY), lngColor
   
    For i = 1 To intNumberOfXYPairs - 1
        toX = CInt(GetNextField(True))
        toY = CInt(GetNextField(True))
        picDraw.Line (fromX, fromY)-(toX, toY), lngColor
        fromX = toX
        fromY = toY
    Next i
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - UnpackDrawString - " & err.Description & " - " & err.Number
End Sub

Public Function ConstructNickAndFullname(intUser As Integer) As String
    ConstructNickAndFullname = UserArray(intUser).Nickname & " - " & UserArray(intUser).Fullname
End Function

Private Sub bgCmdClearDraw_Click()
On Error GoTo err:
    picDraw.Cls
    If CtrlKeyPressed() Then
        If blnIsServer Then
            'If you are the server, send the command to all open connections.
            SendToAllButOriginator SCK_CODE_CLEAR_DRAW & CStr(lngDrawColor) & ";" & CStr(Server) & ";", Server
        Else
            'If you are connected to the server, send the command to the server.
            SendToSERVER SCK_CODE_CLEAR_DRAW & CStr(lngDrawColor) & ";"
        End If
        'Give the box the selected background-color.
        picDraw.BackColor = lngDrawColor
    Else
        If blnIsServer Then
            'If you are the server, send the command to all open connections.
            SendToAllButOriginator SCK_CODE_CLEAR_DRAW & CStr(vbWhite) & ";" & CStr(Server) & ";", Server
        Else
            'If you are connected to the server, send the command to the server.
            SendToSERVER SCK_CODE_CLEAR_DRAW & CStr(vbWhite) & ";"
        End If
        'Give the the box a white background color.
        picDraw.BackColor = vbWhite
    End If
   
    If blnIsConnected Then
        If blnIsServer Then
            UpdateDialog1Line ConstructNickAndFullname(Server) & " " & GetText(144) 'Text: cleared the drawboard.
        Else
            UpdateDialog1Line ConstructNickAndFullname(intMyClient) & " " & GetText(144) 'Text: cleared the drawboard.
        End If
    End If
   
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - bgCmdClearDraw_Click - " & err.Description & " - " & err.Number
End Sub

Public Sub SendChangeName(strOldName As String, intNameChangeType As Integer)
On Error GoTo err:
    If blnIsServer Then
        UserArray(Server).Nickname = txtNickname.Text
        UserArray(Server).Fullname = strFullName
        RemoveName Server
        AddName Server, ConstructNickAndFullname(Server) & " (S)" 'Server user is active. No reason the refresh the activity.
        If blnSettingsServerVisibleToClients Then
            SendUserList
            SendToAll SCK_CODE_CHANGENAME & CStr(Server) & ";" & CStr(intNameChangeType) & ";" & strOldName & ";"
        End If
    Else
        UserArray(intMyClient).Nickname = txtNickname.Text
        UserArray(intMyClient).Fullname = strFullName
        RemoveName intMyClient
        AddName intMyClient, ConstructNickAndFullname(intMyClient) 'Client user is active. No reason the refresh the activity.
        SendToSERVER SCK_CODE_CHANGENAME & CStr(intNameChangeType) & ";" & txtNickname.Text & ";" & strFullName & ";"
    End If
    Select Case intNameChangeType
        Case 0
            strTmpText = GetText(251) 'Text: changed name to
            If blnIsServer Then
                UpdateDialog1Line strOldName & " " & strTmpText & " " & ConstructNickAndFullname(Server)
            Else
                UpdateDialog1Line strOldName & " " & strTmpText & " " & ConstructNickAndFullname(intMyClient)
            End If
        Case 1
            strTmpText = GetText(252) 'Text: changed nickname to
            UpdateDialog1Line strOldName & " " & strTmpText & " " & txtNickname.Text
        Case 2
            strTmpText = GetText(253) 'Text: changed fullname to
            UpdateDialog1Line strOldName & " " & strTmpText & " " & strFullName
    End Select
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - SendChangeName - " & err.Description & " - " & err.Number
End Sub

Public Sub SendServerVisibilityStatus()
       
    If Not blnSettingsServerVisibleToClients Then
        If lstConnections.ListCount <= 1 Then
            UpdateDialog1Line GetText(259) 'Text: The chatserver user will not be visible in the users list on the future clients
            Exit Sub
        End If
       
        'Text: The chatserver user is no longer visible in the users list
        SendToAll SCK_CODE_SERVERINFO & "255" & ";"
        strTmpText = GetText(257) 'Text: The chatserver user is no longer visible in the users list on the clients
        UpdateDialog1Line strTmpText
    Else
        If lstConnections.ListCount <= 1 Then
            UpdateDialog1Line GetText(260) 'Text: The chatserver user be visible in the users list on the future clients
            Exit Sub
        End If
      
        'Text: The chatserver user has become visible in the users list
        SendToAll SCK_CODE_SERVERINFO & "256" & ";"
        strTmpText = GetText(258) 'Text: The chatserver user has become visible in the users list on the clients
        UpdateDialog1Line strTmpText
    End If
End Sub

Public Sub SendOnlineMessageToServer(strText As String, strReceivers As String, intEmoticon As Integer, sinFontSize As Single, lngFontColor As Long)
    On Error GoTo err:
    SendToSERVER SCK_CODE_ONLINEMESSAGE & PackSend(strText) & ";" & CStr(intEmoticon) & ";" & CStr(sinFontSize) & ";" & CStr(lngFontColor) & ";" & strReceivers & ";"
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - SendOnlineMessageToServer - " & err.Description & " - " & err.Number
End Sub

Public Sub SendOnlineMessageToClient(strText As String, intEmoticon As Integer, sinFontSize As Single, lngFontColor As Long, intConnection As Integer)
    On Error GoTo err:
    SendToPerson SCK_CODE_ONLINEMESSAGE & PackSend(strText) & ";" & CStr(intEmoticon) & ";" & CStr(sinFontSize) & ";" & CStr(lngFontColor) & ";" & CStr(intConnection), intConnection
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - SendOnlineMessageToClient - " & err.Description & " - " & err.Number
End Sub

Private Sub DisplayUserActivity(ActivityLevel As enuPCActivity, intConnection As Integer)
On Error GoTo err:
    Dim i As Integer
   
    For i = lstConnections.ListCount - 1 To 0 Step -1
        If lstConnections.ItemData(i) = intConnection Then
            Select Case ActivityLevel
            Case PCActive
                strTmpText = ""
            Case PCInactive
                If UserArray(intConnection).ActivityNotifier Then
                    strTmpText = " [" & GetText(205) & "]" 'Text: Inactive
                Else
                    strTmpText = " (" & GetText(205) & ")" 'Text: Inactive
                End If
            Case PCAway
                If UserArray(intConnection).ActivityNotifier Then
                    strTmpText = " [" & GetText(206) & "]" 'Text: Away
                Else
                    strTmpText = " (" & GetText(206) & ")" 'Text: Away
                End If
            Case Else
                err.Raise 5000, , "Unknown ActivityLevel=" & ActivityLevel
            End Select
           
            If blnIsServer Then
                lstConnections.List(i) = ConstructNickAndFullname(intConnection) & _
                        IIf(intConnection = Server, " (S)", "") & strTmpText
            Else
                lstConnections.List(i) = ConstructNickAndFullname(intConnection) & _
                    IIf(UserArray(intConnection).IsTheServer, " (S)", "") & strTmpText
            End If
        End If
    Next i
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - DisplayUserActivity - " & err.Description & " - " & err.Number
End Sub

Private Sub Form_Load()
    HookDetachAddTaskbarItem
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim MsgBoxResult As VbMsgBoxResult
    If UnloadMode = vbFormCode Then ' The Unload statement is invoked from code.
        If blnIsServer Then
            If lstConnections.ListCount > 1 Then
                strTmpText = GetText(207) 'Text: There are clients connected to the chatserver\n\nDo you still wish to stop the server?
                MsgBoxResult = MessageBox.MsgBox(MOwner(), strTmpText, vbYesNo + vbQuestion)
                If MsgBoxResult = vbYes Then
                    Cancel = False
                Else
                    Cancel = True
                End If
            End If
        ElseIf blnIsJoined Then
            strTmpText = GetText(208) 'Text: ChatTool is connected to a chatserver!\n\nDo you still wish to exit ChatTool?
            MsgBoxResult = MessageBox.MsgBox(MOwner(), strTmpText, vbYesNo + vbQuestion)
            If MsgBoxResult = vbYes Then
                Cancel = False
            Else
                Cancel = True
            End If
        End If
    Else
        Cancel = False
    End If
End Sub

Private Sub imgTintin_DblClick()
    ActivateMiniChat
End Sub

Private Sub imgTintin_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If blnAppHasFocus Then
        WindowMove Me
    End If
End Sub

Private Sub Label1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    picMenu_MouseMove Button, Shift, 0, 0
End Sub

Private Sub lblFontSizeLetter_DblClick()
    picPensize_Click
End Sub

Private Sub lblFontSizeLetter_Click()
    picPensize_Click
End Sub

Private Sub lblInvisible_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    'This label is placed in the top left corner, where the small circle is.
    If Button = vbRightButton Then
        Me.Visible = False
        If strPassword <> "" Then blnWM_SHOWWINDOW_Allowed = False
    Else
        Me.WindowState = vbMinimized
    End If
End Sub

Private Sub lblmenu_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    picMenubar_MouseMove Button, Shift, 0, 0
End Sub

Private Sub lblTextSelect_Click()
On Error GoTo err:
    Dim strSendText As String
    If Not blnIsConnected Then Exit Sub
    If blnTextDraw Then
        picDraw.MouseIcon = LoadResPicture(102, vbResCursor)
        blnTextDraw = False
        DrawText lngDrawColor, txtPicDraw.FontSize, txtPicDraw.Top, txtPicDraw.Left, txtPicDraw.Text
        txtPicDraw.Visible = False
        strSendText = Replace(txtPicDraw.Text, vbCrLf, "\{vbCrlf}")
        If blnIsServer Then
            'If you are the server, send the command to all open connections.
            SendToAllButOriginator SCK_CODE_DRAW_TEXT & CStr(lngDrawColor) & ";" & CStr(txtPicDraw.FontSize) & ";" & CStr(txtPicDraw.Top) & ";" & CStr(txtPicDraw.Left) & ";" & strSendText & ";", Server
        Else
            'If you are connected to the server, send the command to the server.
            SendToSERVER SCK_CODE_DRAW_TEXT & CStr(lngDrawColor) & ";" & CStr(txtPicDraw.FontSize) & ";" & CStr(txtPicDraw.Top) & ";" & CStr(txtPicDraw.Left) & ";" & strSendText & ";"
        End If
        txtPicDraw.Text = ""
        lblPicDraw.Caption = "M"
        lblTextSelect.BackStyle = 0
        lblFontSizeLetter.Visible = False
        linePensize.Visible = True
    Else
        picDraw.MouseIcon = LoadResPicture(101, vbResCursor) 'Text cursor
        blnTextDraw = True
        txtPicDraw.Width = lblPicDraw.Width
        txtPicDraw.Height = lblPicDraw.Height
        lblTextSelect.BackStyle = 1
        If lngDrawColor = 15921906 Then
            txtPicDraw.BackColor = 12632319
        Else
            txtPicDraw.BackColor = 15921906 'Almost white
        End If
        setFontSize
        lblFontSizeLetter.Visible = True
        linePensize.Visible = False
    End If
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - lblTextSelect_Click - " & err.Description & " - " & err.Number
End Sub

Private Sub txtPicDraw_KeyDown(KeyCode As Integer, Shift As Integer)
    If txtPicDraw.Visible = True Then
        lblPicDraw.Caption = txtPicDraw.Text & "M"
        txtPicDraw.Width = lblPicDraw.Width
        txtPicDraw.Height = lblPicDraw.Height
    End If
End Sub

Private Sub txtPicDraw_KeyUp(KeyCode As Integer, Shift As Integer)
    If txtPicDraw.Visible = True Then
        lblPicDraw.Caption = txtPicDraw.Text & "M"
        txtPicDraw.Width = lblPicDraw.Width
        txtPicDraw.Height = lblPicDraw.Height
    End If
End Sub

Private Sub bgCmdSendMessage_Click()
    frmNetMessage.Init
    frmNetMessage.Show vbModal
End Sub

Public Sub ServerStop()
On Error GoTo err:
    Dim i As Integer
    Dim msgResult As VbMsgBoxResult

    'The server are allways in the the list.
    If lstConnections.ListCount > 1 Then
        strTmpText = GetText(207) 'Text: There are clients connected to the chatserver\n\nDo you still wish to stop the server?
        msgResult = MessageBox.MsgBox(Me, strTmpText, vbYesNo + vbQuestion)
        If msgResult = vbNo Then
            Exit Sub
        End If
    End If
   
    If Not blnRunningOnOkWinsckOcx Then
        Set mSendList = Nothing
    End If
   
    'Close all connections.
    For i = 0 To miNumConnections
        sckClient(i).Close
    Next i
   
    strTmpText = GetText(209) 'The chatserver is stopped %1 %2 (%3)
    strTmpText = Replace$(strTmpText, "%1", GetMonthName(Format$(Date, "MM")))
    strTmpText = Replace$(strTmpText, "%2", Format$(Date, "D"))
    strTmpText = Replace$(strTmpText, "%3", Format$(Date, "YYYY"))
    UpdateDialog1Line strTmpText
   
    blnIsServer = False
   
    blnRunCheckConnectionsAliveTimer = False
    'Hide/show certain controls because a connection is being closed.
    CloseConnectionGUI
   
    Exit Sub
err:
    CloseConnectionGUI
    blnRunCheckConnectionsAliveTimer = False
    DebugLog "ERR - frmChatTool - ServerStop - " & err.Description & " - " & err.Number
End Sub

Public Sub ServerStart()
On Error GoTo err:
    Dim msgResult As VbMsgBoxResult
    Dim intRes As Integer
   
    If Not blnIsServer Then
        intRes = 0
        Load frmUserProfile
        If Not blnUserProfileShownAtLeastOnce Or frmUserProfile.Init_IsFullNameChanged Then
            intRes = frmUserProfile.Init_StartServer()
            If frmUserProfile.blnOkButtonPressed Then
                blnUserProfileShownAtLeastOnce = True
            End If
        End If
        Unload frmUserProfile
        DoEvents
        If intRes <> 0 Then
            Exit Sub
        End If
       
        If txtNickname.Text = "" Then 'This check also exits in frmUserProfile.
            strTmpText = GetText(135) 'Text: The nickname must not be empty.
            frmChatTool.MessageBox.MsgBox Me, strTmpText, vbInformation + vbOKOnly
            txtNickname.SetFocus
            Exit Sub
        End If
       
        txtNickname.Text = Trim$(txtNickname.Text)
        PutRegistrySetting "Nickname", txtNickname.Text
       
        datActualDate = Date 'Has to be placed here, because of the dateshifttimer.
               
        'Hide/show certain controls because a connection is being opened.
        OpenConnectionGUI
       
        ReDim UserArray(intMaxUsers) 'Creates intMaxUsers + 1 elements in the array.
       
        blnRunCheckConnectionsAliveTimer = True
       
        'You are the server.
        blnIsServer = True
       
        'Close the Winsock control that allows you to connect to a server.
        sckServer.Close
       
        'Reset the Winsock control that listens for connections.
        sckClient(Server).Close
        sckClient(Server).LocalPort = lngPort
        sckClient(Server).Listen
       
        'Update the status.
        strServerStartTime = time()
        datServerStartDate = Date
        strTmpText = GetText(211) 'The ChatServer is started %2 %1 (%3) on TCP/IP port %4.
        strTmpText = Replace$(strTmpText, "%1", Format$(datServerStartDate, "D"))
        strTmpText = Replace$(strTmpText, "%2", GetMonthName(Format$(datServerStartDate, "MM")))
        strTmpText = Replace$(strTmpText, "%3", Format$(datServerStartDate, "YYYY"))
        strTmpText = Replace$(strTmpText, "%4", CStr(lngPort))
        UpdateDialog3Lines strTmpText
       
        If Not blnSettingsServerVisibleToClients Then
            UpdateDialog1Line GetText(259) 'Text: The chatserver user will not be visible in the users list on the future clients
        End If
       
        'Server=0 is used for the server itself.
        UserArray(Server).UserID = strUserName
        UserArray(Server).IsConnected = True
        UserArray(Server).Fullname = strFullName
        UserArray(Server).Nickname = txtNickname.Text
        UserArray(Server).LastActive = Format$(Now, "YYYY-MM-DD HH:MM:SS")
        UserArray(Server).ConnectionTime = Format$(Now, "YYYY-MM-DD HH:MM:SS")
        UserArray(Server).PCName = GetPCName()
       
        txtServername.Text = UserArray(Server).PCName
          
        strDisplayName = ConstructNickAndFullname(Server) & " (S)"
        lstConnections.AddItem strDisplayName
        lstConnections.ItemData(Server) = Server
       
        txtServername.Locked = True
           
        ConnectionOKGUI
       
        picDraw.Enabled = True
        blnIsJoined = True
       
        txtSend.SetFocus
    End If
   
    Exit Sub
err:
    strTmpErrDescription = err.Description
    CloseConnectionGUI
    blnIsServer = False
    blnRunCheckConnectionsAliveTimer = False
    MessageBox.MsgBox Me, "Error: " & strTmpErrDescription, vbCritical
    sckClient(Server).Close
    DebugLog "ERR - frmChatTool - ServerStart = " & strTmpErrDescription
End Sub

Private Sub SendUserInformation(ParConnection As Integer, i As Integer)
On Error GoTo err:

    If ParConnection = Server Then
        Load frmUserInfo
        frmUserInfo.strActualServerTime = Format$(Now, "YYYY-MM-DD HH:MM:SS")
        frmUserInfo.strChatname = UserArray(i).Nickname
        frmUserInfo.strFullName = UserArray(i).Fullname
        frmUserInfo.strUserName = UserArray(i).UserID
        frmUserInfo.strPCName = UserArray(i).PCName
        frmUserInfo.strConnectionTime = UserArray(i).ConnectionTime
        frmUserInfo.strPCInactivityTime = UserArray(i).InactiveSince
        frmUserInfo.strLastActiveChatToolTime = UserArray(i).LastActive
        frmUserInfo.Init
    Else
        SendToPerson SCK_CODE_USERINFO & Format$(Now, "YYYY-MM-DD HH:MM:SS") & ";" & PackSend(UserArray(i).Nickname) _
            & ";" & PackSend(UserArray(i).Fullname) & ";" & PackSend(UserArray(i).UserID) & ";" & PackSend(UserArray(i).PCName) & ";" & UserArray(i) _
                .ConnectionTime & ";" & UserArray(i).LastActive & ";" & UserArray(i).InactiveSince & ";", ParConnection
    End If
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - SendUserInformation - " & err.Description & " - " & err.Number
End Sub

Private Sub KickUser()
On Error GoTo err:
Dim i As Integer
Dim j As Integer
Dim MsgBoxResult As VbMsgBoxResult
    i = lstConnections.ListIndex
   
    strTmpText = GetText(247) 'Text: Do you want to kick:
    strTmpText = strTmpText & vbCrLf & vbCrLf & ConstructNickAndFullname(lstConnections.ItemData(i))
   
    MsgBoxResult = MessageBox.MsgBox(MOwner(), strTmpText, vbYesNo + vbQuestion)
    If MsgBoxResult = vbNo Then
        Exit Sub
    End If
   
    If lstConnections.ItemData(i) <> Server Then
        'When a selected name is found, nofity all open connections that this person was kicked.
        'We do not send this information to the user being kicked.
        For j = 0 To lstConnections.ListCount - 1
            If lstConnections.ItemData(j) <> Server Then
                If sckClient(lstConnections.ItemData(j)).State = sckConnected Then
                    SendToPerson SCK_CODE_KICKED & CStr(lstConnections.ItemData(i)) & ";", lstConnections.ItemData(j)
                End If
            End If
        Next j
    End If
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - KickUser - " & err.Description & " - " & err.Number
End Sub

Public Sub bgCmdSend_Click()
On Error GoTo err:
    lngLastScrollTimeRtbDialog = -1 'Enable text scroll

    'If the string begins with a #, the string is a command.
    If Len(Trim$(txtSend.Text)) > 0 Then
        If Mid$(Trim$(txtSend.Text), 1, 1) = "#" Then
            ProcessCommandLine
            txtSend.Text = ""
            Exit Sub
        End If
    End If
   
    If Trim$(txtSend.Text) = "" Or Not blnIsJoined Then
        txtSend.Text = ""
        Exit Sub
    End If
   
    SendToHistory txtSend.Text
   
    SendTextMessage txtSend.Text
   
    txtSend.Text = ""
    If Not tmrDebugStress.Enabled And Me.Visible Then
        txtSend.SetFocus
    End If
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - bgCmdSend_Click - " & err.Description & " - " & err.Number
End Sub

Private Sub SendTextMessage(strMessage As String)
On Error GoTo err:
    Dim i As Integer
    Dim intCount As Integer
    Dim sUsers As String
    Dim sName As String
    Dim intReceiversCounter As Integer
   
    If bgChkChatSelected.value = True Then
        intReceiversCounter = 0
        For i = 0 To lstConnections.ListCount - 1
            If lstConnections.Selected(i) = True Then
                intReceiversCounter = intReceiversCounter + 1
            End If
        Next i
    End If

    intCount = 0
    If blnIsServer Then
        'If you are the server, send the message to all open connections.
        If bgChkChatSelected.value = True Then
            'Private message - only for selected users.
            For i = 0 To lstConnections.ListCount - 1
                If lstConnections.Selected(i) = True Then
                    If lstConnections.ItemData(i) = Server And intReceiversCounter = 1 Then
                        strTmpText = GetText(243) 'Text: You can not chat to yourself.
                        UpdateDialog1Line strTmpText
                        Exit Sub
                    End If
                    'Do not send message to SERVER.
                    If lstConnections.ItemData(i) <> Server Then
                        SendToPerson SCK_CODE_MESSAGE & "1;" & PackSend(UserArray(Server).Nickname) & ";" & PackSend(strMessage) & ";", lstConnections.ItemData(i)
                        intCount = intCount + 1
                        'Who did we send to?
                        sName = UserArray(lstConnections.ItemData(i)).Nickname
                    End If
                End If
            Next i
            If intCount = 0 Then
                strTmpText = GetText(213) 'Text: None has been selected to receive the message.
                UpdateDialog1Line strTmpText
                Exit Sub
            End If
        Else
            UserArray(Server).LastActive = Format$(Now, "YYYY-MM-DD HH:MM:SS")
            'Message is for all users.
            SendToAll SCK_CODE_MESSAGE & "0;" & PackSend(UserArray(Server).Nickname) & ";" & PackSend(strMessage) & ";"
        End If
    Else
        'If you are connected to a server, send the message to the server.
        If bgChkChatSelected.value = True Then
            'Private message - only for selected users.
            'See who is selected in the list box and send message to them.
            For i = 0 To lstConnections.ListCount - 1
                If lstConnections.Selected(i) = True Then
                    If lstConnections.ItemData(i) = intMyClient Then
                        If intReceiversCounter = 1 Then
                            strTmpText = GetText(243) 'Text: You can not chat to yourself.
                            UpdateDialog1Line strTmpText
                            Exit Sub
                        End If
                   
                    Else
                        'Create string of list of users message will be delivered to.
                        'This string will be parsed by the server, which will redirect the message.
                        sUsers = sUsers & CStr(lstConnections.ItemData(i)) & ";"
                        'Increment count of users message is being sent to.
                        intCount = intCount + 1
                        sName = UserArray(lstConnections.ItemData(i)).Nickname
                    End If
                End If
            Next i
           
            'If list is not empty, send message to server
            If intCount > 0 Then
                SendToSERVER SCK_CODE_PRIVATE_MESSAGE & PackSend(txtNickname.Text) & ";" & CStr(intCount) & ";" & _
                    PackSend(strMessage) & ";" & sUsers & ";"
            Else
                strTmpText = GetText(213) 'Text: None has been selected to receive the message.
                UpdateDialog1Line strTmpText
                Exit Sub
            End If
        Else
            'Message is for all users.
            SendToSERVER SCK_CODE_MESSAGE & "0;" & PackSend(txtNickname) & ";" & PackSend(strMessage) & ";"
        End If
    End If
   
    'Update the message dialog.
    If bgChkChatSelected.value = True Then
        If intCount = 1 Then
            strTmpText = GetText(214) 'Text: To
            UpdateDialog 1, strTmpText & " " & sName, strMessage, time()
        Else
            strTmpText = GetText(215) 'Text: To (more)
            UpdateDialog 1, strTmpText, strMessage, time()
        End If
    Else
        UpdateDialog 0, txtNickname, strMessage, time()
    End If
   
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - SendTextMessage - " & err.Description & " - " & err.Number
End Sub

Private Sub ProcessCommandLine()
On Error GoTo err:
    Dim i As Integer
    Dim strCommand As String
    Dim Arg As String
   
    txtSend.Text = Trim$(txtSend.Text)
    i = InStr(1, txtSend.Text, " ")
    If i = 0 Then
        i = Len(txtSend.Text)
    End If
    strCommand = Trim$(UCase(Mid$(txtSend, 2, i - 1)))
    Select Case strCommand
    'Command flags
    Case "DEBUGCOM"
        Arg = GetArg(i)
        Select Case Arg
        Case "1": blnDebugCom = True
        Case "0": blnDebugCom = False
        Case Else: GoTo ParameterError:
        End Select
    Case "DEBUGFOCUS"
        Arg = GetArg(i)
        Select Case Arg
        Case "1": blnDebugFocus = True
        Case "0": blnDebugFocus = False
        Case Else: GoTo ParameterError:
        End Select
    Case "DEBUGFILE"
        Arg = GetArg(i)
        Select Case Arg
        Case "1": blnDebugFile = True
        Case "0":
            If blnDebugFile Then
                DebugLog "ChatTool filelog ended: " & FormatDateTime(Now(), vbGeneralDate)
            End If
            blnDebugFile = False
        Case Else: GoTo ParameterError:
        End Select
        Arg = GetArg(i)
        If Arg = "" Then
            strDebugFilePath = App.Path & "\DebugLog.txt"
        Else
            strDebugFilePath = Arg
        End If
        If blnDebugFile Then
            DebugLog "ChatTool filelog started: " & FormatDateTime(Now(), vbGeneralDate)
        End If
    Case "DEBUGLOG"
        Arg = GetArg(i)
        Select Case Arg
        Case "1"
            txtDebugLog.Visible = True
            txtDebugLog.ZOrder 0
        Case "0"
            txtDebugLog.Visible = False
        Case Else: GoTo ParameterError:
        End Select
    Case "DEBUGALL"
        Arg = GetArg(i)
        Select Case Arg
        Case "1"
            blnDebugCom = True
            blnDebugFocus = True
            txtDebugLog.Visible = True
            txtDebugLog.ZOrder 0
        Case "0"
            blnDebugCom = False
            blnDebugFocus = False
            txtDebugLog.Visible = False
        Case Else: GoTo ParameterError:
        End Select
'    Case "DEBUGSTRESS" 'DISABLE FOR FINAL BUILDED VERSION
'        Arg = GetArg(i)
'        If IsNumeric(Arg) Then
'            If CLng(Arg) = 0 Then
'                tmrDebugStress.Enabled = False
'            Else
'                If blnIsJoined Then
'                    tmrDebugStress.interval = CLng(Arg)
'                    lngDebugStressCount = 0
'                    Arg = GetArg(i)
'                    If IsNumeric(Arg) Then
'                        intDebugStressMessageLength = CLng(Arg)
'                    End If
'                    tmrDebugStress.Enabled = True
'                End If
'            End If
'        Else
'            GoTo ParameterError:
'        End If
    Case "DEBUGCLS"
        txtDebugLog.Text = ""
    Case "CLRHIS"
        InitHistory
        Exit Sub 'Avoid the clear history command being send to history.
    Case "CLS"
        ClearMessageLog
    Case "QUIT"
        txtSend.Text = "" 'Looks better when a dialog is displayed whentrying to unload form.
        Unload Me
    Case "NEW"
        Shell App.Path & "\ChatTool.exe", vbHide
    Case "LOGLINES"
        Arg = GetArg(i)
        Select Case Arg
        Case "1": blnDisplayMesssageLog = True
        Case "0": blnDisplayMesssageLog = False
        Case Else: GoTo ParameterError:
        End Select
    Case "LINES"
        If lngLinesInMesssageLog = 1 Then
            strTmpText = GetText(142) 'Text: "There are 1 line in the messagelog"
            UpdateDialog1Line strTmpText
        Else
            strTmpText = GetText(143) 'Text: "There are %1 lines in the messagelog"
            strTmpText = Replace$(strTmpText, "%1", CStr(lngLinesInMesssageLog))
            UpdateDialog1Line strTmpText
        End If
'    Case "LOADPIC" 'Testing functionality - just for the fun of it.
'        Arg = GetArg(i)
'        On Error Resume Next
'        frmChatTool.picDraw = LoadPicture(App.Path & "" & Arg)
'        If err.Number <> 0 Then
'            UpdateDialog1Line err.Description
'        End If
'        On Error GoTo err:
    Case Else
        strTmpText = GetText(139) 'Text: Command error: Unknown command (%1)
        strTmpText = Replace$(strTmpText, "%1", "#" & strCommand)
        UpdateDialog1Line strTmpText
    End Select
       
    'Send the command to history. Regardless of the correctness of the statement.
    SendToHistory txtSend.Text

    Exit Sub
ParameterError:
    If Arg = "" Then
        strTmpText = GetText(140) 'Text: Command error: Missing argument
        UpdateDialog1Line strTmpText
    Else
        strTmpText = GetText(141) 'Text: Command error: Unknown argument (%1)
        strTmpText = Replace$(strTmpText, "%1", Arg)
        UpdateDialog1Line strTmpText
    End If
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - ProcessCommandline - " & err.Description & " - " & err.Number & " strCommand: " & strCommand
End Sub

Private Function GetArg(i As Integer) As String
On Error GoTo err:
Dim j As Integer
    i = i + 1
    j = i
    i = InStr(j, txtSend.Text, " ")
    If i = 0 Then
        i = Len(txtSend.Text)
    End If
    GetArg = Trim$((Mid$(txtSend, j, i - j + 1)))
    Exit Function
err:
    DebugLog "ERR - frmChatTool - GetArg - " & err.Description & " - " & err.Number & "txtSend=" & txtSend.Text
    GetArg = ""
End Function

Private Sub ConnectToServer()
On Error GoTo err:
    Dim intRes As Integer
    Dim strErrorDescription As String

    intRes = 0
    Load frmUserProfile
    If Not blnUserProfileShownAtLeastOnce Or frmUserProfile.Init_IsFullNameChanged Then
        intRes = frmUserProfile.Init_Connect()
        If frmUserProfile.blnOkButtonPressed Then
            blnUserProfileShownAtLeastOnce = True
        End If
    End If
    Unload frmUserProfile
    DoEvents
    If intRes <> 0 Then
        Exit Sub
    End If

    ReDim UserArray(10)

    txtNickname.Text = Trim$(txtNickname.Text)
    PutRegistrySetting "Nickname", txtNickname.Text
   
    If txtNickname.Text = "" Then '
        strTmpText = GetText(135) 'Text: The nickname must not be empty.
        frmChatTool.MessageBox.MsgBox Me, strTmpText, vbInformation + vbOKOnly
        txtNickname.SetFocus
        Exit Sub
    End If
   
    intMyClient = 0

    PutRegistrySetting "Server", txtServername.Text

    'Hide/show certain controls because a connection is being opened.
    OpenConnectionGUI
   
    'You are not the server.
    blnIsServer = False
    lngWinSckConnectAcceptTime = -1
   
    sckServer.Close 'Reset
    sckServer.RemotePort = lngPort
    sckServer.Connect txtServername.Text
   
    While Not sckServer.State = sckConnected
        DoEvents
        Debug.Print sckServer.State
        If Not blnIsConnected Then
            'We will have to terminate the loop somehow.
            'sckServer_Error is called if a connection error happens. It will make blnIsConnected false.
            Exit Sub
        End If
    Wend
   
    lngWinSckConnectAcceptTime = Int(Timer())
       
    SendToSERVER SCK_CODE_JOINED & PRODUCTPROTOCOL & ";" & PackSend(strUserName) & ";" _
         & PackSend(txtNickname) & ";" & PackSend(strFullName) & ";" & PackSend(GetPCName()) & ";", False
   
    blnRunCheckConnectionsAliveTimer = True
    txtSend.SetFocus
    Exit Sub
err:
    strErrorDescription = err.Description
    On Error Resume Next
    strTmpText = GetText(130) 'Text: Error during connect.\n\nError:
    strTmpText = strTmpText & " " & strErrorDescription
    MessageBox.MsgBox Me, strTmpText, vbExclamation
    DisconnectFromServer False
End Sub

Private Sub DisconnectFromServer(Optional blnShowDisconnectInDialog As Boolean = True)
On Error GoTo err:
    Dim strErrorDescription As String
   
    blnRunCheckConnectionsAliveTimer = False
   
    'Close all connections.
    sckServer.Close
   
    If blnShowDisconnectInDialog Then
        UpdateDialog1Line GetText(104) 'Text: You disconnected.
    End If
   
    txtServername.Locked = False
   
    If Not blnRunningOnOkWinsckOcx Then
        Set mSendList = Nothing
    End If
   
    CloseConnectionGUI
   
    Exit Sub
err:
    strErrorDescription = err.Description
    On Error Resume Next
    strTmpText = GetText(131) 'Text: Error during disconnect.\n\nError:
    strTmpText = strTmpText & " " & strErrorDescription
    MessageBox.MsgBox Me, err.Description, vbExclamation
    sckServer.Close
    CloseConnectionGUI
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As _
         Single, y As Single)
On Error GoTo err:
    'This procedure receives the callbacks from the System Tray icon.
    Dim Msg As Long

    'the value of X will vary depending upon the scalemode setting
    If Me.ScaleMode = vbPixels Then
        Msg = x
    Else
        Msg = x / Screen.TwipsPerPixelX
    End If
   
    Select Case Msg
    Case WM_LBUTTONUP
        IconInSystrayClicked
    Case Else
        If Button = vbLeftButton And y <> 0 Then
            If y <= intCloseHeight And x < intCloseLeft Then
                WindowMove Me
            End If
        End If
    End Select
    If Screen.MousePointer <> vbDefault Then Screen.MousePointer = vbDefault
   
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - Form_MouseMove - " & err.Description & " - " & err.Number
End Sub

Private Sub IconInSystrayClicked()
On Error GoTo err:
Dim result As Long
Static blnPasswordFormLoaded As Boolean 'Initially false
    If Not frmMiniChat.Visible And Not frmChatTool.Visible Then
        If strPassword <> "" Then
            'I use blnPasswordFormLoaded to avoid reloading the passwordform if
            'the user clicks on the systrayicon more than once.
            If Not blnPasswordFormLoaded Then
                Load frmPassword
                blnPasswordFormLoaded = True
                If Not frmPassword.RequestPassword() Then
                    Unload frmPassword
                    blnPasswordFormLoaded = False
                    Exit Sub
                End If
            Else
                frmPassword.Reset
                result = SetForegroundWindow(frmPassword.hwnd)
                Exit Sub
            End If
            Unload frmPassword
            blnPasswordFormLoaded = False
        End If
    End If
   
    If lngNumberOfUnreadMessages > 0 Then
        RemoveLightningIconInSysTray
        lngNumberOfUnreadMessages = 0
    End If
   
    If blnMiniChatActive And Not frmMiniChat.Visible Then
        ActivateMiniChat
        Exit Sub
    End If
   
    If Not Me.Visible And Not blnMiniChatActive Then
        Me.Visible = True
        If Me.WindowState = vbMinimized Then
           Me.WindowState = vbNormal
        End If
    Else
         Me.WindowState = vbNormal
    End If
    If blnFrmChatToolActive Then
        SetFocusAPI txtSend.hwnd
    End If
    result = SetForegroundWindow(Me.hwnd)
   
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - IconInSystrayClicked - " & err.Description & " - " & err.Number
End Sub

Private Sub lstConnections_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo err:
    Dim i As Integer
    If KeyCode = vbKeyA And CtrlKeyPressed() Then
        For i = 0 To lstConnections.ListCount - 1
            lstConnections.Selected(i) = True
        Next i
    End If
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - lstConnections_KeyDown - " & err.Description & " - " & err.Number
End Sub

Private Sub picColor_Click(Index As Integer)
    picSelColor.BackColor = picColor(Index).BackColor
    lngDrawColor = picColor(Index).BackColor
    txtPicDraw.ForeColor = picColor(Index).BackColor
    If lngDrawColor = 15921906 Then
        txtPicDraw.BackColor = 12632319
    Else
        txtPicDraw.BackColor = 15921906 'Almost white
    End If
End Sub

Private Sub picPensize_DblClick()
    picPensize_Click
End Sub

Private Sub picPensize_Click()
    If linePensize.Visible Then
        If intPenThickness >= 1 And intPenThickness < 18 Then
            intPenThickness = 19
            linePensize.BorderWidth = intPenThickness
        Else
            intPenThickness = 1
            linePensize.BorderWidth = intPenThickness
        End If
    Else
        If lblPicDraw.FontSize < 12.75 Then
            lblPicDraw.FontSize = 12.75
        Else
            lblPicDraw.FontSize = 8.25
        End If
        setFontSize
    End If
End Sub

Private Sub rtbDialog_GotFocus()
    BlnRtbDialogHasFocus = True
End Sub

Private Sub rtbDialog_LostFocus()
    BlnRtbDialogHasFocus = False
End Sub


Private Sub rtbDialog_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo err:
    Select Case KeyCode
    Case vbKeyUp, vbKeyDown, vbKeyPageUp, vbKeyPageDown
        lngLastScrollTimeRtbDialog = Int(Timer())
    Case vbKeyHome
        If CtrlKeyPressed() Then
            lngLastScrollTimeRtbDialog = Int(Timer())
        End If
    Case Else
    End Select
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - rtbDialog_KeyDown - " & err.Description & " - " & err.Number
End Sub


Private Sub sckServer_Error(ByVal Number As Integer, _
                            Description As String, _
                            ByVal Scode As Long, _
                            ByVal source As String, _
                            ByVal Helpfile As String, _
                            ByVal HelpContext As Long, _
                            CancelDisplay As Boolean)
    On Error Resume Next
    DisconnectFromServer False
    If Number = sckConnectionRefused Then
        strTmpText = GetText(216)  'Text: Impossible to create a connection to the chatserver %1 on TCP/IP port %2\n\nA possible reason is that the chatserver is not started.
        strTmpText = Replace$(strTmpText, "%1", txtServername)
        strTmpText = Replace$(strTmpText, "%2", CStr(lngPort))
        MessageBox.MsgBox MOwner(), strTmpText, vbExclamation + vbOKOnly, GetText(217) 'Text: ChatTool - Communication error
    Else
        MessageBox.MsgBox MOwner(), Number & " - " & Description, vbExclamation + vbOKOnly, GetText(217) 'Text: ChatTool - Communication error
    End If
    DebugLog "INFO - frmChatTool - sckServer_Error = " & Number & " - " & Description
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
    Dim i As Integer
    tmrTimeManager.Enabled = False
    tmrDebugStress.Enabled = False
    tmrOldSendData.Enabled = False
   
    If blnDebugFile Then
        DebugLog "ChatTool filelog ended: " & FormatDateTime(Now(), vbGeneralDate)
    End If
   
    'Close all connections.
    sckServer.Close
    For i = 1 To miNumConnections
        sckClient(i).Close
    Next i
   
    RemoveIconFromSystray
    
    If Not blnRunInDevEnvironment Then
        EndSubClassingFrmChatTool
        EndSubClassingFrmMiniChat
        EndSubClassingRtbDialog
        EndSubClassingRtbMiniDialog
        EndSubClassingRtbDialogMouseWheel
    End If
   
    HookDetachAddTaskbarItem
   
    If Not blnRunningOnOkWinsckOcx Then
        Set mSendList = Nothing
    End If
   
    DoEvents
   
    End 'Stop for good.
End Sub

Private Sub EscapeDrawingSequenze()
    'We only end here in a stuation where the blnIsDrawing = true.
    If linFollowLine.Visible Then
        linFollowLine.Visible = False
        linFollowLine.BorderStyle = 0 'Transparent
    Else
        picDraw_MouseUp vbLeftButton, 0, picDraw.CurrentX, picDraw.CurrentY
    End If
    blnIsDrawing = False
End Sub

Private Sub DrawText(lngFontColor As Long, sinFontSize As Single, lngTopPos As Long, lngLeftPos As Long, strMessage As String)
On Error GoTo err:
    Dim tempstr As String
    picDraw.ForeColor = lngFontColor
    picDraw.FontSize = sinFontSize
    picDraw.CurrentX = lngLeftPos
    picDraw.CurrentY = lngTopPos
    tempstr = strMessage
    Do While InStr(1, tempstr, vbCrLf) > 0
        picDraw.Print Mid(tempstr, 1, InStr(1, tempstr, vbCrLf) - 1)
        tempstr = Mid(tempstr, InStr(1, tempstr, vbCrLf) + 2)
        picDraw.CurrentX = lngLeftPos
    Loop
    picDraw.Print tempstr
    picDraw.Refresh
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - ApplyText - " & err.Description & " - " & err.Number
End Sub

Private Sub picDraw_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    On Error GoTo err:
    If blnIsDrawing Then
        EscapeDrawingSequenze
        Exit Sub
    End If
   
    If blnTextDraw Then
        If Button = vbLeftButton Then
            txtPicDraw.Visible = True
            txtPicDraw.SetFocus
            txtPicDraw.Left = x
            txtPicDraw.Top = y
        Else
            blnTextDraw = False
            txtPicDraw.Text = ""
            txtPicDraw.Visible = False
            lblTextSelect.BackStyle = 0
            picDraw.MouseIcon = LoadResPicture(102, vbResCursor) 'Brush cursor
           
        End If
    Else
        If Button = vbLeftButton Then
            picDraw.DrawWidth = intPenThickness
            picDraw.Line (x, y)-(x, y), lngDrawColor
        Else
            linFollowLine.X1 = x
            linFollowLine.X2 = x
            linFollowLine.Y1 = y
            linFollowLine.Y2 = y
            linFollowLine.Visible = True
            linFollowLine.BorderStyle = 1 'Solid
        End If
       
        sinDrawXmouse = x
        sinDrawYmouse = y
       
        strDrawString = CStr(x) & ";" & CStr(y) & ";"
        intNumberOfDrawingPairs = 1
       
        blnIsDrawing = True
    End If
  
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - picDraw_MouseDown- " & err.Description & " - " & err.Number
End Sub

Private Sub picDraw_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error GoTo err:
    Dim siX1 As String
    Dim siY1 As String
    Dim siX2 As String
    Dim siY2 As String
   
    If blnIsDrawing Then
        If Button = vbLeftButton Then
            'The mouse button is down and the mouse is moving over the drawing surface.
            picDraw.DrawWidth = intPenThickness
            picDraw.Line (sinDrawXmouse, sinDrawYmouse)-(x, y), lngDrawColor
            strDrawString = strDrawString & CStr(x) & ";" & CStr(y) & ";"
            intNumberOfDrawingPairs = intNumberOfDrawingPairs + 1
            'Remember where the mouse is so new lines can be drawn connecting to this point.
           
            If Len(strDrawString) > 1000 Then
                If blnIsServer Then
                    'If you are the server, send the info on the line to all open connections.
                    SendToAll SCK_CODE_DRAW & CStr(lngDrawColor) & ";" & CStr(intPenThickness) & ";" & _
                        CStr(intNumberOfDrawingPairs) & ";" & strDrawString
                Else
                    'If you are connected to the server, send the info on the line to the server.
                    SendToSERVER SCK_CODE_DRAW & CStr(lngDrawColor) & ";" & CStr(intPenThickness) & ";" & _
                        CStr(intNumberOfDrawingPairs) & ";" & strDrawString
                End If
                strDrawString = CStr(x) & ";" & CStr(y) & ";"
                intNumberOfDrawingPairs = 1
            End If
            sinDrawXmouse = x
            sinDrawYmouse = y
        Else
            linFollowLine.X1 = sinDrawXmouse
            linFollowLine.X2 = x
            linFollowLine.Y1 = sinDrawYmouse
            linFollowLine.Y2 = y
            linFollowLine.BorderWidth = intPenThickness
            linFollowLine.Visible = True
            linFollowLine.BorderStyle = 1 ' Solid
        End If
    End If
   
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - picDraw_MouseMove- " & err.Description & " - " & err.Number
End Sub

Private Sub picDraw_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error GoTo err:
   If blnIsDrawing Then
        picDraw.DrawWidth = intPenThickness
        picDraw.Line (sinDrawXmouse, sinDrawYmouse)-(x, y), lngDrawColor
        strDrawString = strDrawString & CStr(x) & ";" & CStr(y) & ";"
        intNumberOfDrawingPairs = intNumberOfDrawingPairs + 1
        If blnIsServer Then
            'If you are the server, send the info on the line to all open connections.
            SendToAll SCK_CODE_DRAW & CStr(lngDrawColor) & ";" & CStr(intPenThickness) & ";" & _
                    CStr(intNumberOfDrawingPairs) & ";" & strDrawString
        Else
            'If you are connected to the server, send the info on the line to the server.
            SendToSERVER SCK_CODE_DRAW & CStr(lngDrawColor) & ";" & CStr(intPenThickness) & ";" & _
                CStr(intNumberOfDrawingPairs) & ";" & strDrawString
        End If
        strDrawString = ""
       
        If Button = vbLeftButton Then
            picDraw.Line (x, y)-(x, y), lngDrawColor
        Else
            picDraw.Line (sinDrawXmouse, sinDrawYmouse)-(x, y), lngDrawColor
            picDraw.Parent.linFollowLine.Visible = False
            picDraw.Parent.linFollowLine.BorderStyle = 0 ' Transparent
        End If
    End If
    blnIsDrawing = False
    sinDrawXmouse = 0
    sinDrawYmouse = 0
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - picDraw_MouseUp- " & err.Description & " - " & err.Number
End Sub

Private Sub picDown_DblClick()
    picdown_click
End Sub

Private Sub picUp_DblClick()
    picup_click
End Sub
Private Sub picup_click()

    If linePensize.Visible Then
        If intPenThickness <= 17 Then
            If CtrlKeyPressed() Then
                intPenThickness = intPenThickness + 1
            Else
                intPenThickness = intPenThickness + 2
            End If
        Else
            intPenThickness = 19
        End If
        linePensize.BorderWidth = intPenThickness
    Else
        Select Case lblPicDraw.FontSize
            Case 7.5: lblPicDraw.FontSize = 8.25
            Case 8.25: lblPicDraw.FontSize = 9
            Case 9: lblPicDraw.FontSize = 9.75
            Case 9.75: lblPicDraw.FontSize = 11.25
            Case 11.25: lblPicDraw.FontSize = 12
            Case 12: lblPicDraw.FontSize = 12.75
        End Select
        setFontSize
    End If
    picPensize.Refresh
End Sub

Private Sub picdown_click()
    If linePensize.Visible Then
        If intPenThickness >= 3 Then
            If CtrlKeyPressed() Then
                intPenThickness = intPenThickness - 1
            Else
                intPenThickness = intPenThickness - 2
            End If
        Else
            intPenThickness = 1
        End If
        linePensize.BorderWidth = intPenThickness
    Else
        Select Case lblPicDraw.FontSize
            Case 9: lblPicDraw.FontSize = 8.25
            Case 9.75: lblPicDraw.FontSize = 9
            Case 10.5: lblPicDraw.FontSize = 9.75
            Case 11.25: lblPicDraw.FontSize = 9.75
            Case 12: lblPicDraw.FontSize = 11.25
            Case 12.75: lblPicDraw.FontSize = 12
        End Select
        setFontSize
    End If
    picPensize.Refresh
End Sub

Private Sub setFontSize()
    'We can not support larger fontsize than 13 (12), because the text will then begin to be antialiased.
    'This is ok for the clients that are connected at the moment, but when a new client connects
    'and receives the painting from the server, only the supported colors can be send.
    'This can of cause be solved by changing the code, so the true color values are send to the
    'clients. This will increase the amount of data send on the network.
   
    Select Case lblPicDraw.FontSize
    Case 8.25
        lblFontSizeLetter.FontSize = 7.5
        lblFontSizeLetter.Left = (picPensize.Width - lblFontSizeLetter.Width) / 2 - 15
    Case 9
        lblFontSizeLetter.FontSize = 8.25
        lblFontSizeLetter.Left = (picPensize.Width - lblFontSizeLetter.Width) / 2
    Case 9.75
        lblFontSizeLetter.FontSize = 9
        lblFontSizeLetter.Left = (picPensize.Width - lblFontSizeLetter.Width) / 2 - 15
    Case 10.5
        lblFontSizeLetter.FontSize = 9.75
        lblFontSizeLetter.Left = (picPensize.Width - lblFontSizeLetter.Width) / 2 - 12
    Case 11.25
        lblFontSizeLetter.FontSize = 10.5
        lblFontSizeLetter.Left = (picPensize.Width - lblFontSizeLetter.Width) / 2 - 12
    Case 12
        lblFontSizeLetter.FontSize = 11.25
        lblFontSizeLetter.Left = (picPensize.Width - lblFontSizeLetter.Width) / 2 - 12
    Case 12.75
        lblFontSizeLetter.FontSize = 12
        lblFontSizeLetter.Left = (picPensize.Width - lblFontSizeLetter.Width) / 2 - 12
    End Select
   
    txtPicDraw.FontSize = lblFontSizeLetter.FontSize
    txtPicDraw.Height = lblPicDraw.Height
    txtPicDraw.Width = lblPicDraw.Width
    txtPicDraw.Refresh
   
End Sub

Private Sub sckServer_Close()
    On Error Resume Next
    'This occurs when the connection to the server is broken. If we have been kicked we don't
    'want to show the server stopped information.
    If blnKicked Then
        blnKicked = False
    Else
        strTmpText = GetText(134) 'Text: The chatserver is stopped.
        UpdateDialog1Line strTmpText
    End If
    DisconnectFromServer False
End Sub

Private Sub sckServer_DataArrival(ByVal bytesTotal As Long)
On Error GoTo err:
    Dim sString As String
   
    sckServer.GetData sString, vbString
   
    sString = Decrypt(sString)
   
    If blnDebugCom Then DebugLog "R:" & sString
   
    ProcessDataClient sString
   
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - sckServer_DataArrival - " & err.Description & " - " & err.Number
End Sub

Private Sub sckClient_Close(Index As Integer)
    On Error Resume Next
    'One of the connections to the server was closed.
   
    'Close the connection.
    sckClient(Index).Close
   
    If Index <= intMaxUsers Then
        'If someone was on that connection, notify open connections.
        If UserArray(Index).Nickname <> "" Then
            'Update the status.
            strTmpText = GetText(129) 'Text: disconnected.
            UpdateDialog1Line ConstructNickAndFullname(Index) & " " & strTmpText
            'Remove their name from the name list.
            RemoveName Index
            'Have the server notify all connected computer that this person has disconnected.
            SendToAll SCK_CODE_DISCONNECTED & CStr(Index) & ";"
        End If
        ResetUser Index
    End If
   
End Sub

Private Sub sckClient_ConnectionRequest(Index As Integer, ByVal requestID As Long)
On Error GoTo err:
    'A connection was requested from the Client.
   
    Dim i As Integer
    Dim iConnection As Integer
   
    'Make sure this is control 0 in the array.  This is the only one that can accept connections.
    If Index = 0 Then
   
        'Search for available Winsock control.
        For i = 1 To miNumConnections
            If sckClient(i).State = sckClosed Then
                iConnection = i
                Exit For
            End If
        Next i
  
        'If none was found, create a new one.
        If iConnection = 0 Then
            'Increment number of connections.
            miNumConnections = miNumConnections + 1
            'Load a new Winsock control for this connection.
            Load sckClient(miNumConnections)
            'Control to be used is this new control.
            iConnection = miNumConnections
        End If
  
        'Set port for this control to 0.  (Randomly assigns an available port.)
        sckClient(iConnection).LocalPort = 0
        'Have this control accept the connection.
        sckClient(iConnection).Accept requestID
       
        If blnDebugCom Then
            DebugLog "I=" & Index & " RemoteHostIP=" & sckClient(iConnection).RemoteHostIP & " RemotePort=" & sckClient(iConnection).RemotePort
        End If
       
    End If
   
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - sckClient_ConnectionRequest- " & err.Description & " - " & err.Number
End Sub

Private Sub sckClient_DataArrival(Index As Integer, ByVal bytesTotal As Long)
On Error GoTo err:
    'Data has arrived at the server from an open connection.
    Dim sString As String

    sckClient(Index).GetData sString, vbString
   
    sString = Decrypt(sString)
   
    If blnDebugCom Then
        If blnIsServer And InStr(1, sString, SCK_CODE_PRIVATE_MESSAGE) > 0 Then
            DebugLog "R(" & Index & "):SCK_CODE_PRIVATE_MESSAGE"
        Else
            DebugLog "R(" & Index & "): " & sString
        End If
    End If
   
    'Process the data.  Pass the index of the connection from which the data came.
    ProcessDataServer sString, Index
   
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - sckClient_DataArrival- " & err.Description & " - " & err.Number
End Sub

Private Sub tmrDebugStress_Timer()
    Dim strDebugString As String
    lngDebugStressCount = lngDebugStressCount + 1
    strDebugString = "Welcome to ChatTool stresstest. " & time() & " Counter=" & lngDebugStressCount & " "
    If Len(strDebugString) + 3 < intDebugStressMessageLength Then
        strDebugString = strDebugString & Space(intDebugStressMessageLength - Len(strDebugString) - 3) & "END"
    End If
    SendTextMessage strDebugString
End Sub

Private Sub tmrTimeManager_Timer() 'Activated every 2 seconds.
On Error GoTo err:
    Static lngTimerCounter As Long
   
    TimerIsSystrayReloaded
   
    If blnRunCheckActivityTimer Then
        TimerCheckActivity
    End If
   
    If blnIsConnected And Not blnIsJoined Then
        TimerServerReplyCheck
    End If
   
    If blnIsServer Then
        TimerServerCheckDateShift
    End If

    lngTimerCounter = lngTimerCounter + 1
    If blnRunCheckConnectionsAliveTimer And lngTimerCounter >= 5 Then 'We only check this every 10 seconds.
        TimerCheckConnectionsAlive
        lngTimerCounter = 0
    End If
   
    TimerCheckIfJumpToBottom
   
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - tmrTimeManager_Timer " & err.Description & " - " & err.Number
End Sub

Private Sub TimerIsSystrayReloaded()
On Error GoTo err:
    'this function checks the hWnd of the system tray.
    'If the value changes, then we will reload the tray icon
    Dim tmp As Long
    Dim x As Long
   
    'get the hWnd value of the system tray
    tmp = FindWindow("Shell_TrayWnd", vbNullString)
   
    'check for a change from the last time, and make sure it is a valid hWnd
    If (tmp <> lngLastTrayHWND) And (tmp > 0) Then
        AddIconToSysTray
    End If
   
    lngLastTrayHWND = tmp

    Exit Sub
err:
    DebugLog "ERR - frmChatTool - TimerIsSystrayReloaded - " & err.Description & " - " & err.Number
End Sub

Private Sub TimerCheckActivity()
On Error GoTo err:
    If blnIsServer Then
        If IsUserActiveOnPC() Then
            If lngInactivityPeriods >= intNumOfInactiveIntervalsBeforeInactive Then
                If blnSettingsServerVisibleToClients Then
                    SendToAll SCK_CODE_ACTIVITY & CStr(Server) & ";" & CStr(PCActive) & ";"
                End If
                DisplayUserActivity PCActive, Server
                UserArray(Server).InactiveSince = ""
                UserArray(Server).ActivityStatus = PCActive
            End If
            lngInactivityPeriods = 0
        Else
            lngInactivityPeriods = lngInactivityPeriods + 1
            If lngInactivityPeriods = intNumOfInactiveIntervalsBeforeInactive Then
                If blnSettingsServerVisibleToClients Then
                    SendToAll SCK_CODE_ACTIVITY & CStr(Server) & ";" & CStr(PCInactive) & ";"
                End If
                DisplayUserActivity PCInactive, Server
                UserArray(Server).InactiveSince = CalcInactivityStartTime()
                UserArray(Server).ActivityStatus = PCInactive
            Else
                If lngInactivityPeriods = intNumOfInactiveIntervalsBeforeAway Then
                    If blnSettingsServerVisibleToClients Then
                        SendToAll SCK_CODE_ACTIVITY & CStr(Server) & ";" & CStr(PCAway) & ";"
                    End If
                    DisplayUserActivity PCAway, Server
                    UserArray(Server).ActivityStatus = PCAway
                End If
            End If
        End If
    Else
        If IsUserActiveOnPC() Then
            If lngInactivityPeriods >= intNumOfInactiveIntervalsBeforeInactive Then
                SendToSERVER SCK_CODE_ACTIVITY & CStr(PCActive) & ";"
            End If
            lngInactivityPeriods = 0
        Else
            lngInactivityPeriods = lngInactivityPeriods + 1
            If lngInactivityPeriods = intNumOfInactiveIntervalsBeforeInactive Then
                SendToSERVER SCK_CODE_ACTIVITY & CStr(PCInactive) & ";"
            Else
                If lngInactivityPeriods = intNumOfInactiveIntervalsBeforeAway Then
                    SendToSERVER SCK_CODE_ACTIVITY & CStr(PCAway) & ";"
                End If
            End If
        End If
    End If
    'I Don't believe in overrun of lngInactivityPeriods.

    Exit Sub
err:
    DebugLog "ERR - frmChatTool - TimerCheckActivity - " & err.Description & " - " & err.Number
End Sub

Private Sub TimerServerReplyCheck()
On Error GoTo err:
    Dim lngTmpTime As Long
   
    If lngWinSckConnectAcceptTime <> -1 Then
   
        'We have send a connect request to "a server", but the server has not replied the join command we send.
        'If this time exceeds MAX_WAIT_FOR_SERVERREPLY seconds, we disconnect...
        lngTmpTime = Int(Timer()) - lngWinSckConnectAcceptTime
        If lngTmpTime < 0 Then lngTmpTime = lngTmpTime + 86400
       
        If lngTmpTime >= MAX_WAIT_FOR_SERVERREPLY Then
            strTmpText = GetText(138) 'Text: The chatserver did not respond to your join request.
            UpdateDialog1Line strTmpText
            DisconnectFromServer False
            lngWinSckConnectAcceptTime = -1
        End If
       
    End If
   
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - TimerServerReplyCheck - " & err.Description & " - " & err.Number
End Sub

Private Sub TimerServerCheckDateShift()
    If Date <> datActualDate Then
        datActualDate = Date
        strTmpText = GetText(235) 'Text: Dateshift to %2 %1 (%3).
        strTmpText = Replace$(strTmpText, "%1", GetMonthName(Format$(datActualDate, "MM")))
        strTmpText = Replace$(strTmpText, "%2", Format$(datActualDate, "D"))
        strTmpText = Replace$(strTmpText, "%3", Format$(datActualDate, "YYYY"))
        UpdateDialog3Lines strTmpText
        SendToAll SCK_CODE_DATESHIFT & Format$(datActualDate, "YYYY-MM-DD") & ";"
    End If
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - TimerServerCheckDateShift - " & err.Description & " - " & err.Number
End Sub

Private Sub TimerCheckConnectionsAlive()
On Error GoTo err:
    Dim i As Integer
    Dim j As Integer
    Dim Checkpoint As String
   
    If blnIsServer Then
        For i = lstConnections.ListCount - 1 To 0 Step -1
            Checkpoint = "0"
            If lstConnections.ItemData(i) <> Server Then
                Checkpoint = "1"
                If Not sckClient(lstConnections.ItemData(i)).State = sckConnected And _
                    UserArray(lstConnections.ItemData(i)).IsConnected Then
                    'Close the connection.
                    sckClient(lstConnections.ItemData(i)).Close
                    'Update the status.
                    Checkpoint = "3"
                    'If a connection is made, but no correctly registred, then do not send the lost connection-information.
                    If UserArray(lstConnections.ItemData(i)).Nickname <> "" And _
                        UserArray(lstConnections.ItemData(i)).Fullname <> "" Then
                       
                        strTmpText = GetText(230) 'Text: lost the connection to the chatserver.
                        UpdateDialog1Line ConstructNickAndFullname(lstConnections.ItemData(i)) & " " & strTmpText
                        SendToAll SCK_CODE_LOSTCONNECTION & CStr(lstConnections.ItemData(i)) & ";"
                    End If
                    Checkpoint = "4"
                    ResetUser lstConnections.ItemData(i)
                    lstConnections.RemoveItem (i)
                End If
            End If
        Next i
    Else
        If blnIsJoined Then
            If Not sckServer.State = sckConnected Then
                strTmpText = GetText(133) 'Text: The connection to the chatserver is lost.
                UpdateDialog1Line strTmpText
                DisconnectFromServer False
            End If
        End If
    End If
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - TimerCheckConnectionsAlive - Checkpoint= " & Checkpoint & err.Description & " - " & err.Number
End Sub

Private Sub TimerCheckIfJumpToBottom()
On Error GoTo err:
    Dim lngTmpTime As Long
    If lngLastScrollTimeRtbDialog <> -1 Then
        lngTmpTime = Int(Timer()) - lngLastScrollTimeRtbDialog
        If lngTmpTime < 0 Then lngTmpTime = lngTmpTime + 86400
        'If we have scrolled away from the bottom. We only accept 20 secs of noscroll before we returns to the bottom.
        If lngTmpTime > 20 Then
            lngLastScrollTimeRtbDialog = -1 'Enable text scroll
        End If
    End If
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - TimerCheckIfJumpToBottom - " & err.Description & " - " & err.Number
End Sub

Private Sub ResetUser(Index As Integer)
    UserArray(Index).IsConnected = False
    UserArray(Index).ActivityNotifier = False
    UserArray(Index).UserID = ""
    UserArray(Index).Nickname = ""
    UserArray(Index).Fullname = ""
    UserArray(Index).ActivityStatus = PCActive
    UserArray(Index).LastActive = ""
    UserArray(Index).ConnectionTime = ""
    UserArray(Index).InactiveSince = ""
    UserArray(Index).PCName = ""
    UserArray(Index).IsTheServer = False
End Sub



Private Sub txtSend_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo err:
    Select Case KeyCode
    Case vbKeyUp
        If CtrlKeyPressed() Then
            SendMessage rtbDialog.hwnd, WM_VSCROLL, SB_LINEUP, 0
            lngLastScrollTimeRtbDialog = Int(Timer())
        Else
            HistoryPrevious txtSend
        End If
        KeyCode = 0
    Case vbKeyDown
         If CtrlKeyPressed() Then
            SendMessage rtbDialog.hwnd, WM_VSCROLL, SB_LINEDOWN, 0
            lngLastScrollTimeRtbDialog = Int(Timer())
        Else
            HistoryNext txtSend
        End If
        KeyCode = 0
    Case vbKeyPageUp
        SendMessage rtbDialog.hwnd, WM_VSCROLL, SB_PAGEUP, 0
        lngLastScrollTimeRtbDialog = Int(Timer())
        KeyCode = 0
    Case vbKeyPageDown
        SendMessage rtbDialog.hwnd, WM_VSCROLL, SB_PAGEDOWN, 0
        lngLastScrollTimeRtbDialog = Int(Timer())
        KeyCode = 0
    Case vbKeyHome
        If CtrlKeyPressed() Then
            SendMessage rtbDialog.hwnd, WM_VSCROLL, SB_TOP, 0
            lngLastScrollTimeRtbDialog = Int(Timer())
            KeyCode = 0
        End If
    Case vbKeyEnd
        If CtrlKeyPressed() Then
            SendMessage rtbDialog.hwnd, WM_VSCROLL, SB_BOTTOM, 0
            lngLastScrollTimeRtbDialog = -1
            KeyCode = 0
        End If
    Case vbKeyD 'Shortcut used for debug-commands.
        If CtrlKeyPressed() Then
            txtSend.Text = "#debug"
            txtSend.SelStart = Len(txtSend.Text)
            KeyCode = 0
        End If
    Case Else
        'Reset every time anything but keydown or keyup is pressed.
        ResetHistoryPointer
    End Select
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - txtSend_KeyDown - " & err.Description & " - " & err.Number
End Sub

Private Sub txtSend_KeyPress(KeyAscii As Integer)
    'Placed in KeyPress to avoid the system-beep (when txtSend not multiline).
    Select Case KeyAscii
    Case vbKeyReturn
        bgCmdSend_Click
        KeyAscii = 0
   
       End Select
End Sub

Private Sub bgChkChatSelected_MouseDown()
    If bgChkChatSelected.value = True Then
        txtSend.ForeColor = vbBlue
        frmMiniChat.txtMiniSend.ForeColor = vbBlue
    Else
        txtSend.ForeColor = vbBlack
        frmMiniChat.txtMiniSend.ForeColor = vbBlack
    End If
    txtSend.Refresh
End Sub

Public Sub SendUserList()
On Error GoTo err:
    'This is a procedure to refresh each user's connection list.
    Dim i As Integer
    Dim j As Integer
    Dim intConn As Integer
    Dim strSendString As String
   
    For i = 0 To lstConnections.ListCount - 1
        'Do not send list to SERVER.
        If lstConnections.ItemData(i) <> Server Then
            'Send command to clear name list to user.
            SendToPerson SCK_CODE_NEW_NAME_LIST, lstConnections.ItemData(i)
            'Send the name for each user to each connection.
            For j = 0 To lstConnections.ListCount - 1
                intConn = lstConnections.ItemData(j)
                strSendString = SCK_CODE_PEOPLE & CStr(intConn) & ";" & PackSend(UserArray(intConn).UserID) & ";" & _
                    PackSend(UserArray(intConn).Nickname) & ";" & PackSend(UserArray(intConn).Fullname) & ";" _
                        & PackSend(UserArray(intConn).ActivityStatus) & ";"
                If intConn = Server Then
                    strSendString = strSendString & "Server" & ";" & _
                        IIf(blnSettingsServerVisibleToClients, "1", "0") & ";"
                Else
                    strSendString = strSendString & "Client" & ";"
                End If
                SendToPerson strSendString, lstConnections.ItemData(i)
            Next j
        End If
    Next i
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - SendUserList - " & err.Description & " - " & err.Number
End Sub


Private Sub AddName(intConnection As Integer, vsName As String)
On Error GoTo err:
    'This procedure adds a name to the name list.
    Dim i As Integer
    'Add the name to the connections list.
    lstConnections.AddItem vsName
    'Associate that item in the name list with this connection.
    For i = 0 To lstConnections.ListCount - 1
        If lstConnections.List(i) = vsName Then
            lstConnections.ItemData(i) = intConnection
            Exit For
        End If
    Next i
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - AddName - " & err.Description & " - " & err.Number
End Sub

Private Sub RemoveName(intConnection As Integer)
    'This procedure removes a user from lstConnectons
    Dim i As Integer
    For i = 0 To lstConnections.ListCount - 1
        If lstConnections.ItemData(i) = intConnection Then
            lstConnections.RemoveItem i
            Exit For
        End If
    Next i
End Sub

Public Sub SendToAll(vsData As String)
On Error GoTo err:
    Dim i As Integer
    'Cycle through connections and send data to each open client connection.
    For i = 1 To miNumConnections
        If sckClient(i).State = sckConnected Then
            SendToPerson vsData, i
        End If
    Next i
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - SendToAll - " & err.Description & " - " & err.Number
End Sub

Public Sub SendToPerson(vsData As String, intConnection As Integer)
On Error GoTo err:
  
    If blnRunningOnOkWinsckOcx Then
        sckClient(intConnection).SendData Encrypt(vsData & vbCrLf)
    Else
        mSendList.Add CStr(intConnection) & ";" & vsData
    End If
   
    If blnDebugCom Then
        'SCK_CODE_MESSAGE & "1;" 1 describes that the message is private.
        'If the message is private don't show its contents in the server debuglog.
        If blnIsServer And InStr(1, vsData, SCK_CODE_MESSAGE & "1;") > 0 Then
            DebugLog "S(" & intConnection & "):SCK_CODE_PRIVATE_MESSAGE"
        Else
            DebugLog "S(" & intConnection & "):" & vsData
        End If
    End If
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - SendToPerson - " & err.Description & " - " & err.Number
End Sub

Public Sub SendToSERVER(vsData As String, Optional blnDoJoinCheck As Boolean = True)
On Error GoTo err:
    'Always do the join check before sending, but it must also be possible to send the join string without
    'the user already joined, therefore we have blnDoJoinCheck as optional to cope with the initial situation.
    If Not blnDoJoinCheck Or blnIsJoined Then
        If blnRunningOnOkWinsckOcx Then
            sckServer.SendData Encrypt(vsData & vbCrLf)
        Else
            sckServer.SendData Encrypt(vsData & vbCrLf)
            DoEvents 'Handles the sendata bug.
        End If
        If blnDebugCom Then DebugLog "S:" & vsData
    End If
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - SendToSERVER - " & err.Description & " - " & err.Number
End Sub

Private Sub tmrOldSendData_Timer()
On Error GoTo err:
    'This is the timer that continuously checks for data to send to support old versions of winsocket.
    Dim i As Integer
    Dim strData As String
    Dim iConnection As Integer
    Dim blnHasRemoved As Boolean
    Do While mSendList.Count > 0
        blnHasRemoved = False
        strData = mSendList.Item(1)
        i = InStr(1, strData, ";")
        If i > 0 Then
            iConnection = CInt(Mid$(strData, 1, i - 1))
            If sckClient(iConnection).State = sckConnected Then
                strData = Mid$(strData, i + 1)
                sckClient(iConnection).SendData Encrypt(strData & vbCrLf)
            End If
        Else
            err.Raise 5000, , "i = InStr(1, strData, ';') i=0 ERROR"
        End If
        mSendList.Remove 1
        blnHasRemoved = True
        DoEvents
    Loop
Exit Sub
err:
    DebugLog "ERR - frmChatTool - tmrOldSendData_Timer - " & err.Description & " - " & err.Number
    On Error Resume Next
    If Not blnHasRemoved Then
        mSendList.Remove 1
    End If
    DoEvents
End Sub

Private Sub InitColorArray()
    ColorArray(0) = 0: ColorArray(1) = 855309: ColorArray(2) = 1776411
    ColorArray(3) = 2631720: ColorArray(4) = 3552822: ColorArray(5) = 4408131
    ColorArray(6) = 5329233: ColorArray(7) = 6184542: ColorArray(8) = 7039851
    ColorArray(9) = 7960953: ColorArray(10) = 8816262: ColorArray(11) = 9737364
    ColorArray(12) = 10592673: ColorArray(13) = 11447982: ColorArray(14) = 12369084
    ColorArray(15) = 13224393: ColorArray(16) = 14145495: ColorArray(17) = 15000804
    ColorArray(18) = 15921906: ColorArray(19) = 16777215: ColorArray(20) = 12632319
    ColorArray(21) = 8421631: ColorArray(22) = 255: ColorArray(23) = 192
    ColorArray(24) = 128: ColorArray(25) = 12640511: ColorArray(26) = 8438015
    ColorArray(27) = 33023: ColorArray(28) = 16576: ColorArray(29) = 16512
    ColorArray(30) = 12648447: ColorArray(31) = 8454143: ColorArray(32) = 65535
    ColorArray(33) = 49344: ColorArray(34) = 32896: ColorArray(35) = 12648384
    ColorArray(36) = 8454016: ColorArray(37) = 65280: ColorArray(38) = 49152
    ColorArray(39) = 32768: ColorArray(40) = 16777152: ColorArray(41) = 16777088
    ColorArray(42) = 16776960: ColorArray(43) = 12632064: ColorArray(44) = 8421376
    ColorArray(45) = 16761024: ColorArray(46) = 16744576: ColorArray(47) = 16711680
    ColorArray(48) = 12582912: ColorArray(49) = 8388608: ColorArray(50) = 16761087
    ColorArray(51) = 16744703: ColorArray(52) = 16711935: ColorArray(53) = 12583104
    ColorArray(54) = 8388736: ColorArray(55) = 16777215
End Sub

Private Sub CreateColorPalette()
    Dim Path As String
    Dim tempstr As String
    Dim i As Integer
    Dim x As Integer
    Dim y As Integer
   
    For i = 0 To 55
        If i <> 0 Then
            Load picColor(i)
        End If
               
        picColor(i).BackColor = ColorArray(i)
              
        picColor(i).Move x, y
        picColor(i).ZOrder 0
        picColor(i).Visible = True
        x = x + picColor(i).Width - 1
        If (x + picColor(i).Width - 1) >= picColorbag.Width / Screen.TwipsPerPixelX Then
            x = 0
            y = y + picColor(i).Height - 1
        End If
    Next i

End Sub

Private Sub UpdateDialog3Lines(ByVal strDialog As String)
    UpdateDialog 0, "", "•••", time()
    UpdateDialog1Line strDialog
    UpdateDialog 0, "", "•••", time()
End Sub

Public Sub UpdateDialog1Line(strDialog As String)
    UpdateDialog 0, "", "••• " & strDialog, time()
End Sub

Public Sub UpdateDialog(intPrivateMessage As Integer, strUser As String, _
    ByVal strDialog As String, strTime As String)
On Error GoTo err:
    'The RTB is a piece of crap. I just hate it so much that I can taste it.
    Dim blnPrivateMessage As Boolean
    Dim strFormattedTime As String
    Dim strNewLine As String
    Dim S As SCROLLINFO
    Dim i As Integer
    Dim lngSelstart As Long
    Dim lngSelLength As Long
    Dim blnFocusProblem As Boolean
    Dim intMousePointer As Integer
   
    If Not blnDisplayMesssageLog Then Exit Sub
   
    intMousePointer = Screen.MousePointer
   
    lngLinesInMesssageLog = lngLinesInMesssageLog + 1
   
    If Not blnAppHasFocus And Not frmMiniChat.Visible Or _
        Not frmMiniChat.Visible And Not frmChatTool.Visible Then
        'Not frmMiniChat.Visible And Not frmChatTool.Visible is for handling the situation where ESC is pressed
        'on MiniChat.
        lngNumberOfUnreadMessages = lngNumberOfUnreadMessages + 1
        If blnSettingsShowLighting Then
            SetLightningIconInSystray
        End If
    End If
   
    'We also have to refresh the MiniChat window.
    frmMiniChat.UpdateDialog intPrivateMessage, strUser, strDialog, strTime
   
    'If AM/PM or a.m./p.m. format then change it to a/p in the text and generally remove any spaces.
    strFormattedTime = Replace$(LCase(FormatDateTime(strTime, vbLongTime)), "a.m.", "a")
    strFormattedTime = Replace$(strFormattedTime, "p.m.", "p")
    strFormattedTime = Replace$(Replace$(strFormattedTime, "m", ""), " ", "")
   
    'There is a scrolling problem when the rtbDialog has focus. The problem occurs because of the nature
    'of the crappy RichTextBox control. When a line is written, the focus is moved to that line, for the Bold font
    'and colored font to be set. If the cursor is positioned somewhere in the text the scrolling do not work the
    'way that I intended. To solve the problems I store the cursor position and the length of the selected
    'text and temporarily move the focus out of the rtbDialog. After the new line is written, I then put the focus
    'back to the rtbDialog and place the cursor and selected text, if it exists. This is the best I can do. I think :)
    If BlnRtbDialogHasFocus And blnAppHasFocus Then
        SetFocusAPI picUp.hwnd 'Get focus away from rtbDialog.
        blnFocusProblem = True
        lngSelstart = rtbDialog.SelStart 'Store the cursor position.
        lngSelLength = rtbDialog.SelLength
    End If
   
    'If we are at the bottom of the rtbdialog then disable the scrollchecktimer if it is set.
    If lngLastScrollTimeRtbDialog <> -1 Then
        S.cbSize = Len(S)
        S.fMask = SIF_ALL
        If GetScrollInfo(rtbDialog.hwnd, SB_VERT, S) Then
            If S.nMax Then
                If S.nPos >= S.nMax - S.nPage Then
                    lngLastScrollTimeRtbDialog = -1
                End If
            End If
        End If
    End If
  
    SendMessage rtbDialog.hwnd, WM_SETREDRAW, ByVal 0&, ByVal 0& 'Avoid flickering in the rtbDialog

    rtbDialog.SelStart = lngRtbTextLength
    If lngRtbTextLength = 0 Then
        If strUser <> "" Then
            strNewLine = strFormattedTime & " " & strUser & "> " & strDialog
        Else
            strNewLine = strFormattedTime & " " & strDialog
        End If
        rtbDialog.SelText = strNewLine
        rtbDialog.SelStart = 0
        rtbDialog.SelLength = Len(strFormattedTime)
        rtbDialog.SelColor = 8421504 'Dark grey
        rtbDialog.SelStart = Len(strFormattedTime) + 1
        If strUser <> "" Then
            rtbDialog.SelLength = Len(strUser) + 2 '1 = >
        Else
            rtbDialog.SelLength = 0
        End If
    Else
        If strUser <> "" Then
            strNewLine = vbCrLf & strFormattedTime & " " & strUser & "> " & strDialog
        Else
            strNewLine = vbCrLf & strFormattedTime & " " & strDialog
        End If
        rtbDialog.SelText = strNewLine
        rtbDialog.SelStart = lngRtbTextLength
        rtbDialog.SelLength = Len(strFormattedTime) + 2
        rtbDialog.SelColor = 8421504 'Dark grey
        rtbDialog.SelStart = lngRtbTextLength + Len(strFormattedTime) + 2
        If strUser <> "" Then
            rtbDialog.SelLength = Len(strUser) + 2 '1 = >
        Else
            rtbDialog.SelLength = 0
        End If
    End If
   
    rtbDialog.SelBold = True
    If intPrivateMessage = 1 Then
        rtbDialog.SelColor = 8421504 'Grey - the private color.
    End If
   
    'New text length
    lngRtbTextLength = lngRtbTextLength + Len(strNewLine)
   
    'Make sure that the last line is fully visible i the text box.
    rtbDialog.SelStart = lngRtbTextLength
    SendMessage rtbDialog.hwnd, WM_SETREDRAW, ByVal 1&, ByVal 0&
   
    If blnFocusProblem Then
        SetFocusAPI rtbDialog.hwnd
        rtbDialog.SelStart = lngSelstart
        rtbDialog.SelLength = lngSelLength
        'If scrolling is allowed then we cannot accept that the selection makes a problem because it always has
        'to be visible.
        If lngLastScrollTimeRtbDialog = -1 Then
            S.cbSize = Len(S)
            S.fMask = SIF_ALL
            'Check if if it is a bottom. If not then correct it.
            If GetScrollInfo(rtbDialog.hwnd, SB_VERT, S) Then
                If S.nMax Then
                    If S.nPos < S.nMax - (S.nPage) Then
                        rtbDialog.SelStart = lngRtbTextLength
                        rtbDialog.SelLength = 0
                        SetFocusAPI txtSend.hwnd
                    End If
                End If
            End If
        End If
    End If
   
    rtbDialog.Refresh

    If intMousePointer <> Screen.MousePointer Then 'To avoid situations I can not explain.
        Screen.MousePointer = intMousePointer
    End If
   
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - UpdateDialog - " & err.Description & " - " & err.Number & " - " & CStr(intPrivateMessage) & _
        " - " & strUser & " - " & strDialog & " - " & strTime
End Sub

Private Sub OpenConnectionGUI()
    'Hide/show certain controls because a connection is being opened.
    bgCmdSend.Enabled = False
    bgCmdClearDraw.Enabled = False
    bgCmdSendMessage.Enabled = False
    blnIsConnected = True
    txtServername.Locked = True
    txtNickname.Locked = True
    txtNickname.BackColor = Title.txtLockedColor
    txtServername.BackColor = Title.txtLockedColor
    picServername.Enabled = False
    picNickname.Enabled = False
    blnRunCheckActivityTimer = True
    blnMenuDisabled = True 'You can not use the menues when trying to connect / start server.
    lstConnections.Clear
   
    'Clear the connection list.
    lstConnections.Clear
End Sub

Private Sub ConnectionOKGUI()
    'Enable controls when the connection is established.
    bgCmdSend.Enabled = True
    bgCmdSendMessage.Enabled = True
    bgCmdClearDraw.Enabled = True
    blnMenuDisabled = False
End Sub

Private Sub CloseConnectionGUI()
    'Hide/show certain controls because the connection is being closed.
    blnIsConnected = False
    blnIsJoined = False
    txtServername.Locked = False
    txtNickname.Locked = False
    bgCmdSend.Enabled = True
    bgCmdSendMessage.Enabled = True
    bgCmdClearDraw.Enabled = True
    txtNickname.BackColor = Title.txtUnlockedColor
    txtServername.BackColor = Title.txtUnlockedColor
    picServername.Enabled = True
    picNickname.Enabled = True
    blnRunCheckActivityTimer = False
    datServerStartDate = 0
    strServerStartTime = ""
    blnMenuDisabled = False
    tmrDebugStress.Enabled = False
    lstConnections.Clear
    picDraw.Enabled = False
End Sub

Private Sub GetUserNameFromPC(strUserName As String)
On Error GoTo err:
    Dim buffer As String * 512
    Dim length As Long
    If GetUserName(buffer, Len(buffer)) Then
        length = InStr(buffer, vbNullChar) - 1
        strUserName = Left$(buffer, length)
    Else
        strUserName = ""
    End If
Exit Sub
err:
    DebugLog "ERR - frmChatTool - GetUserNameFromPC - " & err.Description & " - " & err.Number
End Sub

Private Sub AddIconToSysTray()
    'Load the Tintin-icon
    picTmp.Picture = LoadResPicture(109, 1)
   
    With nid
     .cbSize = Len(nid)
     .hwnd = frmChatTool.hwnd
     .uId = vbNull
     .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
     .uCallBackMessage = WM_MOUSEMOVE
     .hIcon = picTmp.Picture
     .szTip = "ChatTool" & vbNullChar
    End With
    Shell_NotifyIcon NIM_ADD, nid
End Sub

Private Sub RemoveIconFromSystray()
    nid.cbSize = Len(nid)
    nid.hwnd = frmChatTool.hwnd
    nid.uId = vbNull
    Shell_NotifyIcon NIM_DELETE, nid
End Sub

Private Sub SetLightningIconInSystray()
On Error GoTo err:
    If lngNumberOfUnreadMessages <= 5 Then
        picTmp.Picture = LoadResPicture(105, 1) 'Green lightning
    ElseIf lngNumberOfUnreadMessages <= 15 Then
        picTmp.Picture = LoadResPicture(106, 1) 'Yellow lightning
    ElseIf lngNumberOfUnreadMessages <= 50 Then
        picTmp.Picture = LoadResPicture(107, 1) 'Red lightning
    Else
        picTmp.Picture = LoadResPicture(108, 1) 'Black lightning
    End If
   
    With nid
     .cbSize = Len(nid)
     .hwnd = frmChatTool.hwnd
     .uId = vbNull
     .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
     .uCallBackMessage = WM_MOUSEMOVE
     .hIcon = picTmp.Picture
    End With
   
    If lngNumberOfUnreadMessages = 1 Then
        strTmpText = GetText(225) 'Text: ChatTool - There are one unread message.
        nid.szTip = strTmpText & vbNullChar
    Else
        strTmpText = GetText(226) 'Text: ChatTool - There are %1 unread messages.
        strTmpText = Replace$(strTmpText, "%1", CStr(lngNumberOfUnreadMessages))
        nid.szTip = strTmpText & vbNullChar
    End If
   
    Shell_NotifyIcon NIM_MODIFY, nid
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - SetLightningIconInSystray - " & err.Description & " - " & err.Number
End Sub

Private Sub RemoveLightningIconInSysTray()
On Error GoTo err:
    Dim pic As PictureBox
    picTmp.Picture = LoadResPicture(109, 1) 'Tintin icon
    With nid
     .cbSize = Len(nid)
     .hwnd = frmChatTool.hwnd
     .uId = vbNull
     .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
     .uCallBackMessage = WM_MOUSEMOVE
     .hIcon = picTmp.Picture
     .szTip = "ChatTool" & vbNullChar
    End With
    Shell_NotifyIcon NIM_MODIFY, nid
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - RemoveLightningIconInSysTray - " & err.Description & " - " & err.Number
End Sub

Public Sub AppGotFocus()
On Error GoTo err:
    blnAppHasFocus = True
    blnMenuDisabled = False
    RemoveLightningIconInSysTray
    lngNumberOfUnreadMessages = 0
    If blnDebugFocus Then DebugLog "GotFocus"
    rtbDialog.SelStart = lngRtbTextLength
    If frmChatTool.Visible Then
        If blnFrmChatToolActive Then
            txtSend.SetFocus
        End If
    End If
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - AppGotFocus - " & err.Description & " - " & err.Number
End Sub

Public Sub AppLostFocus()
On Error GoTo err:
    If blnMenuDown Then
        MenuClose
    End If
    blnMenuDisabled = True 'Otherwise the menu could be activated withouth the application having focus.
    If blnDebugFocus Then DebugLog "LostFocus"
    blnAppHasFocus = False
    If blnIsDrawing Then
        EscapeDrawingSequenze
    End If
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - AppLostFocus - " & err.Description & " - " & err.Number
End Sub

Private Function CalcInactivityStartTime() As String
On Error GoTo err:
    Dim secs As Long
    Dim datInactivityDate As Date
    Dim strInactivityStartTime As String
   
    'Withdraw 120 sec. from the actual time.
    secs = CLng(Mid$(time, 7, 2)) + CLng(Mid$(time, 4, 2)) * 60 + CLng(Mid$(time, 1, 2)) * 3600
   
    secs = secs - 2 * intNumOfInactiveIntervalsBeforeInactive '2 because the timer is actived every 2 seconds.
   
    'We turn time back to before midnight and has to adjust the time (and date)
    If secs < 0 Then
        secs = 86400 + secs
        datInactivityDate = Date - 1
    Else
        datInactivityDate = Date
    End If
   
    strInactivityStartTime = Format$(CStr(Int(secs / 3600)), "00")
   
    secs = secs - Int(secs / 3600) * 3600
   
    strInactivityStartTime = strInactivityStartTime & ":" & Format$(CStr(Int(secs / 60)), "00")
   
    secs = secs - Int(secs / 60) * 60
   
    strInactivityStartTime = strInactivityStartTime & ":" & Format$(CStr(secs), "00")
   
    'Create ANSI format
    CalcInactivityStartTime = Format$(datInactivityDate, "YYYY-MM-DD") & " " & strInactivityStartTime
   
    Exit Function
err:
    DebugLog "ERR - frmChatTool - CalcInactivityStartTime - " & err.Description & " - " & err.Number & " CalcInactivityStartTime=" & CalcInactivityStartTime
    CalcInactivityStartTime = ""
End Function

Private Function GetRClickedItem(MyList As Control, x As Single, y As Single) As Long
On Error GoTo err:
    'MYLIST: ListBox Control
    'X, Y: X and Y position from MyList_MouseDown
   
    Dim clickX As Long, clickY As Long
    Dim lRet As Long
    Dim CurRect As RECT
    Dim l As Long
   
    'We are so negative
    GetRClickedItem = LB_ERR

    'Control must be a listbox
    If Not TypeOf MyList Is ListBox Then
        Exit Function
    End If

    'get x and y in pixels
    clickX = x \ Screen.TwipsPerPixelX
    clickY = y \ Screen.TwipsPerPixelY

    'Check all items in the list to see if it was clicked on
    For l = 0 To MyList.ListCount - 1

        'get current selection as rectangle
        lRet = SendMessage(MyList.hwnd, LB_GETITEMRECT, l, CurRect)
   
        'If the position of the click is in the this list item then that's our Item
        If (clickX >= CurRect.Left) And (clickX <= CurRect.Right) _
           And (clickY >= CurRect.Top) And (clickY <= CurRect.Bottom) Then
            GetRClickedItem = l
            Exit Function
        End If
           
    Next l
    Exit Function
err:
    DebugLog "ERR - frmChatTool - GetRClickedItem - " & err.Description & " - " & err.Number
End Function

Private Sub lstConnections_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error GoTo err:
    Dim intItem As Long
    Dim i As Integer
   
    If blnMenuDown Then
        MenuClose
    End If

    If Button = vbRightButton Then
        intItem = GetRClickedItem(lstConnections, x, y)
        If intItem <> -1 Then
            lstConnections.ListIndex = intItem
            For i = 0 To lstConnections.ListCount - 1
                If i = intItem Then
                    lstConnections.Selected(i) = True
                ElseIf Not CtrlKeyPressed Then
                    lstConnections.Selected(i) = False
                End If
            Next i
            blnLstConnectionMenuLoaded = True
            '999 is the lstConnection submenu
            MenuOpen 999, x + bgFramePeopleOnline.Left + lstConnections.Left, _
                y + bgFramePeopleOnline.Top + lstConnections.Top
        End If
    End If
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - lstConnections_MouseDown - " & err.Description & " - " & err.Number
End Sub

Private Sub lstConnections_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error GoTo err:
    Dim lngXPoint As Long
    Dim lngYPoint As Long
    Dim lngIndex As Long
    Dim lngExtraWidth As Long
   
    'If a user-entry in lstConnections is not fully visible, we show a tooltip with the full entry.
    If Button = 0 Then 'If no button was pressed
        lngXPoint = CLng(x / Screen.TwipsPerPixelX)
        lngYPoint = CLng(y / Screen.TwipsPerPixelY)
        With lstConnections
            'Get selected item from list
            lngIndex = SendMessage(.hwnd, LB_ITEMFROMPOINT, 0, ByVal ((lngYPoint * 65536) + lngXPoint))
            'Show tooltip or clear last one.
            If (lngIndex >= 0) And (lngIndex <= .ListCount) Then
                If GetWindowLong(lstConnections.hwnd, GWL_STYLE) And WS_VSCROLL Then
                    'The listbox is displaying a vertical scrollbar'
                    lngExtraWidth = GetSystemMetrics(SM_CXVSCROLL) * Screen.TwipsPerPixelX - 500
                Else
                    lngExtraWidth = -500
                End If
                lblWidthCheck.Caption = .List(lngIndex)
                If lblWidthCheck.Width + lngExtraWidth > .Width Then
                    .ToolTipText = .List(lngIndex)
                Else
                    .ToolTipText = ""
                End If
            End If
        End With
    End If
   
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - lstConnections_MouseMove - " & err.Description & " - " & err.Number
End Sub

'The menusystem - Handles both the normal dropdown menues and the rightclick in lstConnection menu - start
Private Sub picMenubar_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error GoTo err:
    Dim i As Integer
   
    If blnMenuDisabled Then Exit Sub
   
    With picMenubar
        If GetCapture() = .hwnd Then
            If ((x < 0) Or (x > .Width)) Or ((y < 0) Or (y > .Height + 50)) Then
                If Not (x + picMenubar.Left > picMenu.Left And x + picMenubar.Left < picMenu.Left + picMenu.Width) Or y < 0 Then
                    MenuClose
                End If
                ReleaseCapture
                If y < .Height + 50 Then
                    intMenuClicked = -1
                End If
                Exit Sub
            End If
        Else
            SetCapture .hwnd
            intMenuClicked = -1
        End If
       
        For i = 0 To 3
            If x > lblMenu(i).Left And x < lblMenu(i).Width + lblMenu(i).Left Then
                If intMenuClicked <> i Then
                    intMenuClicked = i
                    If blnIsMenuloaded Then MenuClose
                    MenuOpen (i)
                End If
            End If
        Next i
    End With
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - picMenubar_MouseMove - " & err.Description & " - " & err.Number
End Sub

Private Sub picMenu_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error GoTo err:
    Dim i As Integer
    For i = 0 To Label1.Count - 1
        If y > Label1(i).Top And y < Label1(i).Height + Label1(i).Top Then
            picMenu.Visible = False
            SelectButton Label1(i)
            MenuClose
            Exit For
        End If
    Next i
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - picMenu_MouseDown - " & err.Description & " - " & err.Number
End Sub

Private Sub picMenu_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error GoTo err:
    Dim i As Integer
   
    With picMenu
        If GetCapture() = .hwnd Then
          If x < 0 Or x > .Width Or y < -50 Or y > .Height Then
            If y < -50 And Not blnLstConnectionMenuLoaded Then
                ReleaseCapture
                SetCapture picMenubar.hwnd
            Else
                ReleaseCapture
                MenuClose
            End If
          End If
        Else
            SetCapture .hwnd
        End If
    End With
   
    For i = 0 To Label1.Count - 1
        If y > Label1(i).Top And y < Label1(i).Height + Label1(i).Top Then
            SetButtonLines Line1, Label1(i)
        End If
    Next i
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - picMenu_MouseMove - " & err.Description & " - " & err.Number
End Sub

Private Sub LoadMenus()
On Error GoTo err:
    Dim blnblnIsMenuloaded As Boolean

    If lblMenu.UBound = 0 Then
        blnblnIsMenuloaded = False
    Else
        blnblnIsMenuloaded = True
    End If

    lngSelectColor = vbBlack
    ReDim MainMnuArray(3)
   
    MainMnuArray(0) = GetText(1000) 'Text: File
    MainMnuArray(1) = GetText(1001) 'Text: Functions
    MainMnuArray(2) = GetText(1004) 'Text: Settings
    MainMnuArray(3) = GetText(1003) 'Text: Help
   
    ReDim MenuSubArray(12)
   
    Label1(0).ForeColor = vbBlack
    Tile_Main picMenubar, picMenu.Picture, 0, 0, picMenubar.Width, picMenubar.Height
    SetButtonLines Line1, Label1(0)
    lblMenu(0).Caption = MainMnuArray(0)
       
    For i = 1 To UBound(MainMnuArray)
        If Not blnblnIsMenuloaded Then
            Load lblMenu(i)
        End If
        lblMenu(i).Caption = MainMnuArray(i)
        lblMenu(i).Left = lblMenu(i - 1).Left + lblMenu(i - 1).Width + 100
        lblMenu(i).Visible = True
    Next i
    blnMenuDown = False
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - LoadMenus - " & err.Description & " - " & err.Number
End Sub

Private Sub LoadSubMenu(Index As Integer)
On Error GoTo err:
    Dim i  As Integer
    Dim intCountSelected As Integer
    Dim intSelectedIndex As Integer
    Dim blnClientSelected As Boolean
    Dim blnServerSelected As Boolean
   
    'Creates an array to hold the captions.
    For i = 0 To UBound(MenuSubArray())
        MenuSubArray(i) = ""
    Next i
    Select Case Index
        Case 0
            '**************************** File
            MenuSubArray(0) = GetText(1010) 'Text: Save drwaing
            MenuSubArray(1) = GetText(1011) 'Text: Exit ChatTool
        Case 1
            '**************************** Functions
            i = 0
            If blnIsServer Then
                MenuSubArray(i) = GetText(1022) 'Text: Stop server
                i = i + 1
            ElseIf Not blnIsConnected Then
                MenuSubArray(i) = GetText(1023) 'Text: Start server
                i = i + 1
                If Len(txtServername) > 0 Then
                    MenuSubArray(i) = GetText(1026) & " " & txtServername ' GetText(1026) 'Text: Connect to
                    i = i + 1
                End If
            Else
                MenuSubArray(i) = GetText(1027) 'Text: Disconnect
                i = i + 1
            End If
            MenuSubArray(i) = GetText(1024) 'Text: Clear messagelog
            i = i + 1
            MenuSubArray(i) = GetText(1072) 'Text: Activate MiniChat
            i = i + 1
       Case 2
            '**************************** Tintin
            MenuSubArray(0) = GetText(1025) 'Text: User profile
            MenuSubArray(1) = GetText(1021) 'Text: ChatTool Settings
            MenuSubArray(2) = GetText(1028) 'Text: Password protection
        Case 3
            '**************************** Help
            MenuSubArray(0) = GetText(1040) 'Text: ChatTool help
            MenuSubArray(1) = GetText(1041) 'Text: About
        Case 999 'The menu when rightclicking on a user online.
            blnClientSelected = False
            blnServerSelected = False
            intCountSelected = 0
            For i = lstConnections.ListCount - 1 To 0 Step -1
                If lstConnections.Selected(i) Then
                    If lstConnections.ItemData(i) = Server Then
                        blnServerSelected = True
                    Else
                        blnClientSelected = True
                    End If
                    intCountSelected = intCountSelected + 1
                    intSelectedIndex = lstConnections.ItemData(i)
                End If
            Next i
           
            i = 0
           
            'We only want to display the "Kick" menu when you are the server and have chosen one of the other users.
            If blnIsServer And blnClientSelected And intCountSelected = 1 Then
                MenuSubArray(i) = GetText(1071) 'Text: Kick
                i = i + 1
            End If
           
            If intCountSelected = 1 Then
                MenuSubArray(i) = GetText(1070) 'Text: User information
                i = i + 1
            End If
           
            If intCountSelected = 1 Then
                If blnIsServer And Not blnServerSelected Then
                    MenuSubArray(i) = GetText(1073) 'Text: Online message
                    i = i + 1
                ElseIf Not blnIsServer And intSelectedIndex <> intMyClient Then
                    MenuSubArray(i) = GetText(1073) 'Text: Online message
                    i = i + 1
                End If
            Else
                MenuSubArray(i) = GetText(1073) 'Text: Online message
                i = i + 1
            End If
           
            If intCountSelected = 1 Then
                If UserArray(lstConnections.ItemData(lstConnections.ListIndex)).ActivityNotifier Then
                    MenuSubArray(i) = GetText(1075) 'Text: Disable active notifier
                    i = i + 1
                ElseIf UserArray(lstConnections.ItemData(lstConnections.ListIndex)).ActivityStatus <> PCActive Then
                    MenuSubArray(i) = GetText(1074) 'Text: Set active notifier
                    i = i + 1
                End If
            End If
           
    End Select
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - LoadSubMenu - " & err.Description & " - " & err.Number
End Sub

'This procedure positions the Line shape controls around the ImageControl
Private Sub SetButtonLines(LineObject As Object, OutLineControl As Control)
On Error GoTo err:
    Dim IX1 As Single, IY1 As Single, IX2 As Single, IY2 As Single
    'Set the four corners of the image control
    IX1 = OutLineControl.Left - 25: IX2 = OutLineControl.Left + OutLineControl.Width + 25
    IY1 = OutLineControl.Top: IY2 = OutLineControl.Top + OutLineControl.Height + 25
    'Bottom Line
    LineObject(0).X1 = IX1: LineObject(0).Y1 = IY2 - 25
    LineObject(0).X2 = IX2 + 15: LineObject(0).Y2 = IY2 - 25
    'Right Line
    LineObject(1).X1 = IX2: LineObject(1).Y1 = IY1
    LineObject(1).X2 = IX2: LineObject(1).Y2 = IY2 - 15
    'Top Line
    LineObject(2).X1 = IX1: LineObject(2).Y1 = IY1
    LineObject(2).X2 = IX2 + 15: LineObject(2).Y2 = IY1
    'Left Line
    LineObject(3).X1 = IX1: LineObject(3).Y1 = IY1
    LineObject(3).X2 = IX1: LineObject(3).Y2 = IY2 - 25
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - SetButtonLines - " & err.Description & " - " & err.Number
End Sub

'Sub to place processing code
Private Sub SelectButton(TheControl As Object)
On Error GoTo err:
    Dim intIndex As Integer
    DoEvents
    Select Case TheControl.Caption
        'File
        Case GetText(1010) 'Text: Save drwaing
            frmSaveDrawing.Show vbModal
        Case GetText(1011) 'Text: Exit ChatTool
            Unload Me
        'Functions
        Case GetText(1023) 'Text: Start server
            ServerStart
        Case GetText(1022) 'Text: Stop server
            ServerStop
        Case GetText(1026) & " " & txtServername.Text 'Text: Connect to
            ConnectToServer
        Case GetText(1027) 'Text: Disconnect
            DisconnectFromServer
        Case GetText(1024) 'Text: Clear messagelog
            ClearMessageLog
        Case GetText(1072) 'Text: Activate MiniChat
            ActivateMiniChat
        'Settings
        Case GetText(1021) 'Text: Settings
            ShowSettings
        Case GetText(1025) 'Text: User profile
            ShowUserProfile
        Case GetText(1028) 'Text: Password protection
            PasswordProtection
        'Help
        Case GetText(1040) 'Text: ChatTool help
            ShowHelp
        Case GetText(1041) 'Text: About
            ShowAboutForm
        'Rightclicking an entry in lstConnection
        Case GetText(1071) 'Text: Kick
            KickUser
        Case GetText(1070) 'Text: User information
            If blnIsServer Then
                SendUserInformation Server, lstConnections.ItemData(lstConnections.ListIndex)
            Else
                SendToSERVER SCK_CODE_USERINFO & CStr(lstConnections.ItemData(lstConnections.ListIndex)) & ";"
            End If
        Case GetText(1073) 'Text: Online message
            ShowSendOnlineMessage
        Case GetText(1074) 'Text: Active notifier
            intIndex = lstConnections.ItemData(lstConnections.ListIndex)
            'Check if the activity status has changed, while the menu was shown. If it has changed to active then ignore the activity notification.
            If UserArray(intIndex).ActivityStatus <> PCActive Then
                UserArray(intIndex).ActivityNotifier = True
                DisplayUserActivity UserArray(intIndex).ActivityStatus, intIndex
            End If
        Case GetText(1075) 'Text: Disable active notifier
            intIndex = lstConnections.ItemData(lstConnections.ListIndex)
            UserArray(intIndex).ActivityNotifier = False
            DisplayUserActivity UserArray(intIndex).ActivityStatus, intIndex
        Case Else
    End Select
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - SelectButton - " & err.Description & " - " & err.Number
End Sub

Public Sub Tile_Main(TileObject As Object, TilePicture As Picture, TileLeft As Single, TileTop As Single, TileWidth As Single, TileHeight As Single)
On Error GoTo err:
    Dim ImageTop As Single, ImageLeft As Single, ImageWidth As Single, ImageHeight As Single
    Dim Max_Images_Height As Integer, Max_Images_Width As Integer
    Dim c As Integer
    ImageTop = TileTop
    ImageLeft = TileLeft
    ImageWidth = TileObject.ScaleX(TilePicture.Width, vbHimetric, TileObject.ScaleMode)
    ImageHeight = TileObject.ScaleY(TilePicture.Height, vbHimetric, TileObject.ScaleMode)
    Max_Images_Width = CInt(TileWidth \ ImageWidth) + 1
    Max_Images_Height = IIf(CInt(TileHeight \ ImageHeight) = 0, 1, CInt(TileHeight \ ImageHeight) + 1)
    TileObject.AutoRedraw = True
    For i = 1 To Max_Images_Height + 1
        For c = 0 To Max_Images_Width
            TileObject.PaintPicture TilePicture, ImageLeft, ImageTop, ImageWidth, ImageHeight
            ImageLeft = ImageLeft + ImageWidth
        Next
        ImageLeft = TileLeft
        ImageWidth = TileObject.ScaleX(TilePicture.Width, vbHimetric, TileObject.ScaleMode)
        ImageTop = ImageTop + ImageHeight
    Next
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - Tile_Main - " & err.Description & " - " & err.Number
End Sub

Private Sub MenuOpen(Index As Integer, Optional x As Single, Optional y As Single)
    Dim LastFile As Integer
    Dim MnuLen As Integer
   
    If Not blnMenuDown Then
        LoadSubMenu (Index)
        i = 0
        While i < 12 And MenuSubArray(i) <> ""
            If i > 0 Then
                Load Label1(i)
                Label1(i).Top = Label1(i - 1).Top + Label1(i - 1).Height + 50
                Label1(i).Visible = True
            End If
            If MenuSubArray(i) <> "" Then
                Label1(i).Caption = MenuSubArray(i)
                If (Label1(i).Left * 2) + Label1(i).Width > MnuLen Then
                    MnuLen = (Label1(i).Left * 2) + Label1(i).Width
                End If
                LastFile = i
            End If
            i = i + 1
        Wend
        blnIsMenuloaded = True
        If MnuLen < 1500 Then
            MnuLen = 1500
        End If
        picMenu.Height = Label1(LastFile).Top + Label1(LastFile).Height + 160
        picMenu.Width = MnuLen
        If blnLstConnectionMenuLoaded Then
            picMenu.Top = y
            Tile_Main picMenu, picMenu.Picture, 0, 0, picMenu.Width, picMenu.Height
            'Makes sure that the menu is always drawn inside the lstConnections box (x coordinate).
            If x + picMenu.Width > bgFramePeopleOnline.Left + lstConnections.Left + lstConnections.Width Then
                picMenu.Left = bgFramePeopleOnline.Left + lstConnections.Left + lstConnections.Width - picMenu.Width - 50 '50 is for avioding the frame.
            Else
                picMenu.Left = x
            End If
        Else
            lblMenu(Index).ForeColor = lngSelectColor
            picMenu.Top = lblMenu(Index).Height + 350
            Tile_Main picMenu, picMenu.Picture, 0, 0, picMenu.Width, picMenu.Height
            picMenu.Left = lblMenu(Index).Left - 10
        End If
        SetButtonLines Line1, Label1(0)
        picMenu.Visible = True
        blnMenuDown = True
    End If
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - MenuOpen - " & err.Description & " - " & err.Number
End Sub

Private Sub MenuClose()
On Error GoTo err:
Dim i As Integer
    picMenu.Visible = False
    For i = 1 To Label1.Count - 1
        Unload Label1(i)
    Next
    blnMenuDown = False
    blnLstConnectionMenuLoaded = False
    DoEvents
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - MenuClose - " & err.Description & " - " & err.Number
End Sub
'The menusystem - End

'Activated menu - Start
Private Sub ShowSettings()
On Error GoTo err:
    frmSettings.Show vbModal
Exit Sub
err:
    DebugLog "ERR - frmChatTool - ShowSettings - " & err.Description & " - " & err.Number
End Sub

Private Sub ShowUserProfile()
On Error GoTo err:
    Load frmUserProfile
    frmUserProfile.Init_ShowProfile
    Unload frmUserProfile
Exit Sub
err:
    DebugLog "ERR - frmChatTool - ShowUserProfile - " & err.Description & " - " & err.Number
End Sub

Private Sub PasswordProtection()
On Error GoTo err:
    If strPassword <> "" Then
        Load frmPassword
        If Not frmPassword.RequestPassword() Then
            Unload frmPassword
            Exit Sub
        End If
        Unload frmPassword
    End If
    Load frmPasswordSetup
    frmPasswordSetup.Init
Exit Sub
err:
    DebugLog "ERR - frmChatTool - PasswordProtection - " & err.Description & " - " & err.Number
End Sub

Private Sub ClearMessageLog()
On Error GoTo err:
    rtbDialog.Text = ""
    lngLinesInMesssageLog = 0
    lngRtbTextLength = 0
   
    frmMiniChat.ClearDialog
    If Me.Visible Then
        txtSend.SetFocus
    End If
Exit Sub
err:
    DebugLog "ERR - frmChatTool - ClearMessageLog - " & err.Description & " - " & err.Number
End Sub

Private Sub ShowAboutForm()
On Error GoTo err:
    Load frmAbout
    frmAbout.Init PRODUCTVERSION, PRODUCTPROTOCOL, PRODUCTBUILDDATE
    frmAbout.Show vbModal
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - ShowAboutForm - " & err.Description & " - " & err.Number
End Sub

Private Sub ShowHelp()
On Error GoTo err:
    Shell "hh.exe " & App.Path & "\ChatTool.chm", vbNormalFocus
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - ShowHelp - " & err.Description & " - " & err.Number
End Sub

Private Sub ActivateMiniChat()
    blnMiniChatActive = True
    frmMiniChat.Init
    If frmMiniChat.blnSwitchToMainChatForm Then
        blnMiniChatActive = False
        If strPassword <> "" Then blnWM_SHOWWINDOW_Allowed = True
        Me.Visible = True
        txtSend.Text = frmMiniChat.txtMiniSend.Text
        txtSend.SetFocus
        txtSend.SelStart = Len(txtSend.Text)
    Else
        'MiniChat is still active.... of course it is. But not visible.
        blnMiniChatActive = True
        If strPassword <> "" Then blnWM_SHOWWINDOW_Allowed = False
    End If
End Sub

Private Sub ShowOnlineMessage(strMessage As String, intEmoticon As Integer, sinFontSize As Single, lngFontColor As Long, intUser As Integer)
    Dim intInLine As Integer
    Load frmOnlineMessageShow
    intInLine = frmOnlineMessageShow.Init(strMessage, intEmoticon, sinFontSize, lngFontColor, intUser)
End Sub

Private Sub ShowSendOnlineMessage()
On Error GoTo err:
    frmOnlineMessageSend.Show vbModal
Exit Sub
err:
    DebugLog "ERR - frmChatTool - ShowSendOnlineMessage - " & err.Description & " - " & err.Number
End Sub


'Activated menu  - End
Public Sub GetFirstOnlineUser(strUserName As String, strFullName As String)
    If lstConnections.ListCount > 0 Then
        strUserName = UserArray(lstConnections.ItemData(0)).UserID
        strFullName = UserArray(lstConnections.ItemData(0)).Fullname
        intGetOnlineUsersCount = 1
    Else
        intGetOnlineUsersCount = 0
        strUserName = ""
        strFullName = ""
    End If
End Sub

Public Sub GetNextOnlineUser(strUserName As String, strFullName As String)
    If lstConnections.ListCount >= intGetOnlineUsersCount Then
        strUserName = UserArray(lstConnections.ItemData(intGetOnlineUsersCount)).UserID
        strFullName = UserArray(lstConnections.ItemData(intGetOnlineUsersCount)).Fullname
        intGetOnlineUsersCount = intGetOnlineUsersCount + 1
    Else
        intGetOnlineUsersCount = 0
        strUserName = ""
        strFullName = ""
    End If
End Sub

Private Function MOwner() As Form
    'This is used to place the messagebox form. Either in center of frmChatTool or frmMiniChat or in the center of the screen.
    If Me.Visible Then
        Set MOwner = Me
        Exit Function
    End If
   
    If frmMiniChat.Visible Then
        Set MOwner = frmMiniChat
        Exit Function
    End If
   
    'Place in center of screen
    Set MOwner = Nothing
End Function

Public Sub RedimUserArray(intSize As Integer)
    If intSize > UBound(UserArray()) Then
        ReDim Preserve UserArray(intSize) 'Creates intSize + 1 elements in the array
    End If
End Sub

Public Function IsNickNameUsed(strNickname As String) As Boolean
Dim i As Integer
    For i = lstConnections.ListCount - 1 To 0 Step -1
        If blnIsServer And lstConnections.ItemData(i) <> Server Or _
            Not blnIsServer And lstConnections.ItemData(i) <> intMyClient Then
                If UCase(UserArray(lstConnections.ItemData(i)).Nickname) = UCase(Trim$(strNickname)) Then
                    IsNickNameUsed = True
                    Exit Function
                End If
        End If
    Next i
    IsNickNameUsed = False
End Function

Private Sub SendDrawingToClient(intClient As Integer)
On Error GoTo err:
    'Must be optimized for better packing of the drawing.
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim lngColor As Long
    Dim bytColor As Byte
    Dim SendArray(10200) As Byte 'Used for a way faster string manipulation.
    Dim SendString As String
    Dim blnEmptyLine As Boolean
    Dim strCounter As String
   
    '-1 = the messeagelog is not updated with the name of the user, who cleared the drawboard.
    SendToPerson SCK_CODE_CLEAR_DRAW & CStr(vbWhite) & ";-1;", intClient
   
    k = 0
    For i = 0 To picDraw.Width / Screen.TwipsPerPixelX - 3
        blnEmptyLine = True
        strCounter = Format(CStr(i), "000")
        SendArray(k) = Asc(Mid$(strCounter, 1, 1))
        SendArray(k + 1) = Asc(Mid$(strCounter, 2, 1))
        SendArray(k + 2) = Asc(Mid$(strCounter, 3, 1))
        k = k + 3

        For j = 0 To picDraw.Height / Screen.TwipsPerPixelY - 3
           
            lngColor = GetPixel(picDraw.hDC, i, j)
            If lngColor <> 16777215 Then
                blnEmptyLine = False
            End If

        Select Case lngColor
            Case 0 'Greyscale (0)
                bytColor = 70
            Case 855309 'Greyscale (5)
                bytColor = 71
            Case 1776411 'Greyscale (11)
                bytColor = 72
            Case 2631720 'Greyscale (16)
                bytColor = 73
            Case 3552822 'Greyscale (21)
                bytColor = 74
            Case 4408131 'Greyscale (26)
                bytColor = 75
            Case 5329233 'Greyscale (32)
                bytColor = 76
            Case 6184542 'Greyscale (37)
                bytColor = 77
            Case 7039851 'Greyscale (42)
                bytColor = 78
            Case 7960953 'Greyscale (47)
                bytColor = 79
            Case 8816262 'Greyscale (53)
                bytColor = 80
            Case 9737364 'Greyscale (58)
                bytColor = 81
            Case 10592673 'Greyscale (63)
                bytColor = 82
            Case 11447982 'Greyscale (68)
                bytColor = 83
            Case 12369084 'Greyscale (74)
                bytColor = 84
            Case 13224393 'Greyscale (79)
                bytColor = 85
            Case 14145495 'Greyscale (84)
                bytColor = 86
            Case 15000804 'Greyscale (89)
                bytColor = 87
            Case 15921906 'Greyscale (95)
                bytColor = 88
            Case 16777215 'Greyscale (100)
                bytColor = 89
            Case 12632319 'Red
                bytColor = 90
            Case 8421631 'Red
                bytColor = 91
            Case 255 'Red
                bytColor = 92
            Case 192 'Red
                bytColor = 93
            Case 128 'Red
                bytColor = 94
            Case 12640511 'Orange
                bytColor = 95
            Case 8438015 'Orange
                bytColor = 96
            Case 33023 'Orange
                bytColor = 97
            Case 16576 'Orange
                bytColor = 98
            Case 16512 'Orange
                bytColor = 99
            Case 12648447 'Yellow
                bytColor = 100
            Case 8454143 'Yellow
                bytColor = 101
            Case 65535 'Yellow
                bytColor = 102
            Case 49344 'Yellow
                bytColor = 103
            Case 32896 'Yellow
                bytColor = 104
            Case 12648384 'Green
                bytColor = 105
            Case 8454016 'Green
                bytColor = 106
            Case 65280 'Green
                bytColor = 107
            Case 49152 'Green
                bytColor = 108
            Case 32768 'Green
                bytColor = 109
            Case 16777152 'Cyan
                bytColor = 110
            Case 16777088 'Cyan
                bytColor = 110
            Case 16776960 'Cyan
                bytColor = 112
            Case 12632064 'Cyan
                bytColor = 113
            Case 8421376 'Cyan
                bytColor = 114
            Case 16761024 'Blue
                bytColor = 115
            Case 16744576 'Blue
                bytColor = 116
            Case 16711680 'Blue
                bytColor = 117
            Case 12582912 'Blue
                bytColor = 118
            Case 8388608 'Blue
                bytColor = 119
            Case 16761087 'Purple
                bytColor = 120
            Case 16744703 'Purple
                bytColor = 121
            Case 16711935 'Purple
                bytColor = 122
            Case 12583104 'Purple
                bytColor = 123
            Case 8388736 'Purple
                bytColor = 124
            End Select

            SendArray(j + k) = bytColor
        Next j
       
        If Not blnEmptyLine Then
            k = k + 179
        Else
            k = k - 3
        End If
       
        If k > 10000 Then
            SendString = Mid$(StrConv(SendArray(), vbUnicode), 1, k)
            SendToPerson SCK_CODE_FULLDRAWING & SendString & ";", intClient
            k = 0
        End If
    Next i
   
    strCounter = Format(CStr(i), "000")
    SendArray(k) = Asc("9")
    SendArray(k + 1) = Asc("9")
    SendArray(k + 2) = Asc("9")
    k = k + 3
    SendString = Mid$(StrConv(SendArray(), vbUnicode), 1, k)
    SendToPerson SCK_CODE_FULLDRAWING & SendString & ";", intClient
   
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - SendDrawingToClient - " & err.Description & " - " & err.Number
   
    'Make sure that picDraw is opened for drawing at the client.
    SendToPerson SCK_CODE_FULLDRAWING & 999 & ";", intClient
End Sub

Private Sub ProcessDrawLine(strDraw As String)
On Error GoTo err:
    Dim i As Long
    Dim j As Long
    Dim lngColor As Long
    Dim lngChar As Byte
    Dim strCounter As String
    Dim intCollumn As Integer
   
    If Len(strDraw) = 0 Then Exit Sub
      
    i = 1
    While i < Len(strDraw)
        'First get the collum number
        strCounter = Mid$(strDraw, i, 3)
       
        intCollumn = CInt(strCounter)
       
        If intCollumn = 999 Then '999 is the terminator.
            picDraw.Refresh
            picDraw.Enabled = True
            i = Len(strDraw) 'Stop the loop
        Else
            i = i + 3
            For j = 0 To 178
                lngChar = Asc(Mid$(strDraw, i, 1))
                lngColor = ColorArray(lngChar - 70)
                SetPixel picDraw.hDC, intCollumn, j, lngColor
                i = i + 1
            Next j
        End If
    Wend
   
    Exit Sub
err:
    DebugLog "ERR - frmChatTool - ProcessDrawLine - " & err.Description & " - " & err.Number
    'The best thing we can do.
    picDraw.Refresh
    picDraw.Enabled = True
End Sub

Private Function Encrypt(strRawData As String) As String
'To avoid that the messages are send in clear text over the network.
'A simple algorithm is used. The bytes in the text are shiftet 40 places the right.
'I don't think NSA will have any problem cracking this code though :).
On Error GoTo err:
    Dim bytChar As Byte
    Dim SendArray() As Byte 'Used for a way faster string manipulation.
    Dim i As Long
    ReDim SendArray(Len(strRawData) - 1)
   
    CopyMemory SendArray(0), ByVal strRawData, Len(strRawData)
   
    For i = 0 To Len(strRawData) - 1
        bytChar = SendArray(i)
        If bytChar <= 215 Then
            bytChar = bytChar + 40
        Else
            bytChar = bytChar - 215
        End If
        SendArray(i) = bytChar
    Next i
   
    Encrypt = StrConv(SendArray(), vbUnicode)
   
    Exit Function
err:
    DebugLog "ERR - frmChatTool - Encrypt - strRawData =" & strRawData & " - " & err.Description & " - " & err.Number
End Function

Private Function Decrypt(strRawData As String) As String
    Dim bytChar As Byte
    Dim ReceiveArray() As Byte 'Used for a way faster string manipulation.
    Dim i As Long
    ReDim ReceiveArray(Len(strRawData) - 1)
    CopyMemory ReceiveArray(0), ByVal strRawData, Len(strRawData)
    For i = 0 To Len(strRawData) - 1
        bytChar = ReceiveArray(i)
        If bytChar >= 40 Then
            bytChar = bytChar - 40
        Else
            bytChar = bytChar + 215
        End If
        ReceiveArray(i) = bytChar
    Next i
    Decrypt = StrConv(ReceiveArray(), vbUnicode)
    Exit Function
err:
    DebugLog "ERR - frmChatTool - Decrypt - strRawData =" & strRawData & " - " & err.Description & " - " & err.Number
End Function

Project Homepage: