trayme.cls

获取操作系统启动权限

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "TrayMe"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private First As Boolean
Private mehWnd As Long
Private meIcon As Long
Private meShowToolTip As String
'   We need a window for catch
'   the messages sent from Windows
Private WithEvents xx As hidden
Attribute xx.VB_VarHelpID = -1
'   This are the events we will
'   raise (you can use less)
Public Event leftBtnDown()
Attribute leftBtnDown.VB_Description = "Left button down"
Public Event leftBtnUp()
Attribute leftBtnUp.VB_Description = "Left button Up"
Public Event leftBtnDblClick()
Attribute leftBtnDblClick.VB_Description = "Left button double click"
Public Event rigthBtnDown()
Attribute rigthBtnDown.VB_Description = "Right button down"
Public Event rigthBtnUp()
Attribute rigthBtnUp.VB_Description = "Right button up"
Public Event rigthBtnDblClick()
Attribute rigthBtnDblClick.VB_Description = "Right button double click"

'   For show the icon we need know if
'   its the first time we call the method
Public Function Show() As Integer
Attribute Show.VB_Description = "This function shows the tray icon"
    Dim nd      As NOTIFYICONDATA
    Dim nRet    As Integer
    '   For first time we use NIM_ADD
    '   else we use NIM_MODIFY
    If First = False Then
        nd.cbSize = Len(nd)
        nd.Hwnd = mehWnd
        nd.uID = vbNull
        '   This is necesary for catch the mousemove event
        '   with our form
        nd.uCallbackMessage = WM_MOUSEMOVE
        nd.hIcon = meIcon
        nd.szTip = meShowToolTip & Chr$(0)
        nd.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
        nRet = Shell_NotifyIconA(NIM_MODIFY, nd)
    Else
        nd.cbSize = Len(nd)
        nd.Hwnd = mehWnd
        nd.uID = vbNull
        '   This is necesary for catch the mousemove event
        '   with our form
        nd.uCallbackMessage = WM_MOUSEMOVE
        nd.hIcon = meIcon
        nd.szTip = meShowToolTip & Chr$(0)
        nd.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
        nRet = Shell_NotifyIconA(NIM_ADD, nd)
        First = False
    End If
    Show = nRet
End Function

Public Function Hide() As Integer
Attribute Hide.VB_Description = "This function hides the tray icon"
    Dim nd  As NOTIFYICONDATA
    Dim nRet    As Integer
    '   We put First to true because we are hidding
    '   the icon (with NIM_DELETE)
    First = True
    nd.cbSize = Len(nd)
    nd.Hwnd = mehWnd
    nd.uID = vbNull
    nd.uCallbackMessage = WM_MOUSEMOVE
    nd.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
    nRet = Shell_NotifyIconA(NIM_DELETE, nd)
    Hide = nRet
End Function

Private Sub Class_Initialize()
    '   We need a instance of "hidden"
    Set xx = New hidden
    Load xx
    First = True
    meIcon = 0
    '   We will use the hWnd from hidden
    mehWnd = xx.Hwnd
    meShowToolTip = "Tooltip"
End Sub

Public Property Get Icon() As Variant
Attribute Icon.VB_Description = "This is a reference to the icon to be showed"
    Icon = meIcon
End Property

Public Property Let Icon(ByVal vNewValue As Variant)
    If IsNumeric(vNewValue) Then
        meIcon = vNewValue
    End If
End Property

Public Property Get ShowToolTip() As Variant
Attribute ShowToolTip.VB_Description = "This is the tooltip to be showed in the tray icon (shouln't be an empty string)"
    ShowToolTip = meShowToolTip
End Property

Public Property Let ShowToolTip(ByVal vNewValue As Variant)
    Dim tmpStr As String
    tmpStr = CStr(vNewValue)
    If tmpStr <> "" Then
        meShowToolTip = vNewValue
    End If
End Property

Private Sub Class_Terminate()
    Unload xx
End Sub

Private Sub xx_Clicked(msg As Long)
    '   The form is telling us the
    '   kind of event have ocurred (you can check others)
    Select Case msg
       Case WM_LBUTTONDOWN
            RaiseEvent leftBtnDown
       Case WM_LBUTTONUP
            RaiseEvent leftBtnUp
       Case WM_LBUTTONDBLCLK
            RaiseEvent leftBtnDblClick
       Case WM_RBUTTONDOWN
            RaiseEvent rigthBtnDown
       Case WM_RBUTTONUP
            RaiseEvent rigthBtnUp
       Case WM_RBUTTONDBLCLK
            RaiseEvent rigthBtnDblClick
    End Select
End Sub