csystray.cls

adsl拨号工具 有很多功能 不错啊 大家试试

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CSysTray"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'*:********************************************************************************
'*: Class. . . . . . . . . . : clsSysTray.cls
'*: Description. . . . . . . : When the application is minimized, it minimizes to
'*:                            be an icon in the system tray.
'*: Author . . . . . . . . . : Martin Richardson
'*: Acknowledgements . . . . : Mark Hunter (system tray routines)
'*: Copyright. . . . . . . . : This class is freeware
'*:
'*: Update...................: This class was changed by me, Todd Herman to make it
'*:                            more streamlined and allow it handle animated cursors.
'*:********************************************************************************
'*: Code to set up in the main form:

'*: Properties
'*:
'*: Icon
'*:     Icon displayed in the taskbar.  Use this property to set the icon, or return
'*:     it.
'*: ToolTip
'*:     Tooltip text displayed when the mouse is over the icon in the system tray.  Use
'*:     this property to assign text to the tooltip, or to return the value of it.
'*: SourceWindow As Form
'*:     Reference to the form which will minimize to the system tray.
'*: DefaultDblClk As Boolean
'*:     Set to True to fire the DEFAULT (defined below) for the mouse double click event
'*:     which will show the application and remove the icon from the tray. (default)
'*:     Set to FALSE to override the below default event.
'*:
'*: Methods:
'*:
'*: MinToSysTray
'*:     Minimize the application, have it appear as an icon in the system tray.
'*:     The applicion disappears from the task bar and only appears in the
'*:     system tray.
'*: IconInSysTray
'*:     Create an icon for the application in the system tray, but leave the icon
'*:     visible and on the task bar.
'*: RemoveFromSysTray
'*:     Remove the icon from the system tray.
'*:
'*: These methods are available, but the same actions can be accomplished by
'*: setting the ICON and TOOLTIP properties.
'*:
'*: ChangeToolTip( sNewToolTip As String )
'*:     Set/change the tooltip displayed when the mouse is over the tray icon.
'*:     ex: gSysTray.ChangeToolTip "Processing..."
'*: ChangeIcon( sIconPath as string )
'*:     Set/change the icon which appears in the system tray.  The default icon
'*:     is the icon of the form.
'*:     ex: gSysTray.ChangeIcon app.path & "\MyIcon.ico"
'*:
'*: Events:
'*:
'*: LButtonDblClk
'*:     Fires when double clicking the left mouse button over the tray icon.  This event
'*:     has default code which will show the form and remove the icon from the
'*:     system tray when it fires.  Set the property DefaultDblClk to False to
'*:     bypass this code.
'*: LButtonDown
'*:     Fires when the left mouse button goes down over the tray icon.
'*: LButtonUp
'*:     Fires when the left mouse button comes up over the tray icon.
'*: RButtonDblClk
'*:     Fires when double clicking the right mouse button over the tray icon.
'*: RButtonDown
'*:     Fires when the right mouse button goes down over the tray icon.
'*: RButtonUp
'*:     Fires when the right mouse button comes up over the tray icon.
'*:     Best place for calling a popup menu.
'*:
'*: Example of utilizing a popup menu with the RButtonUp event:
'*: 1.  Create a menu on the form being minimized, or on it's own seperate form.
'*:     Let's say the form with the menu is called frmMenuForm.
'*: 2.  Set the name of the root menu item to be mnuRightClickMenu
'*: 3.  Assuming the name of the Private SysTray object is still gSysTray, use this code
'*:     in the main form:
'*:
'Private Sub gSysTray_RButtonUP()
'    PopUpMenu frmMenuForm.mnuRightClickMenu
'End Sub
'*:
'*:********************************************************************************

'*:********************************************************************************
'*: User Defined Types
'*:********************************************************************************
Private Type NOTIFYICONDATA
    cbSize As Long
    hwnd As Long
    uId As Long
    uFlags As Long
    ucallbackMessage As Long
    hIcon As Long
    szTip As String * 64
End Type

'*:********************************************************************************
'*: Constants
'*:********************************************************************************
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const WM_MOUSEMOVE = &H200
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4

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

'*:********************************************************************************
'*: API Declarations
'*:********************************************************************************
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Private Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal dwImageType As Long, ByVal dwDesiredWidth As Long, ByVal dwDesiredHeight As Long, ByVal dwFlags As Long) As Long
Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long

Private Const LR_LOADFROMFILE = &H10
Private Const IMAGE_BITMAP = 0
Private Const IMAGE_ICON = 1
Private Const IMAGE_CURSOR = 2
Private Const IMAGE_ENHMETAFILE = 3
Private Const DI_MASK = &H1
Private Const DI_IMAGE = &H2
Private Const DI_DEFAULTSIZE = &H8
Private Const DI_NORMAL = DI_MASK Or DI_IMAGE Or DI_DEFAULTSIZE

'*:********************************************************************************
'*: Local variables
'*:********************************************************************************
Private IconData As NOTIFYICONDATA
Private WithEvents pbPictureHook As PictureBox
Attribute pbPictureHook.VB_VarHelpID = -1
Private sToolTip As String

'*:********************************************************************************
'*: Events
'*:********************************************************************************
Public Event LButtonDblClk()
Public Event LButtonDown()
Public Event LButtonUp()
Public Event RButtonDblClk()
Public Event RButtonDown()
Public Event RButtonUp()

'*:********************************************************************************
'*: local variable(s) to hold property value(s)
'*:********************************************************************************
Private frmSourceWindow As Form 'local copy
Private bDefaultDblClk As Boolean 'local copy
Private iCurrentFrame As Integer
Public Property Let ToolTip(ByVal sData As String)

    'Set the tooltip value for the system tray icon
    ChangeToolTip sData
    
End Property
Public Property Get ToolTip() As String

    'Get the tooltip value for the system tray icon
    ToolTip = sToolTip
    
End Property
'Public Property Let Icon(ByVal vData As Variant)
    'Change the current icon in the system tray.  This is the same
    'as directly calling ChangeIcon
'    ChangeIcon sData
'End Property
'Public Property Get Icon() As Variant
'    Icon = IconData.hIcon      'pichook.Picture
'End Property
Public Property Let DefaultDblClk(ByVal bData As Boolean)

    'If this is set to true, the application will be restored to it's normal
    'size when the user double clicks on the system tray icon.  This value
    'defaults to true.
    bDefaultDblClk = bData
    
End Property
Public Property Get DefaultDblClk() As Boolean

    DefaultDblClk = bDefaultDblClk