frmOnlineMessageShow.frm

 VERSION 5.00
Begin VB.Form frmOnlineMessageShow
   AutoRedraw      =   -1  'True
   BorderStyle     =   0  'None
   ClientHeight    =   3525
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   7590
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   ScaleHeight     =   3525
   ScaleWidth      =   7590
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox txtShowMessage
      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            =   1620
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   2
      Top             =   720
      Width           =   5790
   End
   Begin ChatTool.bgDugme bgCmdOk
      Height          =   435
      Left            =   3210
      TabIndex        =   0
      Top             =   2925
      Width           =   1200
      _ExtentX        =   2117
      _ExtentY        =   767
      Caption         =   "&Ok"
      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 lblInLine
      Alignment       =   1  'Right Justify
      BeginProperty Font
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   225
      Left            =   6735
      TabIndex        =   4
      Top             =   3105
      Width           =   675
   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        =   3
      Top             =   2160
      Width           =   900
   End
   Begin VB.Shape shpBinder
      BackColor       =   &H00000000&
      BackStyle       =   1  'Opaque
      Height          =   870
      Left            =   1500
      Top             =   960
      Width           =   120
   End
   Begin VB.Label lblHeading
      Caption         =   "Message heading"
      BeginProperty Font
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   285
      Left            =   180
      TabIndex        =   1
      Top             =   405
      Width           =   5835
   End
   Begin VB.Image imgEmoticon
      Height          =   1305
      Left            =   210
      Top             =   750
      Width           =   1275
   End
   Begin VB.Shape shpFrame
      BackStyle       =   1  'Opaque
      Height          =   1335
      Left            =   180
      Shape           =   4  'Rounded Rectangle
      Top             =   735
      Width           =   1335
   End
End
Attribute VB_Name = "frmOnlineMessageShow"
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 blnIsAMessageDisplayed As Boolean
Private Type message
    strMessage As String
    intEmoticon As Integer
    sinFontSize As Single
    lngFontColor As Long
    strUserName As String
    strTime As String
End Type
Private MessageArray() As message
Private intMessageArrayCount As Integer
Private intLocalMessageCounter As Integer
Private intInLine As Integer
Private typFormSkinLoadType As loadtype

Private Sub bgCmdOk_Click()
On Error GoTo err:
    If intMessageArrayCount - intLocalMessageCounter >= 0 Then
        intInLine = intMessageArrayCount - intLocalMessageCounter
        If intInLine = 0 Then
            lblInLine.Caption = ""
        Else
            lblInLine.Caption = CStr(intMessageArrayCount - intLocalMessageCounter)
        End If
        txtShowMessage.Text = MessageArray(intLocalMessageCounter).strMessage
        txtShowMessage.FontSize = MessageArray(intLocalMessageCounter).sinFontSize
        txtShowMessage.ForeColor = MessageArray(intMessageArrayCount).lngFontColor
       
        If MessageArray(intLocalMessageCounter).intEmoticon <> -1 Then
            imgEmoticon.Picture = frmEmoticons.imgSmiley(MessageArray(intLocalMessageCounter).intEmoticon).Picture
            lblEmoticon.Caption = " " & frmEmoticons.GetEmoticonName(MessageArray(intLocalMessageCounter).intEmoticon) & " "
            lblEmoticon.Visible = True
            imgEmoticon.Visible = True
            shpFrame.Visible = True
            shpBinder.Visible = True
            frmOnlineMessageShow.Width = 7590
            txtShowMessage.Left = 1620
        Else
            lblEmoticon.Visible = False
            imgEmoticon.Visible = False
            shpFrame.Visible = False
            shpBinder.Visible = False
            txtShowMessage.Left = 180
            frmOnlineMessageShow.Width = 7590 - 1620 + 180
        End If
        LoadSkin Me, Active, True, typFormSkinLoadType, 1
        lblInLine.Left = frmOnlineMessageShow.Width - 850
        strTmpText = GetText(1822)  'Text: Message from:
        lblHeading.Caption = strTmpText & " " & MessageArray(intLocalMessageCounter).strUserName & " - " & FormatDateTime(MessageArray(intLocalMessageCounter).strTime, vbGeneralDate)
        imgEmoticon.Left = shpFrame.Left + shpFrame.Width / 2 - imgEmoticon.Width / 2
        imgEmoticon.Top = shpFrame.Top + shpFrame.Height / 2 - imgEmoticon.Height / 2
        intLocalMessageCounter = intLocalMessageCounter + 1
        CenterOnScreen
        bgCmdOk.Left = Int(frmOnlineMessageShow.Width / 2) - Int(bgCmdOk.Width / 2)
    Else
        Me.Hide
    End If
    Exit Sub
err:
    DebugLog "ERR - frmOnlineMessageShow - bgCmdOk_Click - " & err.Number & " - " & err.Description
End Sub

Private Sub cmdClose_ObjectEvent(Info As EventInfo)
    bgCmdOk_Click
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
    bgCmdOk.SetFocus
    Exit Sub
err:
    DebugLog "ERR - frmOnlineMessageShow - 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: Me.Hide
    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
    typFormSkinLoadType = LoadIt
    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
    txtShowMessage.BackColor = Title.ColorB
    lblHeading.BackColor = Title.BackColor
    lblInLine.BackColor = Title.BackColor
    lblEmoticon.BackColor = Title.txtLockedColor
    shpFrame.BackColor = Title.txtUnlockedColor
   
    intMessageArrayCount = 0
    intInLine = 0
    ReDim MessageArray(1) 'One to start on
   
    frmChatTool.blnOnlineMessageShowFormLoaded = True
   
    LoadGUIText
   
    Exit Sub
err:
    DebugLog "ERR - frmOnlineMessageShow - Form_load - " & err.Number & " - " & err.Description
End Sub

Public Function Init(strMessage As String, intEmoticon As Integer, sinFontSize As Single, lngFontColor As Long, intUser As Integer) As Integer
On Error GoTo err:
  
    intMessageArrayCount = intMessageArrayCount + 1
    If intMessageArrayCount > UBound(MessageArray()) Then
        ReDim Preserve MessageArray(intMessageArrayCount + 10)
    End If
   
    If sinFontSize = 0 Then sinFontSize = 9   'In case of an error.
    MessageArray(intMessageArrayCount).strMessage = Replace$(strMessage, "\{vbCrlf}", vbCrLf)
    MessageArray(intMessageArrayCount).intEmoticon = intEmoticon
    MessageArray(intMessageArrayCount).sinFontSize = sinFontSize
    MessageArray(intMessageArrayCount).lngFontColor = lngFontColor
    MessageArray(intMessageArrayCount).strUserName = frmChatTool.ConstructNickAndFullname(intUser)
    MessageArray(intMessageArrayCount).strTime = Format$(Now, "YYYY-MM-DD HH:MM:SS")
   
    If intMessageArrayCount = 1 Then
        intLocalMessageCounter = 1
      
        txtShowMessage.Text = MessageArray(intLocalMessageCounter).strMessage
        txtShowMessage.FontSize = MessageArray(intLocalMessageCounter).sinFontSize
        txtShowMessage.ForeColor = MessageArray(intLocalMessageCounter).lngFontColor
        If MessageArray(intLocalMessageCounter).intEmoticon <> -1 Then
            imgEmoticon.Picture = frmEmoticons.imgSmiley(MessageArray(intLocalMessageCounter).intEmoticon).Picture
            lblEmoticon.Caption = " " & frmEmoticons.GetEmoticonName(MessageArray(intLocalMessageCounter).intEmoticon) & " "
            lblEmoticon.Visible = True
            imgEmoticon.Visible = True
            shpFrame.Visible = True
            shpBinder.Visible = True
            frmOnlineMessageShow.Width = 7590
            txtShowMessage.Left = 1620
        Else
            lblEmoticon.Visible = False
            imgEmoticon.Visible = False
            shpFrame.Visible = False
            shpBinder.Visible = False
            txtShowMessage.Left = 180
            frmOnlineMessageShow.Width = 7590 - 1620 + 180
        End If
        lblInLine.Left = frmOnlineMessageShow.Width - 850
        LoadSkin Me, Active, True, typFormSkinLoadType, 1
        typFormSkinLoadType = reLoad
        strTmpText = GetText(1822)  'Text: Message from:
        lblHeading.Caption = strTmpText & " " & MessageArray(intLocalMessageCounter).strUserName & " - " & FormatDateTime(MessageArray(intLocalMessageCounter).strTime, vbGeneralDate)
        imgEmoticon.Left = shpFrame.Left + shpFrame.Width / 2 - imgEmoticon.Width / 2
        imgEmoticon.Top = shpFrame.Top + shpFrame.Height / 2 - imgEmoticon.Height / 2
        bgCmdOk.Left = Int(frmOnlineMessageShow.Width / 2) - Int(bgCmdOk.Width / 2)
        intLocalMessageCounter = intLocalMessageCounter + 1
        CenterOnScreen
        Me.Show vbModal
        intLocalMessageCounter = 0
        intMessageArrayCount = 0
        ReDim MessageArray(1) 'One to re-start on
    Else
        intInLine = intInLine + 1
        lblInLine.Caption = CStr(intInLine)
    End If
   
    Init = intInLine
   
    Exit Function
err:
    DebugLog "ERR - frmOnlineMessageShow - Init - " & err.Number & " - " & err.Description
End Function

Public Sub LoadGUIText()
    Me.Caption = GetText(1820) 'Text: ChatTool - Online message
    bgCmdOk.Caption = GetText(1821) 'Text: &Ok
End Sub

Public Sub ChangeLanguage()
    LoadGUIText
End Sub

Private Sub CenterOnScreen()
On Error GoTo err:
    'Place in center of screen.
    GetDeskTopSize
    Me.Left = lngDesktopWidth / 2 - Me.Width / 2
    Me.Top = lngDesktopHeight / 2 - Me.Height / 2
    SetForegroundWindow Me.hwnd
    OnTop Me, True
    Exit Sub
err:
    DebugLog "ERR - frmOnlineMessageShow - CenterOnScreen - " & err.Number & " - " & err.Description
End Sub

Project Homepage: