frmOnlineMessageSend.frm

 VERSION 5.00
Begin VB.Form frmOnlineMessageSend
   AutoRedraw      =   -1  'True
   BorderStyle     =   0  'None
   Caption         =   "Form1"
   ClientHeight    =   4560
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   7695
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   4560
   ScaleWidth      =   7695
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox txtSendMessage
      Appearance      =   0  'Flat
      BackColor       =   &H00C0C0FF&
      BeginProperty Font
         Name            =   "Arial"
         Size            =   14.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2055
      Left            =   1695
      MaxLength       =   1000
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Top             =   1650
      Width           =   5790
   End
   Begin VB.PictureBox Picture2
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   285
      Left            =   2505
      ScaleHeight     =   255
      ScaleWidth      =   855
      TabIndex        =   13
      TabStop         =   0   'False
      Top             =   1170
      Width           =   885
      Begin VB.ComboBox cboColor
         Appearance      =   0  'Flat
         BeginProperty Font
            Name            =   "Arial"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   360
         ItemData        =   "frmOnlineMessageSend.frx":0000
         Left            =   -45
         List            =   "frmOnlineMessageSend.frx":0002
         Style           =   2  'Dropdown List
         TabIndex        =   5
         Top             =   -60
         Width           =   960
      End
   End
   Begin VB.PictureBox Picture1
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   330
      Left            =   2835
      ScaleHeight     =   300
      ScaleWidth      =   525
      TabIndex        =   10
      TabStop         =   0   'False
      Top             =   720
      Width           =   555
      Begin VB.ComboBox cboFontSize
         Appearance      =   0  'Flat
         BeginProperty Font
            Name            =   "Arial"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   360
         ItemData        =   "frmOnlineMessageSend.frx":0004
         Left            =   -30
         List            =   "frmOnlineMessageSend.frx":0035
         Style           =   2  'Dropdown List
         TabIndex        =   4
         Top             =   -30
         Width           =   630
      End
   End
   Begin VB.ListBox lstReceivers
      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          =   930
      ItemData        =   "frmOnlineMessageSend.frx":0073
      Left            =   3585
      List            =   "frmOnlineMessageSend.frx":0075
      MultiSelect     =   2  'Extended
      Sorted          =   -1  'True
      TabIndex        =   6
      Top             =   630
      Width           =   3900
   End
   Begin ChatTool.bgDugme bgCmdSend
      Height          =   450
      Left            =   2445
      TabIndex        =   1
      Top             =   3870
      Width           =   1515
      _ExtentX        =   2672
      _ExtentY        =   794
      Caption         =   "&Send"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Object.Width           =   -1
   End
   Begin ChatTool.bgDugme bgCmdCancel
      Height          =   450
      Left            =   4170
      TabIndex        =   2
      Top             =   3870
      Width           =   1515
      _ExtentX        =   2672
      _ExtentY        =   794
      Caption         =   "&Cancel"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Object.Width           =   -1
   End
   Begin ChatTool.bgDugme bgCmdEmoticon
      Height          =   450
      Left            =   270
      TabIndex        =   3
      Top             =   2415
      Width           =   1185
      _ExtentX        =   2090
      _ExtentY        =   794
      Caption         =   "&Emoticon"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Object.Width           =   -1
   End
   Begin VB.Label lblColor
      Caption         =   "Color:"
      BeginProperty Font
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   285
      Left            =   1770
      TabIndex        =   12
      Top             =   1170
      Width           =   615
   End
   Begin VB.Label lblFont
      Caption         =   "Font:"
      BeginProperty Font
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   1695
      TabIndex        =   11
      Top             =   375
      Width           =   1365
   End
   Begin VB.Label lblReceiverlist
      Caption         =   "Receiverlist:"
      BeginProperty Font
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   285
      Left            =   3600
      TabIndex        =   9
      Top             =   375
      Width           =   1980
   End
   Begin VB.Label lblEmoticon
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BorderStyle     =   1  'Fixed Single
      Caption         =   " Emoticon "
      BeginProperty Font
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   405
      TabIndex        =   8
      Top             =   2055
      Width           =   900
   End
   Begin VB.Label lblFontSize
      Caption         =   "Size:"
      BeginProperty Font
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   285
      Left            =   1785
      TabIndex        =   7
      Top             =   750
      Width           =   930
   End
   Begin VB.Image imgSmiley
      Height          =   825
      Left            =   420
      Top             =   900
      Width           =   870
   End
   Begin VB.Shape shpFrame
      BackStyle       =   1  'Opaque
      Height          =   1335
      Left            =   195
      Shape           =   5  'Rounded Square
      Top             =   630
      Width           =   1335
   End
   Begin VB.Shape shpFontTools
      BackStyle       =   1  'Opaque
      Height          =   930
      Left            =   1695
      Top             =   630
      Width           =   1800
   End
End
Attribute VB_Name = "frmOnlineMessageSend"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Aktiv As Boolean
Private WithEvents cmdClose As VBControlExtender
Attribute cmdClose.VB_VarHelpID = -1
Private strTmpText As String
Private blnOkPressed As Boolean

Private Sub bgCmdCancel_Click()
    Unload Me
End Sub

Private Sub bgCmdEmoticon_Click()
    On Error GoTo err:
    frmEmoticons.Show vbModal
    If frmEmoticons.intChosenEmoticonIndex <> -1 Then
        imgSmiley.Visible = True
        imgSmiley.Picture = frmEmoticons.imgSmiley(frmEmoticons.intChosenEmoticonIndex)
        imgSmiley.Left = shpFrame.Left + shpFrame.Width / 2 - imgSmiley.Width / 2
        imgSmiley.Top = shpFrame.Top + shpFrame.Height / 2 - imgSmiley.Height / 2
        lblEmoticon.Caption = " " & frmEmoticons.GetEmoticonName(frmEmoticons.intChosenEmoticonIndex) & " "
        imgSmiley.ZOrder 0
    Else
        imgSmiley.Visible = False
        lblEmoticon.Caption = " " & GetText(1735) & " " 'Text: Emoticon
    End If
    Exit Sub
err:
    DebugLog "ERR - frmOnlineMessageSend - bgCmdEmoticon_Click - " & err.Number & " - " & err.Description
End Sub

Private Sub bgCmdSend_Click()
On Error GoTo err:
    Dim strSendTo As String
    Dim i As Integer
    Dim strSendMesssage As String
   
    strSendMesssage = Replace$(txtSendMessage.Text, vbCrLf, "\{vbCrlf}")
   
    If frmChatTool.blnIsServer Then
        i = 0
        While i < lstReceivers.ListCount
            frmChatTool.SendOnlineMessageToClient strSendMesssage, frmEmoticons.intChosenEmoticonIndex, CInt(cboFontSize.Text), txtSendMessage.ForeColor, lstReceivers.ItemData(i)
            i = i + 1
        Wend
    Else
        i = 0
        strSendTo = CStr(lstReceivers.ListCount) & ";"
        While i < lstReceivers.ListCount
            strSendTo = strSendTo & CStr(lstReceivers.ItemData(i)) & ";"
            i = i + 1
        Wend
        frmChatTool.SendOnlineMessageToServer strSendMesssage, strSendTo, frmEmoticons.intChosenEmoticonIndex, CInt(cboFontSize.Text), txtSendMessage.ForeColor
    End If
   
    If Not CtrlKeyPressed Then
        Unload Me
    Else
        txtSendMessage.Text = ""
        txtSendMessage.SetFocus
    End If
    Exit Sub
err:
    DebugLog "ERR - frmOnlineMessageSend - bgCmdSend_Click - " & err.Number & " - " & err.Description
End Sub

Private Sub cboColor_Change()
    Select Case cboColor.Text
        Case GetText(1810) 'Text: Black
            txtSendMessage.ForeColor = vbBlack
        Case GetText(1811) 'Text: Red
            txtSendMessage.ForeColor = vbRed
        Case GetText(1812) 'Text: Blue
            txtSendMessage.ForeColor = vbBlue
        Case Else
            txtSendMessage.ForeColor = vbBlack
    End Select
End Sub

Private Sub cboColor_Click()
    Select Case cboColor.Text
        Case GetText(1810) 'Text: Black
            txtSendMessage.ForeColor = vbBlack
        Case GetText(1811) 'Text: Red
            txtSendMessage.ForeColor = vbRed
        Case GetText(1812) 'Text: Blue
            txtSendMessage.ForeColor = vbBlue
        Case Else
            txtSendMessage.ForeColor = vbBlack
    End Select
End Sub

Private Sub cboFontSize_Change()
   txtSendMessage.Font.Size = CInt(cboFontSize.Text)
End Sub

Private Sub cboFontSize_Click()
   txtSendMessage.Font.Size = CInt(cboFontSize.Text)
End Sub

Private Sub cmdClose_ObjectEvent(Info As EventInfo)
    Unload Me
End Sub

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

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

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyEscape: Unload Me
    End Select
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbLeftButton Then
        If y <= intCloseHeight And x < intCloseLeft Then
            WindowMove Me
        End If
        If Screen.MousePointer <> vbDefault Then Screen.MousePointer = vbDefault
    End If
End Sub

Private Sub Form_Load()
On Error GoTo err:
    Dim i As Integer
    Aktiv = False
    Me.Left = frmChatTool.Left + Int((frmChatTool.Width - Me.Width) / 2)
    Me.Top = frmChatTool.Top + Int((frmChatTool.Height - Me.Height) / 2)
    Set cmdClose = Me.Controls.Add("ChatTool.bgclose", "cmdClose")
    cmdClose.Visible = True
    txtSendMessage.BackColor = Title.txtUnlockedColor
    lblReceiverlist.BackColor = Title.BackColor
    lblFontSize.BackColor = Title.ColorB
    lblFont.BackColor = Title.BackColor
    lblColor.BackColor = Title.ColorB
    lblEmoticon.BackColor = Title.txtLockedColor
    shpFrame.BackColor = Title.txtUnlockedColor
    shpFontTools.BackColor = Title.ColorB
    cboFontSize.BackColor = Title.txtUnlockedColor
    cboFontSize.Text = "14"
    cboColor.BackColor = Title.txtUnlockedColor
    cboColor.ForeColor = vbBlack
    lblEmoticon.Caption = " " & GetText(1735) & " " 'Text: Emoticon
   
    i = 0
    While i < frmChatTool.lstConnections.ListCount
        If frmChatTool.lstConnections.Selected(i) Then
            If Not (frmChatTool.blnIsServer And frmChatTool.lstConnections.ItemData(i) = 0) Then
                If Not (Not frmChatTool.blnIsServer And frmChatTool.lstConnections.ItemData(i) = frmChatTool.intMyClient) Then
                    lstReceivers.AddItem frmChatTool.ConstructNickAndFullname(frmChatTool.lstConnections.ItemData(i))
                    lstReceivers.ItemData(lstReceivers.NewIndex) = frmChatTool.lstConnections.ItemData(i)
                End If
            End If
        End If
        i = i + 1
    Wend
   
    If frmEmoticons.intChosenEmoticonIndex <> -1 Then
        frmEmoticons.ResetSmileyClick
        frmEmoticons.intChosenEmoticonIndex = -1
    End If
   
    LoadGUIText
   
    Exit Sub
err:
    DebugLog "ERR - frmOnlineMessageSend - Form_load - " & err.Number & " - " & err.Description
End Sub

Public Sub LoadGUIText()
    Me.Caption = GetText(1801) 'Text: ChatTool - Online message
    lblFontSize.Caption = GetText(1802) 'Text: Size:
    lblColor.Caption = GetText(1823) 'Text: Farve
    lblReceiverlist.Caption = GetText(1804) 'Text: Receiver list:
    bgCmdCancel.Caption = GetText(1805) 'Text: &Cancel
    bgCmdEmoticon.Caption = GetText(1806) 'Text: &Emoticon
    bgCmdSend.Caption = GetText(1807) 'Text: &Send
    cboColor.AddItem GetText(1810) 'Text: Black
    cboColor.AddItem GetText(1811) 'Text: Red
    cboColor.AddItem GetText(1812) 'Text: Blue
    cboColor.Text = GetText(1810) 'Text: Black
End Sub

Project Homepage: