vbAccelerator - Contents of code file: fSysTray.frm

VERSION 5.00
Begin VB.Form frmFileClipboardEnhancer 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "File Clipboard Enhancer"
   ClientHeight    =   3825
   ClientLeft      =   2145
   ClientTop       =   2805
   ClientWidth     =   5370
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "fSysTray.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3825
   ScaleWidth      =   5370
   ShowInTaskbar   =   0   'False
   Begin VB.PictureBox picTab 
      BorderStyle     =   0  'None
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2715
      Index           =   0
      Left            =   180
      ScaleHeight     =   2715
      ScaleWidth      =   4695
      TabIndex        =   12
      Top             =   1020
      Width           =   4695
      Begin VB.CheckBox chkStartAutomatically 
         Caption         =   "&Start Automatically when Windows Starts"
         Height          =   315
         Left            =   120
         TabIndex        =   14
         Top             =   960
         Value           =   1  'Checked
         Width           =   3555
      End
      Begin VB.CheckBox chkDisabled 
         Caption         =   "&Disable File Clipboard Enhancer"
         Height          =   315
         Left            =   120
         TabIndex        =   13
         Top             =   600
         Width           =   3555
      End
      Begin VB.Label lblSettings 
         Caption         =   "You can configure whether the File Clipboard
          Enhancer is running or not, and whether it starts automatically:"
         Height          =   435
         Left            =   60
         TabIndex        =   15
         Top             =   120
         Width           =   4515
      End
      Begin VB.Line linNo 
         BorderColor     =   &H80000010&
         Visible         =   0   'False
         X1              =   60
         X2              =   4620
         Y1              =   2100
         Y2              =   2100
      End
   End
   Begin VB.PictureBox picTab 
      BorderStyle     =   0  'None
      Height          =   2895
      Index           =   1
      Left            =   1380
      ScaleHeight     =   2895
      ScaleWidth      =   4695
      TabIndex        =   6
      Top             =   660
      Width           =   4695
      Begin VB.TextBox txtPreview 
         BackColor       =   &H8000000F&
         Height          =   2055
         Left            =   60
         Locked          =   -1  'True
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   11
         Top             =   780
         Width           =   4635
      End
      Begin VB.CheckBox chkPrefixWith 
         Caption         =   "&Prefix With:"
         Height          =   315
         Left            =   60
         TabIndex        =   10
         Top             =   60
         Width           =   1335
      End
      Begin VB.CheckBox chkFollowWith 
         Caption         =   "&Follow With:"
         Height          =   315
         Left            =   60
         TabIndex        =   9
         Top             =   420
         Width           =   1335
      End
      Begin VB.TextBox txtFollowWith 
         BackColor       =   &H8000000F&
         Height          =   315
         Left            =   1440
         Locked          =   -1  'True
         TabIndex        =   8
         Top             =   420
         Width           =   3255
      End
      Begin VB.TextBox txtPrefixWith 
         BackColor       =   &H8000000F&
         Height          =   315
         Left            =   1440
         Locked          =   -1  'True
         TabIndex        =   7
         Top             =   60
         Width           =   3255
      End
   End
   Begin VB.PictureBox picTab 
      BorderStyle     =   0  'None
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2715
      Index           =   2
      Left            =   480
      ScaleHeight     =   2715
      ScaleWidth      =   4695
      TabIndex        =   2
      Top             =   240
      Width           =   4695
      Begin VB.Line linSep 
         BorderColor     =   &H80000010&
         X1              =   60
         X2              =   4620
         Y1              =   2100
         Y2              =   2100
      End
      Begin VB.Label lblInfo 
         Caption         =   $"fSysTray.frx":1272
         Height          =   735
         Left            =   60
         TabIndex        =   5
         Top             =   120
         Width           =   4635
      End
      Begin VB.Image imgVba 
         Appearance      =   0  'Flat
         Height          =   330
         Left            =   60
         Picture         =   "fSysTray.frx":1310
         Top             =   2220
         Width           =   1275
      End
      Begin VB.Label lblExample 
         Caption         =   $"fSysTray.frx":1869
         Height          =   735
         Left            =   60
         TabIndex        =   4
         Top             =   840
         Width           =   4695
      End
      Begin VB.Label lblVisit 
         Caption         =   "Visit http://vbaccelerator.com/ for more VB and
          .NET code and utilities."
         Height          =   435
         Left            =   1380
         TabIndex        =   3
         Top             =   2160
         Width           =   3315
      End
   End
   Begin pFileClipboardEnhancer.vbalDTabControl tabMain 
      Height          =   3255
      Left            =   420
      TabIndex        =   1
      Top             =   120
      Width           =   4815
      _ExtentX        =   8493
      _ExtentY        =   5741
      AllowScroll     =   0   'False
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty SelectedFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ShowCloseButton =   0   'False
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "OK"
      Default         =   -1  'True
      Height          =   375
      Left            =   4080
      TabIndex        =   0
      Top             =   3420
      Width           =   1155
   End
   Begin VB.Image imgIcon 
      Height          =   240
      Left            =   120
      Picture         =   "fSysTray.frx":1906
      Top             =   120
      Width           =   240
   End
   Begin VB.Menu mnuPopup 
      Caption         =   "&Popup"
      Visible         =   0   'False
      Begin VB.Menu mnuSysTray 
         Caption         =   ""
         Index           =   0
      End
   End
End
Attribute VB_Name = "frmFileClipboardEnhancer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' 03/03/2003
' * Added Unicode support
' * Added support for new tray version (ME,2000 or above required)
' * Added support for balloon tips (ME,2000 or above required)

' frmSysTray.
' Steve McMahon
' Original version based on code supplied from Ben Baird:

'Author:
'        Ben Baird <psyborg@cyberhighway.com>
'        Copyright (c) 1997, Ben Baird
'
'Purpose:
'        Demonstrates setting an icon in the taskbar's
'        system tray without the overhead of subclassing
'        to receive events.

Private Declare Function Shell_NotifyIconA Lib "shell32.dll" _
   (ByVal dwMessage As Long, lpData As NOTIFYICONDATAA) As Long
   
Private Declare Function Shell_NotifyIconW Lib "shell32.dll" _
   (ByVal dwMessage As Long, lpData As NOTIFYICONDATAW) As Long


Private Const NIF_ICON = &H2
Private Const NIF_MESSAGE = &H1
Private Const NIF_TIP = &H4
Private Const NIF_STATE = &H8
Private Const NIF_INFO = &H10

Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const NIM_SETFOCUS = &H3
Private Const NIM_SETVERSION = &H4

Private Const NOTIFYICON_VERSION = 3

Private Type NOTIFYICONDATAA
   cbSize As Long             ' 4
   hWnd As Long               ' 8
   uID As Long                ' 12
   uFlags As Long             ' 16
   uCallbackMessage As Long   ' 20
   hIcon As Long              ' 24
   szTip As String * 128      ' 152
   dwState As Long            ' 156
   dwStateMask As Long        ' 160
   szInfo As String * 256     ' 416
   uTimeOutOrVersion As Long  ' 420
   szInfoTitle As String * 64 ' 484
   dwInfoFlags As Long        ' 488
   guidItem As Long           ' 492
End Type
Private Type NOTIFYICONDATAW
   cbSize As Long             ' 4
   hWnd As Long               ' 8
   uID As Long                ' 12
   uFlags As Long             ' 16
   uCallbackMessage As Long   ' 20
   hIcon As Long              ' 24
   szTip(0 To 255) As Byte    ' 280
   dwState As Long            ' 284
   dwStateMask As Long        ' 288
   szInfo(0 To 511) As Byte   ' 800
   uTimeOutOrVersion As Long  ' 804
   szInfoTitle(0 To 127) As Byte ' 932
   dwInfoFlags As Long        ' 936
   guidItem As Long           ' 940
End Type


Private nfIconDataA As NOTIFYICONDATAA
Private nfIconDataW As NOTIFYICONDATAW

Private Const NOTIFYICONDATAA_V1_SIZE_A = 88
Private Const NOTIFYICONDATAA_V1_SIZE_U = 152
Private Const NOTIFYICONDATAA_V2_SIZE_A = 488
Private Const NOTIFYICONDATAA_V2_SIZE_U = 936

Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long)
 As Long

Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205

Private Const WM_USER = &H400

Private Const NIN_SELECT = WM_USER
Private Const NINF_KEY = &H1
Private Const NIN_KEYSELECT = (NIN_SELECT Or NINF_KEY)
Private Const NIN_BALLOONSHOW = (WM_USER + 2)
Private Const NIN_BALLOONHIDE = (WM_USER + 3)
Private Const NIN_BALLOONTIMEOUT = (WM_USER + 4)
Private Const NIN_BALLOONUSERCLICK = (WM_USER + 5)

' Version detection:
Private Declare Function GetVersion Lib "kernel32" () As Long

Public Event SysTrayMouseDown(ByVal eButton As MouseButtonConstants)
Public Event SysTrayMouseUp(ByVal eButton As MouseButtonConstants)
Public Event SysTrayMouseMove()
Public Event SysTrayDoubleClick(ByVal eButton As MouseButtonConstants)
Public Event MenuClick(ByVal lIndex As Long, ByVal sKey As String)
Public Event BalloonShow()
Public Event BalloonHide()
Public Event BalloonTimeOut()
Public Event BalloonClicked()

Public Enum EBalloonIconTypes
   NIIF_NONE = 0
   NIIF_INFO = 1
   NIIF_WARNING = 2
   NIIF_ERROR = 3
   NIIF_NOSOUND = &H10
End Enum

Private m_bAddedMenuItem As Boolean
Private m_iDefaultIndex As Long

Private m_bUseUnicode As Boolean
Private m_bSupportsNewVersion As Boolean



Public Enum eAutoRunTypes
    eNever
    eOnce
    eAlways
End Enum

Private WithEvents m_cClipView As cClipboardViewer
Attribute m_cClipView.VB_VarHelpID = -1
Private WithEvents m_tmr As CTimer
Attribute m_tmr.VB_VarHelpID = -1

Private m_sFiles() As String
Private m_iFileCount As Long

Private m_bDisabled As Boolean

Public Sub ShowBalloonTip( _
      ByVal sMessage As String, _
      Optional ByVal sTitle As String, _
      Optional ByVal eIcon As EBalloonIconTypes, _
      Optional ByVal lTimeOutMs = 30000 _
   )
Dim lR As Long
   If (m_bSupportsNewVersion) Then
      If (m_bUseUnicode) Then
         stringToArray sMessage, nfIconDataW.szInfo, 512
         stringToArray sTitle, nfIconDataW.szInfoTitle, 128
         nfIconDataW.uTimeOutOrVersion = lTimeOutMs
         nfIconDataW.dwInfoFlags = eIcon
         nfIconDataW.uFlags = NIF_INFO
         lR = Shell_NotifyIconW(NIM_MODIFY, nfIconDataW)
      Else
         nfIconDataA.szInfo = sMessage
         nfIconDataA.szInfoTitle = sTitle
         nfIconDataA.uTimeOutOrVersion = lTimeOutMs
         nfIconDataA.dwInfoFlags = eIcon
         nfIconDataA.uFlags = NIF_INFO
         lR = Shell_NotifyIconA(NIM_MODIFY, nfIconDataA)
      End If
   Else
      ' can't do it, fail silently.
   End If
End Sub

Public Property Get ToolTip() As String
Dim sTip As String
Dim iPos As Long
    sTip = nfIconDataA.szTip
    iPos = InStr(sTip, Chr$(0))
    If (iPos <> 0) Then
        sTip = Left$(sTip, iPos - 1)
    End If
    ToolTip = sTip
End Property

Public Property Let ToolTip(ByVal sTip As String)
   If (m_bUseUnicode) Then
      stringToArray sTip, nfIconDataW.szTip,
       unicodeSize(IIf(m_bSupportsNewVersion, 128, 64))
      nfIconDataW.uFlags = NIF_TIP
      Shell_NotifyIconW NIM_MODIFY, nfIconDataW
   Else
      If (sTip & Chr$(0) <> nfIconDataA.szTip) Then
         nfIconDataA.szTip = sTip & Chr$(0)
         nfIconDataA.uFlags = NIF_TIP
         Shell_NotifyIconA NIM_MODIFY, nfIconDataA
      End If
   End If
End Property

Public Property Get IconHandle() As Long
    IconHandle = nfIconDataA.hIcon
End Property
Public Property Let IconHandle(ByVal hIcon As Long)
   If (m_bUseUnicode) Then
      If (hIcon <> nfIconDataW.hIcon) Then
         nfIconDataW.hIcon = hIcon
         nfIconDataW.uFlags = NIF_ICON
         Shell_NotifyIconW NIM_MODIFY, nfIconDataW
      End If
   Else
      If (hIcon <> nfIconDataA.hIcon) Then
         nfIconDataA.hIcon = hIcon
         nfIconDataA.uFlags = NIF_ICON
         Shell_NotifyIconA NIM_MODIFY, nfIconDataA
      End If
   End If
End Property

Public Function AddMenuItem(ByVal sCaption As String, Optional ByVal sKey As
 String = "", Optional ByVal bDefault As Boolean = False) As Long
Dim iIndex As Long
    If Not (m_bAddedMenuItem) Then
        iIndex = 0
        m_bAddedMenuItem = True
    Else
        iIndex = mnuSysTray.UBound + 1
        Load mnuSysTray(iIndex)
    End If
    mnuSysTray(iIndex).Visible = True
    mnuSysTray(iIndex).Tag = sKey
    mnuSysTray(iIndex).Caption = sCaption
    If (bDefault) Then
        m_iDefaultIndex = iIndex
    End If
    AddMenuItem = iIndex
End Function

Private Function ValidIndex(ByVal lIndex As Long) As Boolean
    ValidIndex = (lIndex >= mnuSysTray.LBound And lIndex <= mnuSysTray.UBound)
End Function
Public Property Get MenuIndexForKey(ByVal sKey As String) As Long
Dim iU As Long
   For iU = mnuSysTray.LBound To mnuSysTray.UBound
      If (mnuSysTray(iU).Tag = sKey) Then
         MenuIndexForKey = iU
         Exit For
      End If
   Next iU
End Property

Public Sub EnableMenuItem(ByVal lIndex As Long, ByVal bState As Boolean)
    If (ValidIndex(lIndex)) Then
        mnuSysTray(lIndex).Enabled = bState
    End If
End Sub
Public Property Get MenuItemChecked(ByVal lIndex As Long) As Boolean
   If (ValidIndex(lIndex)) Then
      MenuItemChecked = mnuSysTray(lIndex).Checked
   End If
End Property
Public Property Let MenuItemChecked(ByVal lIndex As Long, ByVal bState As
 Boolean)
   If (ValidIndex(lIndex)) Then
      mnuSysTray(lIndex).Checked = bState
   End If
End Property

Public Function RemoveMenuItem(ByVal iIndex As Long) As Long
Dim i As Long
   If ValidIndex(iIndex) Then
      If (iIndex = 0) Then
         mnuSysTray(0).Caption = ""
      Else
         ' remove the item:
         For i = iIndex + 1 To mnuSysTray.UBound
            mnuSysTray(iIndex - 1).Caption = mnuSysTray(iIndex).Caption
            mnuSysTray(iIndex - 1).Tag = mnuSysTray(iIndex).Tag
         Next i
         Unload mnuSysTray(mnuSysTray.UBound)
      End If
   End If
End Function

Public Property Get DefaultMenuIndex() As Long
   DefaultMenuIndex = m_iDefaultIndex
End Property

Public Property Let DefaultMenuIndex(ByVal lIndex As Long)
   If (ValidIndex(lIndex)) Then
      m_iDefaultIndex = lIndex
   Else
      m_iDefaultIndex = 0
   End If
End Property

Public Function ShowMenu()
   SetForegroundWindow Me.hWnd
   If (m_iDefaultIndex > -1) Then
      Me.PopupMenu mnuPopup, 0, , , mnuSysTray(m_iDefaultIndex)
   Else
      Me.PopupMenu mnuPopup, 0
   End If
End Function

Public Sub SysTrayInit()
   ' Get version:
   Dim lMajor As Long
   Dim lMinor As Long
   Dim bIsNt As Long
   GetWindowsVersion lMajor, lMinor, , , bIsNt

   If (bIsNt) Then
      m_bUseUnicode = True
      If (lMajor >= 5) Then
         ' 2000 or XP
         m_bSupportsNewVersion = True
      End If
   ElseIf (lMajor = 4) And (lMinor = 90) Then
      ' Windows ME
      m_bSupportsNewVersion = True
   End If
   
   
   'Add the icon to the system tray...
   Dim lR As Long
   
   If (m_bUseUnicode) Then
      With nfIconDataW
         .hWnd = Me.hWnd
         .uID = Me.Icon
         .uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
         .uCallbackMessage = WM_MOUSEMOVE
         .hIcon = Me.Icon.Handle
         stringToArray App.FileDescription, .szTip,
          unicodeSize(IIf(m_bSupportsNewVersion, 128, 64))
         If (m_bSupportsNewVersion) Then
            .uTimeOutOrVersion = NOTIFYICON_VERSION
         End If
         .cbSize = nfStructureSize
      End With
      lR = Shell_NotifyIconW(NIM_ADD, nfIconDataW)
      If (m_bSupportsNewVersion) Then
         Shell_NotifyIconW NIM_SETVERSION, nfIconDataW
      End If
   Else
      With nfIconDataA
         .hWnd = Me.hWnd
         .uID = Me.Icon
         .uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
         .uCallbackMessage = WM_MOUSEMOVE
         .hIcon = Me.Icon.Handle
         .szTip = App.FileDescription & Chr$(0)
         If (m_bSupportsNewVersion) Then
            .uTimeOutOrVersion = NOTIFYICON_VERSION
         End If
         .cbSize = nfStructureSize
      End With
      lR = Shell_NotifyIconA(NIM_ADD, nfIconDataA)
      If (m_bSupportsNewVersion) Then
         lR = Shell_NotifyIconA(NIM_SETVERSION, nfIconDataA)
      End If
   End If

End Sub


Private Sub stringToArray( _
      ByVal sString As String, _
      bArray() As Byte, _
      ByVal lMaxSize As Long _
   )
Dim b() As Byte
Dim i As Long
Dim j As Long
   If Len(sString) > 0 Then
      b = sString
      For i = LBound(b) To UBound(b)
         bArray(i) = b(i)
         If (i = (lMaxSize - 2)) Then
            Exit For
         End If
      Next i
      For j = i To lMaxSize - 1
         bArray(j) = 0
      Next j
   End If
End Sub
Private Function unicodeSize(ByVal lSize As Long) As Long
   If (m_bUseUnicode) Then
      unicodeSize = lSize * 2
   Else
      unicodeSize = lSize
   End If
End Function

Private Property Get nfStructureSize() As Long
   If (m_bSupportsNewVersion) Then
      If (m_bUseUnicode) Then
         nfStructureSize = NOTIFYICONDATAA_V2_SIZE_U
      Else
         nfStructureSize = NOTIFYICONDATAA_V2_SIZE_A
      End If
   Else
      If (m_bUseUnicode) Then
         nfStructureSize = NOTIFYICONDATAA_V1_SIZE_U
      Else
         nfStructureSize = NOTIFYICONDATAA_V1_SIZE_A
      End If
   End If
End Property

Private Sub chkDisabled_Click()
   If (chkDisabled.Tag = "") Then
      MenuClick MenuIndexForKey("DISABLE"), "DISABLE"
   End If
End Sub

Private Sub chkFollowWith_Click()
   If (chkFollowWith.Value = Checked) Then
      txtFollowWith.BackColor = vbWindowBackground
      txtFollowWith.Locked = False
   Else
      txtFollowWith.BackColor = vbButtonFace
      txtFollowWith.Locked = True
   End If
   renderFileList
End Sub

Private Sub chkPrefixWith_Click()
   If (chkPrefixWith.Value = Checked) Then
      txtPrefixWith.BackColor = vbWindowBackground
      txtPrefixWith.Locked = False
   Else
      txtPrefixWith.BackColor = vbButtonFace
      txtPrefixWith.Locked = True
   End If
   renderFileList
End Sub

Private Sub cmdOK_Click()
   Me.Visible = False
End Sub

Private Sub Form_Load()
      
   Set m_tmr = New CTimer
   Set m_cClipView = New cClipboardViewer
   m_cClipView.InitClipboardChangeNotification Me.hWnd
   
   With Me
      .AddMenuItem "Disable File Clipboard Enhancer", "DISABLE", False
      .AddMenuItem "Close File Clipboard Enhancer", "CLOSE"
      .AddMenuItem "-"
      .AddMenuItem "Settings...", "ABOUT", True
      .Visible = False
      .SysTrayInit
      .IconHandle = .imgIcon.Picture.Handle
   End With
   
   Dim cT As cTab
   Set cT = tabMain.Tabs.Add("SETTINGS", , "Settings")
   cT.Panel = picTab(0)
   Set cT = tabMain.Tabs.Add("CONTENTS", , "Clipboard")
   cT.Panel = picTab(1)
   Set cT = tabMain.Tabs.Add("ABOUT", , "About")
   cT.Panel = picTab(2)
   
   Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
   
   ' Load settings:
   Dim cR As New cRegistry
   Dim bHasSetting As Boolean
   
   If (loadSettings(HKEY_LOCAL_MACHINE)) Then
      bHasSetting = True
   ElseIf (loadSettings(HKEY_CURRENT_USER)) Then
      bHasSetting = True
   End If
   
   If (bHasSetting) Then
      If (AutoRun(HKEY_LOCAL_MACHINE) = eAlways) Or _
         (AutoRun(HKEY_CURRENT_USER) = eAlways) Then
         chkStartAutomatically.Value = Checked
      Else
         chkStartAutomatically.Value = Unchecked
      End If
   Else
      ' default is start automatically
   End If
   
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y
 As Single)
Dim lX As Long
   ' VB manipulates the x value according to scale mode:
   ' we must remove this before we can interpret the
   ' message windows was trying to send to us:
   lX = ScaleX(x, Me.ScaleMode, vbPixels)
   Select Case lX
   Case WM_MOUSEMOVE
      RaiseEvent SysTrayMouseMove
   Case WM_LBUTTONDOWN
      SysTrayMouseDown vbLeftButton
   Case WM_LBUTTONUP
      RaiseEvent SysTrayMouseUp(vbLeftButton)
   Case WM_LBUTTONDBLCLK
      RaiseEvent SysTrayDoubleClick(vbLeftButton)
   Case WM_RBUTTONDOWN
      SysTrayMouseDown vbRightButton
   Case WM_RBUTTONUP
      RaiseEvent SysTrayMouseUp(vbRightButton)
   Case WM_RBUTTONDBLCLK
      RaiseEvent SysTrayDoubleClick(vbRightButton)
   Case NIN_BALLOONSHOW
      RaiseEvent BalloonShow
   Case NIN_BALLOONHIDE
      RaiseEvent BalloonHide
   Case NIN_BALLOONTIMEOUT
      RaiseEvent BalloonTimeOut
   Case NIN_BALLOONUSERCLICK
      RaiseEvent BalloonClicked
   End Select

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
   
   m_cClipView.StopClipboardChangeNotification

   If (m_bUseUnicode) Then
      Shell_NotifyIconW NIM_DELETE, nfIconDataW
   Else
      Shell_NotifyIconA NIM_DELETE, nfIconDataA
   End If
   
   saveSettings HKEY_LOCAL_MACHINE
   saveSettings HKEY_CURRENT_USER
   
End Sub

Private Sub mnuSysTray_Click(Index As Integer)
   MenuClick Index, mnuSysTray(Index).Tag
End Sub

Private Sub GetWindowsVersion( _
      Optional ByRef lMajor = 0, _
      Optional ByRef lMinor = 0, _
      Optional ByRef lRevision = 0, _
      Optional ByRef lBuildNumber = 0, _
      Optional ByRef bIsNt = False _
   )
Dim lR As Long
   lR = GetVersion()
   lBuildNumber = (lR And &H7F000000) \ &H1000000
   If (lR And &H80000000) Then lBuildNumber = lBuildNumber Or &H80
   lRevision = (lR And &HFF0000) \ &H10000
   lMinor = (lR And &HFF00&) \ &H100
   lMajor = (lR And &HFF)
   bIsNt = ((lR And &H80000000) = 0)
End Sub

Private Sub m_cClipView_ClipboardChanged()
   '
   m_tmr.Interval = 50
   '
End Sub

Private Sub m_tmr_ThatTime()
   '
   m_tmr.Interval = 0
   
   Dim cCustClip As New cCustomClipboard
   Dim lFmtId As Long
   Dim bFileList As Boolean
   
   On Error GoTo ErrorHandler
   cCustClip.GetCurrentFormats Me.hWnd
   
   lFmtId = cCustClip.FormatIDForName(Me.hWnd, "File List")
   If (cCustClip.IsDataAvailableForFormat(lFmtId)) Then
      ' Has File List
      bFileList = True
      If Not (cCustClip.IsDataAvailableForFormat(CF_TEXT)) Then
         ' Does not have text
         If (cCustClip.ClipboardOpen(Me.hWnd)) Then
            If cCustClip.GetFileList(m_sFiles, m_iFileCount) Then
               Dim sFileList As String
               Dim i As Long
               For i = 1 To m_iFileCount
                  If (i > 1) Then
                     sFileList = sFileList & vbCrLf
                  End If
                  sFileList = sFileList & m_sFiles(i)
               Next i
               cCustClip.SetTextData CF_TEXT, sFileList
            End If
            cCustClip.ClipboardClose
         End If
      End If
   End If
   
   If Not (bFileList) Then
      ' No FIle List
      m_iFileCount = 0
      Erase m_sFiles
   End If
   renderFileList
   Exit Sub
   '
ErrorHandler:
   Debug.Print "An error occurred: " & Err.Description
   Exit Sub
End Sub

Private Sub MenuClick(ByVal lIndex As Long, ByVal sKey As String)
   Select Case sKey
   Case "ABOUT"
      Me.Show
   
   Case "DISABLE"
      m_bDisabled = Not (m_bDisabled)
      Me.MenuItemChecked(lIndex) = m_bDisabled
      If (m_bDisabled) Then
         m_cClipView.StopClipboardChangeNotification
      Else
         m_cClipView.InitClipboardChangeNotification Me.hWnd
      End If
      chkDisabled.Tag = "NOCLICK"
      chkDisabled.Value = IIf(m_bDisabled, Checked, Unchecked)
      chkDisabled.Tag = ""
      
   Case "CLOSE"
      Set m_cClipView = Nothing
      Unload Me
   End Select
End Sub

Private Sub SysTrayMouseDown(ByVal eButton As MouseButtonConstants)
   '
   If (eButton = vbRightButton) Then
      Me.ShowMenu
   Else
      Me.Show
   End If
   '
End Sub


Private Sub txtFollowWith_Change()
   renderFileList
End Sub

Private Sub txtPrefixWith_Change()
   renderFileList
End Sub

Private Sub renderFileList()
Dim sRender As String
Dim sPrefix As String
Dim sFollow As String
Dim i As Long
   
   If (chkPrefixWith.Value = Checked) Then
      sPrefix = txtPrefixWith.Text
   End If
   If (chkFollowWith.Value = Checked) Then
      sFollow = txtFollowWith.Text
   End If

   For i = 1 To m_iFileCount
      If (i > 1) Then
         sRender = sRender & vbCrLf
      End If
      sRender = sRender & sPrefix & m_sFiles(i) & sFollow
   Next i
   
   txtPreview.Text = sRender
   If Not (StrComp(txtPreview.Text, txtPreview.Tag) = 0) Then
      addClipboardText sRender
      txtPreview.Tag = sRender
   End If
   
End Sub

Private Sub addClipboardText(sText As String)
Dim cCustClip As New cCustomClipboard
   If (cCustClip.ClipboardOpen(Me.hWnd)) Then
      cCustClip.SetTextData CF_TEXT, sText
      cCustClip.ClipboardClose
   End If
End Sub

Private Property Let AutoRun( _
      ByVal eHive As ERegistryClassConstants, _
      ByVal eType As eAutoRunTypes _
   )
Dim sExe As String

    sExe = App.Path
    If (Right$(sExe, 1) <> "\") Then sExe = sExe & "\"
    sExe = sExe & App.EXEName
    
    Dim cR As New cRegistry
    cR.ClassKey = eHive
    If (eType = eNever) Then
        ' Remove entry from always Run if it is there:
        cR.SectionKey = "Software\Microsoft\Windows\CurrentVersion\Run"
        cR.ValueKey = App.EXEName
        On Error Resume Next
        cR.DeleteValue
        Err.Clear
        ' Remove entry from RunOnce if it is there:
        cR.SectionKey = "Software\Microsoft\Windows\CurrentVersion\RunOnce"
        On Error Resume Next
        cR.DeleteValue
        Err.Clear
    ElseIf eType = eOnce Then
        ' Remove entry from always Run if it is there:
        cR.SectionKey = "Software\Microsoft\Windows\CurrentVersion\Run"
        cR.ValueKey = App.EXEName
        On Error Resume Next
        cR.DeleteValue
        Err.Clear
        ' Add an entry to RunOnce (or just ensure the exe name and path
        ' is correct if it is already there):
        cR.SectionKey = "Software\Microsoft\Windows\CurrentVersion\RunOnce"
        cR.ValueKey = App.EXEName
        cR.ValueType = REG_SZ
        cR.Value = sExe
    Else
        ' Remove entry from RunOnce if it is there:
        cR.SectionKey = "Software\Microsoft\Windows\CurrentVersion\RunOnce"
        cR.ValueKey = App.EXEName
        On Error Resume Next
        cR.DeleteValue
        Err.Clear
        ' Add an entry to RunOnce (or just ensure the exe name and path
        ' is correct if it is already there):
        cR.SectionKey = "Software\Microsoft\Windows\CurrentVersion\Run"
        cR.ValueKey = App.EXEName
        cR.ValueType = REG_SZ
        cR.Value = sExe
    End If
        
End Property

Private Property Get AutoRun( _
      ByVal eHive As ERegistryClassConstants _
   ) As eAutoRunTypes
    Dim cR As New cRegistry
    cR.ClassKey = eHive
    cR.SectionKey = "Software\Microsoft\Windows\CurrentVersion\Run"
    cR.ValueKey = App.EXEName
    cR.Default = "?"
    cR.ValueType = REG_SZ
    If (cR.Value = "?") Then
        cR.SectionKey = "Software\Microsoft\Windows\CurrentVersion\RunOnce"
        If (cR.Value = "?") Then
            AutoRun = eNever
        Else
            AutoRun = eOnce
        End If
    Else
        AutoRun = eAlways
    End If
End Property

Private Sub saveSettings(ByVal eHive As ERegistryClassConstants)
Dim cR As New cRegistry
   cR.ClassKey = eHive
   cR.SectionKey = "Software\vbAccelerator\FileClipboardEnhancer"
   cR.ValueKey = "Disabled"
   cR.ValueType = REG_DWORD
   cR.Value = (chkDisabled.Value = Checked)
   cR.ValueKey = "Version"
   cR.ValueType = REG_SZ
   cR.Value = App.Major & "." & App.Minor & "." & App.Revision
   
   AutoRun(eHive) = IIf(chkStartAutomatically.Value = Checked, eAlways, eNever)
   
End Sub
Private Function loadSettings(ByVal eHive As ERegistryClassConstants)
Dim cR As New cRegistry
   cR.ClassKey = eHive
   cR.SectionKey = "Software\vbAccelerator\FileClipboardEnhancer"
   cR.ValueKey = "Version"
   cR.ValueType = REG_SZ
   cR.Default = "?"
   If Not (cR.Value = cR.Default) Then
      cR.ValueKey = "Disabled"
      cR.ValueType = REG_DWORD
      cR.Default = False
      chkDisabled.Value = IIf(cR.Value, Checked, Unchecked)
      loadSettings = True
   End If
End Function