frmMiniChat.frm

 VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form frmMiniChat
   Appearance      =   0  'Flat
   BackColor       =   &H00E0E0E0&
   BorderStyle     =   0  'None
   ClientHeight    =   900
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   8385
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   FillStyle       =   7  'Diagonal Cross
   Icon            =   "frmMiniChat.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   900
   ScaleWidth      =   8385
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox txtMiniSend
      BackColor       =   &H00E0E0E0&
      BorderStyle     =   0  'None
      CausesValidation=   0   'False
      BeginProperty Font
         Name            =   "Arial"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   165
      MaxLength       =   2000
      TabIndex        =   0
      Top             =   675
      Width           =   6525
   End
   Begin VB.Timer tmrCheckIfJumpToBottom
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   7470
      Top             =   210
   End
   Begin RichTextLib.RichTextBox rtbMiniDialog
      Height          =   630
      Left            =   30
      TabIndex        =   2
      TabStop         =   0   'False
      Top             =   15
      Width           =   7875
      _ExtentX        =   13891
      _ExtentY        =   1111
      _Version        =   393217
      BackColor       =   14737632
      BorderStyle     =   0
      Enabled         =   0   'False
      ReadOnly        =   -1  'True
      MousePointer    =   1
      Appearance      =   0
      TextRTF         =   $"frmMiniChat.frx":08CA
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Arial"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.Line linVertical
      BorderColor     =   &H00404040&
      X1              =   6780
      X2              =   6780
      Y1              =   660
      Y2              =   900
   End
   Begin VB.Image imgMiniTintin
      Appearance      =   0  'Flat
      Height          =   480
      Left            =   7920
      Picture         =   "frmMiniChat.frx":0941
      Stretch         =   -1  'True
      Top             =   195
      Width           =   480
   End
   Begin VB.Label lblMinichat
      BackColor       =   &H00C0C0C0&
      Caption         =   " ChatTool MiniChat"
      BeginProperty Font
         Name            =   "Arial"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00404040&
      Height          =   210
      Left            =   6795
      TabIndex        =   1
      Top             =   675
      Width           =   1575
   End
   Begin VB.Shape shpFrame
      Height          =   900
      Left            =   0
      Top             =   0
      Width           =   8385
   End
   Begin VB.Line linSplitter
      X1              =   8385
      X2              =   0
      Y1              =   660
      Y2              =   660
   End
   Begin VB.Label lblStarter
      BackColor       =   &H00C0C0C0&
      Caption         =   " >"
      BeginProperty Font
         Name            =   "Arial"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00404040&
      Height          =   210
      Left            =   0
      TabIndex        =   3
      Top             =   675
      Width           =   150
   End
End
Attribute VB_Name = "frmMiniChat"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const MAX_MESSAGELINES = 100

Private Declare Function SetActiveWindow Lib "user32" (ByVal hwnd As Long) As Long

' *** Dock (START)
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
              ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
              ByVal cy As Long, ByVal wFlags As Long) As Long
'Const HWND_TOPMOST = -1
'Const HWND_NOTOPMOST = -2
Const SPI_GETWORKAREA = 48

'Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long

Private blnSnapDistance  As Long
Private blnStartDragX As Single
Private blnStartDragY As Single
Private blnWorkAreaRect As RECT

'Are we attached to some edge of the screen?
Private blnAttachedToRight As Boolean
Private blnAttachedToLeft As Boolean
Private blnAttachedToTop As Boolean
Private blnAttachedToBottom As Boolean
Private blnWindowStyle As Long
' *** Dock (END)

Private intMiniChatXPos As Integer
Private intMiniChatYPos As Integer
Private intMiniChatWidth As Integer
Private intMiniChatHeight As Integer
Private lngMiniChatMessageCounter As Long
Private blnHasBeenHereBefore As Boolean
Private blnResizingForm As Boolean
Private sglXStartPos As Single
Private sglYStartPos As Single
Private strTmpText As String
Public lngLastScrollTimeRtbMiniDialog As Long
Public blnSwitchToMainChatForm As Boolean

Public Sub Init()
On Error GoTo err:

    StayOnDesktop
   
    If Not blnHasBeenHereBefore Then
        blnHasBeenHereBefore = True
        strTmpText = GetText(1601) 'Text: Use <Ctrl>+<Space> to switch between MiniChat and the normal chat-window.
        UpdateDialog 0, "", "••• " & strTmpText, time()
        SendMessage rtbMiniDialog.hwnd, WM_VSCROLL, SB_BOTTOM, 0 'Older versions of RichTextBox require this for jumping to the bottom the first time.
    End If
   
    txtMiniSend.Text = frmChatTool.txtSend.Text
    txtMiniSend.SelStart = Len(txtMiniSend.Text)
   
    OnTop Me, True
    lngLastScrollTimeRtbMiniDialog = -1 'Enable text scroll
    tmrCheckIfJumpToBottom.Enabled = True
 
    'Form_activate is not entered in a situation, where MiniChat is made invisible by pressing the ESC key
    'and made visible again by clicking the systray-icon.
    rtbMiniDialog.SelStart = Len(rtbMiniDialog.Text)
    SetFocusAPI txtMiniSend.hwnd
    SetForegroundWindow Me.hwnd
    Me.Show vbModal
    Exit Sub
err:
    DebugLog "ERR - frmMiniChat - Init - " & err.Description & " - " & err.Number
End Sub

Private Sub Form_activate()
    If Me.Visible Then
        frmChatTool.Visible = False
        tmrCheckIfJumpToBottom.Enabled = True
    End If
End Sub

Private Sub Form_Deactivate()
    tmrCheckIfJumpToBottom.Enabled = False
End Sub

Private Sub Form_Load()
On Error GoTo err:
    intMiniChatXPos = CInt(GetRegistrySetting("MiniChatXpos", "200")) 'In pixels
    intMiniChatYPos = CInt(GetRegistrySetting("MiniChatYpos", "0")) 'In pixels
    intMiniChatWidth = CInt(GetRegistrySetting("MiniChatWidth", "559")) 'In pixels
    intMiniChatHeight = CInt(GetRegistrySetting("MiniChatHeight", "60")) 'In pixels
   
    OnTop Me, True
    Me.Left = intMiniChatXPos * Screen.TwipsPerPixelX
    Me.Top = intMiniChatYPos * Screen.TwipsPerPixelY
   
    SetFormHeightAndWidth intMiniChatHeight, intMiniChatWidth
   
    Me.BackColor = Title.ColorB
    txtMiniSend.BackColor = Title.ColorB
    lblMinichat.BackColor = Title.BackColor
    lblStarter.BackColor = Title.BackColor
    rtbMiniDialog.BackColor = Title.ColorB
    blnSnapDistance = 10 * Screen.TwipsPerPixelX
    rtbMiniDialog.Text = ""
   
    LoadGUIText

    Exit Sub
err:
    DebugLog "ERR - frmMiniChat - Form_load - " & err.Description & " - " & err.Number
End Sub

Public Sub LoadGUIText()
    'The form caption is visible in the (<Alt>+<Tab>) tasklist.
    Me.Caption = GetText(1602) 'Text: Legendary ChatTool
End Sub

Private Sub SetFormHeightAndWidth(Height As Integer, Width As Integer) 'In pixels
    'Place the Tintin-icon so the form gets the correct height and width after resize.
    imgMiniTintin.Left = Width * Screen.TwipsPerPixelX - imgMiniTintin.Width
    imgMiniTintin.Top = Height * Screen.TwipsPerPixelY - imgMiniTintin.Height - lblMinichat.Height - 2 * Screen.TwipsPerPixelY
    ResizeForm 0, 0, True 'Initial situation
End Sub

Private Sub StayOnDesktop()

    GetDeskTopSize

    If Me.Left + Me.Width > lngDesktopWidth Then
        Me.Left = lngDesktopWidth - Me.Width
    End If
   
    If Me.Left < 0 Then
        Me.Left = 0
    End If
   
    If Me.Top + Me.Height > lngDesktopHeight Then
        Me.Top = lngDesktopHeight - Me.Height
    End If
   
    If Me.Top < 0 Then
        Me.Top = 0
    End If
   
End Sub

Private Sub imgMiniTintin_DblClick()
    blnSwitchToMainChatForm = True
    Me.Hide
End Sub

Private Sub imgMiniTintin_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbLeftButton Then
        StartDockDrag x, y
    End If
    If Button = vbRightButton Then
        imgMiniTintin.MousePointer = 8
        blnResizingForm = True
        sglXStartPos = x
        sglYStartPos = y
        SendMessage rtbMiniDialog.hwnd, WM_SETREDRAW, ByVal 0&, ByVal 0&
    End If
End Sub

Private Sub imgMiniTintin_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
   
    If Button = vbLeftButton Then
        UpdateDockDrag x, y
    End If
   
    If Button = vbRightButton Then
        ResizeForm x, y
    End If

End Sub

Private Sub ResizeForm(x As Single, y As Single, Optional blnInitial As Boolean = False)
On Error GoTo err:
    Dim sglNewImgMiniTintinXpos As Single
    Dim sglNewImgMiniTintinYpos As Single
    sglNewImgMiniTintinXpos = imgMiniTintin.Left + x - sglXStartPos
    If sglNewImgMiniTintinXpos > 2500 And sglNewImgMiniTintinXpos < 12000 Or blnInitial Then
        imgMiniTintin.Left = sglNewImgMiniTintinXpos
        shpFrame.Width = imgMiniTintin.Left + imgMiniTintin.Width
        frmMiniChat.Width = imgMiniTintin.Left + imgMiniTintin.Width
        rtbMiniDialog.Width = imgMiniTintin.Left
        lblMinichat.Left = imgMiniTintin.Left + imgMiniTintin.Width - lblMinichat.Width - Screen.TwipsPerPixelX
        linSplitter.X1 = 0
        linSplitter.X2 = linSplitter.X1 + imgMiniTintin.Left + imgMiniTintin.Width
        linVertical.X1 = lblMinichat.Left - Screen.TwipsPerPixelX
        linVertical.X2 = lblMinichat.Left - Screen.TwipsPerPixelX
        txtMiniSend.Width = lblMinichat.Left - 5 * Screen.TwipsPerPixelX - lblStarter.Width
    End If
   
    sglNewImgMiniTintinYpos = imgMiniTintin.Top + y - sglYStartPos
    If sglNewImgMiniTintinYpos >= 180 And sglNewImgMiniTintinYpos < 4000 Or blnInitial Then
        imgMiniTintin.Top = sglNewImgMiniTintinYpos
        rtbMiniDialog.Height = imgMiniTintin.Top + imgMiniTintin.Height - 2 * Screen.TwipsPerPixelY
        linSplitter.Y1 = sglNewImgMiniTintinYpos + imgMiniTintin.Height
        linSplitter.Y2 = sglNewImgMiniTintinYpos + imgMiniTintin.Height
        shpFrame.Height = imgMiniTintin.Top + imgMiniTintin.Height + lblMinichat.Height + 2 * Screen.TwipsPerPixelY
        linVertical.Y1 = sglNewImgMiniTintinYpos + imgMiniTintin.Height
        linVertical.Y2 = shpFrame.Height
        frmMiniChat.Height = imgMiniTintin.Top + imgMiniTintin.Height + lblMinichat.Height + 2 * Screen.TwipsPerPixelY
        txtMiniSend.Top = imgMiniTintin.Top + imgMiniTintin.Height + Screen.TwipsPerPixelY
        lblMinichat.Top = imgMiniTintin.Top + imgMiniTintin.Height + Screen.TwipsPerPixelY
        lblStarter.Top = imgMiniTintin.Top + imgMiniTintin.Height + Screen.TwipsPerPixelY
    End If
    Exit Sub
err:
    DebugLog "ERR - frmMiniChat - ResizeForm - " & err.Description & " - " & err.Number
End Sub

Private Sub imgMiniTintin_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error GoTo err:
    Dim intWidth As Integer
    Dim intHeight As Integer
   
    StayOnDesktop
   
    StoreXYPosition
  
    If blnResizingForm Then
        sglXStartPos = 0
        sglYStartPos = 0
        intWidth = Me.Width / Screen.TwipsPerPixelX
        intHeight = Me.Height / Screen.TwipsPerPixelY
        PutRegistrySetting "MiniChatWidth", CStr(intWidth)
        PutRegistrySetting "MiniChatHeight", CStr(intHeight)
       
        SetFormHeightAndWidth intHeight, intWidth
       
        blnResizingForm = False
        rtbMiniDialog.SelStart = 0
        rtbMiniDialog.SelStart = Len(rtbMiniDialog.Text)
        SendMessage rtbMiniDialog.hwnd, WM_SETREDRAW, ByVal 1&, ByVal 0&
        DoEvents
        rtbMiniDialog.Refresh
    End If
   
    imgMiniTintin.MousePointer = vbDefault
    Exit Sub
err:
    DebugLog "ERR - frmMiniChat - imgMiniTintin_MouseUp - " & err.Description & " - " & err.Number
End Sub

Private Sub StoreXYPosition()
On Error GoTo err:
    Dim intXPos As Integer
    Dim intYPos As Integer
   
    intXPos = Me.Left / Screen.TwipsPerPixelX
    intYPos = Me.Top / Screen.TwipsPerPixelY
   
    PutRegistrySetting "MiniChatXpos", CStr(intXPos)
    PutRegistrySetting "MiniChatYpos", CStr(intYPos)
    Exit Sub
err:
    DebugLog "ERR - frmMiniChat - StoreXYPosition - " & err.Description & " - " & err.Number
End Sub

Private Sub lblMinichat_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbLeftButton Then
        StartDockDrag x, y
    End If
End Sub

Private Sub lblMinichat_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbLeftButton Then
        UpdateDockDrag x, y
    End If
End Sub

Private Sub lblMinichat_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    StayOnDesktop
    StoreXYPosition
End Sub

Private Sub lblStarter_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbLeftButton Then
        StartDockDrag x, y
    End If
End Sub

Private Sub lblStarter_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbLeftButton Then
        UpdateDockDrag x, y
    End If
End Sub

Private Sub lblStarter_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    StayOnDesktop
    StoreXYPosition
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbLeftButton Then
        StartDockDrag x, y
    End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbLeftButton Then
        UpdateDockDrag x, y
    End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    StayOnDesktop
    StoreXYPosition
End Sub

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

Private Sub txtMiniSend_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo err:
    Select Case KeyCode
    Case vbKeyUp
        If CtrlKeyPressed() Then
            SendMessage rtbMiniDialog.hwnd, WM_VSCROLL, SB_LINEUP, 0
            lngLastScrollTimeRtbMiniDialog = Int(Timer())
        Else
            HistoryPrevious txtMiniSend
        End If
        KeyCode = 0
    Case vbKeyDown
        If CtrlKeyPressed() Then
            SendMessage rtbMiniDialog.hwnd, WM_VSCROLL, SB_LINEDOWN, 0
            lngLastScrollTimeRtbMiniDialog = Int(Timer())
        Else
            HistoryNext txtMiniSend
        End If
        KeyCode = 0
    Case vbKeySpace
        If CtrlKeyPressed() Then
            blnSwitchToMainChatForm = True
            Me.Hide
            KeyCode = 0
        End If
    Case vbKeyHome
        If CtrlKeyPressed() Then
            SendMessage rtbMiniDialog.hwnd, WM_VSCROLL, SB_TOP, 0
            lngLastScrollTimeRtbMiniDialog = Int(Timer())
            KeyCode = 0
        End If
    Case vbKeyEnd
        If CtrlKeyPressed() Then
            SendMessage rtbMiniDialog.hwnd, WM_VSCROLL, SB_BOTTOM, 0
            lngLastScrollTimeRtbMiniDialog = -1 'Enable text scroll
            KeyCode = 0
        End If
    Case vbKeyPageUp
        SendMessage rtbMiniDialog.hwnd, WM_VSCROLL, SB_PAGEUP, 0
        lngLastScrollTimeRtbMiniDialog = Int(Timer())
    Case vbKeyPageDown
        SendMessage rtbMiniDialog.hwnd, WM_VSCROLL, SB_PAGEDOWN, 0
        lngLastScrollTimeRtbMiniDialog = Int(Timer())
    Case Else
        ResetHistoryPointer
    End Select
    Exit Sub
err:
    DebugLog "ERR - frmMiniChat - txtMiniSend_KeyDown - " & err.Description & " - " & err.Number
End Sub

Private Sub txtMiniSend_KeyPress(KeyAscii As Integer)
On Error GoTo err:
    'Placed in KeyPress to avoid the system-beep when txtMiniSend not multiline.
    Select Case KeyAscii
    Case vbKeyReturn
        lngLastScrollTimeRtbMiniDialog = -1 'Enable text scroll
        frmChatTool.txtSend.Text = txtMiniSend.Text
        frmChatTool.bgCmdSend_Click
        txtMiniSend.Text = ""
        SetFocusAPI txtMiniSend.hwnd
        KeyAscii = 0
    'Also placed here to avoid beep.
    Case vbKeyEscape
        frmChatTool.txtSend.Text = txtMiniSend.Text
        blnSwitchToMainChatForm = False
        KeyAscii = 0
        Me.Hide
    End Select
Exit Sub
err:
    DebugLog "ERR - frmMiniChat - txtMiniSend_KeyPress - " & err.Description & " - " & err.Number
End Sub

Private Sub StartDockDrag(ByVal x As Single, ByVal y As Single)
    ' Get the WorkArea - the area of the desktop not taken
    ' by the taskbar, using a little known but interesting
    ' API call
    SystemParametersInfo SPI_GETWORKAREA, 0&, blnWorkAreaRect, 0&
   
    ' Convert from pixels to twips
    blnWorkAreaRect.Top = blnWorkAreaRect.Top * Screen.TwipsPerPixelY
    blnWorkAreaRect.Left = blnWorkAreaRect.Left * Screen.TwipsPerPixelX
    blnWorkAreaRect.Bottom = blnWorkAreaRect.Bottom * Screen.TwipsPerPixelY
    blnWorkAreaRect.Right = blnWorkAreaRect.Right * Screen.TwipsPerPixelX
   
    blnStartDragX = x
    blnStartDragY = y
End Sub

Private Sub UpdateDockDrag(ByVal x As Single, ByVal y As Single)
On Error GoTo err:
Dim DiffX As Long, DiffY As Long
Dim NewX As Long, NewY As Long
Dim ToLeftDistance As Long
Dim ToRightDistance As Long
Dim ToTopDistance As Long
Dim ToBottomDistance As Long

    DiffX = x - blnStartDragX
    DiffY = y - blnStartDragY
   
    If DiffX = 0 And DiffY = 0 Then Exit Sub
   
    NewX = Me.Left + DiffX
    NewY = Me.Top + DiffY
   
    ' Find the distance to the screen edges
    ToRightDistance = blnWorkAreaRect.Right - (NewX + Me.Width)
    ToLeftDistance = NewX - blnWorkAreaRect.Left
    ToBottomDistance = blnWorkAreaRect.Bottom - (NewY + Me.Height)
    ToTopDistance = NewY - blnWorkAreaRect.Top
   
    'The idea in all the following code is the same:
    'If we are not already attached some specific edge,
    'find out if we should.
    'If we are already attached, find out whether we should
    '"break" the attachment, or stay put.
    If Not blnAttachedToBottom Then
        If Abs(ToBottomDistance) <= blnSnapDistance Then
            'Attach to edge
            NewY = Me.Top + ToBottomDistance
            blnAttachedToBottom = True
        End If
    Else
        If Abs(ToBottomDistance) > blnSnapDistance Then
            'Break the attachement
            blnAttachedToBottom = False
        Else
            'Stay at current position
            NewY = Me.Top
        End If
    End If
   
    If Not blnAttachedToTop Then
        If Abs(ToTopDistance) <= blnSnapDistance Then
            NewY = blnWorkAreaRect.Top
            blnAttachedToTop = True
        End If
    Else
        If Abs(ToTopDistance) > blnSnapDistance Then
            blnAttachedToTop = False
        Else
            NewY = Me.Top
        End If
    End If

    If Not blnAttachedToRight Then
        If Abs(ToRightDistance) <= blnSnapDistance Then
            NewX = blnWorkAreaRect.Right - Me.Width
            blnAttachedToRight = True
        End If
    Else
        If Abs(ToRightDistance) > blnSnapDistance Then
            blnAttachedToRight = False
        Else
            NewX = Me.Left
        End If
    End If

    If Not blnAttachedToLeft Then
        If Abs(ToLeftDistance) <= blnSnapDistance Then
            NewX = blnWorkAreaRect.Left
            blnAttachedToLeft = True
        End If
    Else
        If Abs(ToLeftDistance) > blnSnapDistance Then
            blnAttachedToLeft = False
        Else
            NewX = Me.Left
        End If
    End If
    'Position the window, converting to pixels again
    SetWindowPos Me.hwnd, blnWindowStyle, _
        NewX / Screen.TwipsPerPixelX, _
        NewY / Screen.TwipsPerPixelY, _
        Me.Width / Screen.TwipsPerPixelX, _
        Me.Height / Screen.TwipsPerPixelY, 0
    Exit Sub
err:
    DebugLog "ERR - frmMiniChat - UpdateDockDrag - " & err.Description & " - " & err.Number
End Sub

Public Sub UpdateDialog(intPrivateMessage As Integer, strFromuser As String, _
    ByVal strDialog As String, strTime As String)
On Error GoTo err:
    Dim intCrLfPos As Integer
    Dim blnPrivateMessage As Boolean
    Dim strFormattedTime As String
    Dim strNewLine As String
    Dim i As Integer
    Dim lngRtbMiniTextLength As Long
    Dim intMousePointer As Integer
   
    intCrLfPos = 0
   
    'If there are more than MAX_MESSAGELINES lines in the rtbMiniDialog then delete the first line.
    If lngMiniChatMessageCounter >= MAX_MESSAGELINES Then
        'Jump over the standard top text when it it displayed.
        If lngMiniChatMessageCounter > MAX_MESSAGELINES Then
            intCrLfPos = InStr(1, rtbMiniDialog.Text, vbCrLf)
        Else
            lngMiniChatMessageCounter = lngMiniChatMessageCounter + 1
        End If
        intCrLfPos = InStr(intCrLfPos + 1, rtbMiniDialog.Text, vbCrLf)
        strTmpText = GetText(1600) 'Text: Only %1 lines shown in MiniChat.
        strTmpText = Replace(strTmpText, "%1", MAX_MESSAGELINES) & vbCrLf
        With rtbMiniDialog
            SendMessage .hwnd, WM_SETREDRAW, ByVal 0&, ByVal 0&
            intMousePointer = Screen.MousePointer
            .SelStart = 0
            .SelLength = intCrLfPos + 1
            .SelText = strTmpText
            Screen.MousePointer = intMousePointer
            SendMessage .hwnd, WM_SETREDRAW, ByVal 1&, ByVal 0&
        End With
    Else
        lngMiniChatMessageCounter = lngMiniChatMessageCounter + 1
    End If
   
    '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", ""), " ", "")
   
    SendMessage rtbMiniDialog.hwnd, WM_SETREDRAW, ByVal 0&, ByVal 0& 'Avoid flickering in the rtbMiniDialog
    lngRtbMiniTextLength = Len(rtbMiniDialog.Text)
    rtbMiniDialog.SelStart = lngRtbMiniTextLength
    If lngRtbMiniTextLength = 0 Then
        If strFromuser <> "" Then
            strNewLine = strFormattedTime & " " & strFromuser & "> " & strDialog
        Else
            strNewLine = strFormattedTime & " " & strDialog
        End If
        rtbMiniDialog.SelText = strNewLine
        rtbMiniDialog.SelStart = 0
        rtbMiniDialog.SelLength = Len(strFormattedTime)
        rtbMiniDialog.SelColor = 8421504 'Make the time dark grey
        rtbMiniDialog.SelStart = Len(strFormattedTime) + 1
        If strFromuser <> "" Then
            rtbMiniDialog.SelLength = Len(strFromuser) + 2 '1 = >
        Else
            rtbMiniDialog.SelLength = 0
        End If
    Else
        If strFromuser <> "" Then
            strNewLine = vbCrLf & strFormattedTime & " " & strFromuser & "> " & strDialog
        Else
            strNewLine = vbCrLf & strFormattedTime & " " & strDialog
        End If
        rtbMiniDialog.SelText = strNewLine
        rtbMiniDialog.SelStart = lngRtbMiniTextLength
        rtbMiniDialog.SelLength = Len(strFormattedTime) + 2
        rtbMiniDialog.SelColor = 8421504 'Make the time dark grey
        rtbMiniDialog.SelStart = lngRtbMiniTextLength + Len(strFormattedTime) + 2
        If strFromuser <> "" Then
            rtbMiniDialog.SelLength = Len(strFromuser) + 2 '1 = >
        Else
            rtbMiniDialog.SelLength = 0
        End If
    End If
   
    rtbMiniDialog.SelBold = True
    If intPrivateMessage = 1 Then
        rtbMiniDialog.SelColor = 8421504 'Grey
    End If
   
    'Make sure that the last line is fully visible i the text box.
    rtbMiniDialog.SelStart = Len(rtbMiniDialog.Text)
    SendMessage rtbMiniDialog.hwnd, WM_SETREDRAW, ByVal 1&, ByVal 0&
    rtbMiniDialog.Refresh
   
    Exit Sub
err:
    DebugLog "ERR - frmMiniChat - UpdateDialog - " & err.Description & " - " & err.Number & " - " & CStr(intPrivateMessage) & _
        " - " & strFromuser & " - " & strDialog & " - " & strTime
End Sub

Public Sub ClearDialog()
    rtbMiniDialog.Text = ""
    lngMiniChatMessageCounter = 0
End Sub

   

Project Homepage: