You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
313 lines
15 KiB
313 lines
15 KiB
VERSION 5.00
|
|
Begin VB.UserControl cSysTray
|
|
CanGetFocus = 0 'False
|
|
ClientHeight = 510
|
|
ClientLeft = 0
|
|
ClientTop = 0
|
|
ClientWidth = 510
|
|
ClipControls = 0 'False
|
|
EditAtDesignTime= -1 'True
|
|
InvisibleAtRuntime= -1 'True
|
|
MouseIcon = "SysTray.ctx":0000
|
|
Picture = "SysTray.ctx":030A
|
|
ScaleHeight = 34
|
|
ScaleMode = 3 'Pixel
|
|
ScaleWidth = 34
|
|
End
|
|
Attribute VB_Name = "cSysTray"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = True
|
|
Attribute VB_PredeclaredId = False
|
|
Attribute VB_Exposed = True
|
|
Option Explicit
|
|
'-------------------------------------------------------
|
|
' Control Property Globals...
|
|
'-------------------------------------------------------
|
|
Private gInTray As Boolean
|
|
Private gTrayId As Long
|
|
Private gTrayTip As String
|
|
Private gTrayHwnd As Long
|
|
Private gTrayIcon As StdPicture
|
|
Private gAddedToTray As Boolean
|
|
Const MAX_SIZE = 510
|
|
|
|
Private Const defInTray = False
|
|
Private Const defTrayTip = "VB 5 - SysTray Control." & vbNullChar
|
|
|
|
Private Const sInTray = "InTray"
|
|
Private Const sTrayIcon = "TrayIcon"
|
|
Private Const sTrayTip = "TrayTip"
|
|
|
|
'-------------------------------------------------------
|
|
' Control Events...
|
|
'-------------------------------------------------------
|
|
Public Event MouseMove(Id As Long)
|
|
Public Event MouseDown(Button As Integer, Id As Long)
|
|
Public Event MouseUp(Button As Integer, Id As Long)
|
|
Public Event MouseDblClick(Button As Integer, Id As Long)
|
|
|
|
'-------------------------------------------------------
|
|
Private Sub UserControl_Initialize()
|
|
'-------------------------------------------------------
|
|
gInTray = defInTray ' Set global InTray defalt
|
|
gAddedToTray = False ' Set default state
|
|
gTrayId = 0 ' Set global TrayId default
|
|
gTrayHwnd = hwnd ' Set and keep HWND of user control
|
|
'-------------------------------------------------------
|
|
End Sub
|
|
'-------------------------------------------------------
|
|
|
|
'-------------------------------------------------------
|
|
Private Sub UserControl_InitProperties()
|
|
'-------------------------------------------------------
|
|
InTray = defInTray ' Init InTray Property
|
|
TrayTip = defTrayTip ' Init TrayTip Property
|
|
Set TrayIcon = Picture ' Init TrayIcon property
|
|
'-------------------------------------------------------
|
|
End Sub
|
|
'-------------------------------------------------------
|
|
|
|
'-------------------------------------------------------
|
|
Private Sub UserControl_Paint()
|
|
'-------------------------------------------------------
|
|
Dim edge As RECT ' Rectangle edge of control
|
|
'-------------------------------------------------------
|
|
edge.Left = 0 ' Set rect edges to outer
|
|
edge.Top = 0 ' - most position in pixels
|
|
edge.Bottom = ScaleHeight '
|
|
edge.Right = ScaleWidth '
|
|
DrawEdge hDC, edge, BDR_RAISEDOUTER, BF_RECT Or BF_SOFT ' Draw Edge...
|
|
'-------------------------------------------------------
|
|
End Sub
|
|
'-------------------------------------------------------
|
|
|
|
'-------------------------------------------------------
|
|
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
|
|
'-------------------------------------------------------
|
|
' Read in the properties that have been saved into the PropertyBag...
|
|
With PropBag
|
|
InTray = .ReadProperty(sInTray, defInTray) ' Get InTray
|
|
Set TrayIcon = .ReadProperty(sTrayIcon, Picture) ' Get TrayIcon
|
|
TrayTip = .ReadProperty(sTrayTip, defTrayTip) ' Get TrayTip
|
|
End With
|
|
'-------------------------------------------------------
|
|
End Sub
|
|
'-------------------------------------------------------
|
|
|
|
'-------------------------------------------------------
|
|
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
|
|
'-------------------------------------------------------
|
|
With PropBag
|
|
.WriteProperty sInTray, gInTray ' Save InTray to propertybag
|
|
.WriteProperty sTrayIcon, gTrayIcon ' Save TrayIcon to propertybag
|
|
.WriteProperty sTrayTip, gTrayTip ' Save TrayTip to propertybag
|
|
End With
|
|
'-------------------------------------------------------
|
|
End Sub
|
|
'-------------------------------------------------------
|
|
|
|
'-------------------------------------------------------
|
|
Private Sub UserControl_Resize()
|
|
'-------------------------------------------------------
|
|
Height = MAX_SIZE ' Prevent Control from being resized...
|
|
Width = MAX_SIZE
|
|
'-------------------------------------------------------
|
|
End Sub
|
|
'-------------------------------------------------------
|
|
|
|
'-------------------------------------------------------
|
|
Private Sub UserControl_Terminate()
|
|
'-------------------------------------------------------
|
|
If InTray Then ' If TrayIcon is visible
|
|
InTray = False ' Cleanup and unplug it.
|
|
End If
|
|
'-------------------------------------------------------
|
|
End Sub
|
|
'-------------------------------------------------------
|
|
|
|
'-------------------------------------------------------
|
|
Public Property Set TrayIcon(Icon As StdPicture)
|
|
'-------------------------------------------------------
|
|
Dim Tray As NOTIFYICONDATA ' Notify Icon Data structure
|
|
Dim rc As Long ' API return code
|
|
'-------------------------------------------------------
|
|
If Not (Icon Is Nothing) Then ' If icon is valid...
|
|
If (Icon.Type = vbPicTypeIcon) Then ' Use ONLY if it is an icon
|
|
If gAddedToTray Then ' Modify tray only if it is in use.
|
|
Tray.uID = gTrayId ' Unique ID for each HWND and callback message.
|
|
Tray.hwnd = gTrayHwnd ' HWND receiving messages.
|
|
Tray.hIcon = Icon.Handle ' Tray icon.
|
|
Tray.uFlags = NIF_ICON ' Set flags for valid data items
|
|
Tray.cbSize = Len(Tray) ' Size of struct.
|
|
|
|
rc = Shell_NotifyIcon(NIM_MODIFY, Tray) ' Send data to Sys Tray.
|
|
End If
|
|
|
|
Set gTrayIcon = Icon ' Save Icon to global
|
|
Set Picture = Icon ' Show user change in control as well(gratuitous)
|
|
PropertyChanged sTrayIcon ' Notify control that property has changed.
|
|
End If
|
|
End If
|
|
'-------------------------------------------------------
|
|
End Property
|
|
'-------------------------------------------------------
|
|
|
|
'-------------------------------------------------------
|
|
Public Property Get TrayIcon() As StdPicture
|
|
'-------------------------------------------------------
|
|
Set TrayIcon = gTrayIcon ' Return Icon value
|
|
'-------------------------------------------------------
|
|
End Property
|
|
'-------------------------------------------------------
|
|
|
|
'-------------------------------------------------------
|
|
Public Property Let TrayTip(Tip As String)
|
|
Attribute TrayTip.VB_ProcData.VB_Invoke_PropertyPut = ";Misc"
|
|
Attribute TrayTip.VB_UserMemId = -517
|
|
'-------------------------------------------------------
|
|
Dim Tray As NOTIFYICONDATA ' Notify Icon Data structure
|
|
Dim rc As Long ' API Return code
|
|
'-------------------------------------------------------
|
|
If gAddedToTray Then ' if TrayIcon is in taskbar
|
|
Tray.uID = gTrayId ' Unique ID for each HWND and callback message.
|
|
Tray.hwnd = gTrayHwnd ' HWND receiving messages.
|
|
Tray.szTip = Tip & vbNullChar ' Tray tool tip
|
|
Tray.uFlags = NIF_TIP ' Set flags for valid data items
|
|
Tray.cbSize = Len(Tray) ' Size of struct.
|
|
|
|
rc = Shell_NotifyIcon(NIM_MODIFY, Tray) ' Send data to Sys Tray.
|
|
End If
|
|
|
|
gTrayTip = Tip ' Save Tip
|
|
PropertyChanged sTrayTip ' Notify control that property has changed
|
|
'-------------------------------------------------------
|
|
End Property
|
|
'-------------------------------------------------------
|
|
|
|
'-------------------------------------------------------
|
|
Public Property Get TrayTip() As String
|
|
'-------------------------------------------------------
|
|
TrayTip = gTrayTip ' Return Global Tip...
|
|
'-------------------------------------------------------
|
|
End Property
|
|
'-------------------------------------------------------
|
|
|
|
'-------------------------------------------------------
|
|
Public Property Let InTray(Show As Boolean)
|
|
Attribute InTray.VB_ProcData.VB_Invoke_PropertyPut = ";Behavior"
|
|
'-------------------------------------------------------
|
|
Dim ClassAddr As Long ' Address pointer to Control Instance
|
|
'-------------------------------------------------------
|
|
If (Show <> gInTray) Then ' Modify ONLY if state is changing!
|
|
If Show Then ' If adding Icon to system tray...
|
|
If Ambient.UserMode Then ' If in RunMode and not in IDE...
|
|
' SubClass Controls window proc.
|
|
PrevWndProc = SetWindowLong(gTrayHwnd, GWL_WNDPROC, AddressOf SubWndProc)
|
|
|
|
' Get address to user control object
|
|
'CopyMemory ClassAddr, UserControl, 4&
|
|
|
|
' Save address to the USERDATA of the control's window struct.
|
|
' this will be used to get an object refenence to the control
|
|
' from an HWND in the callback.
|
|
SetWindowLong gTrayHwnd, GWL_USERDATA, ObjPtr(Me) 'ClassAddr
|
|
|
|
AddIcon gTrayHwnd, gTrayId, TrayTip, TrayIcon ' Add TrayIcon to System Tray...
|
|
gAddedToTray = True ' Save state of control used in teardown procedure
|
|
End If
|
|
Else ' If removing Icon from system tray
|
|
If gAddedToTray Then ' If Added to system tray then remove...
|
|
DeleteIcon gTrayHwnd, gTrayId ' Remove icon from system tray
|
|
|
|
' Un SubClass controls window proc.
|
|
SetWindowLong gTrayHwnd, GWL_WNDPROC, PrevWndProc
|
|
gAddedToTray = False ' Maintain the state for teardown purposes
|
|
End If
|
|
End If
|
|
|
|
gInTray = Show ' Update global variable
|
|
PropertyChanged sInTray ' Notify control that property has changed
|
|
End If
|
|
'-------------------------------------------------------
|
|
End Property
|
|
'-------------------------------------------------------
|
|
|
|
'-------------------------------------------------------
|
|
Public Property Get InTray() As Boolean
|
|
'-------------------------------------------------------
|
|
InTray = gInTray ' Return global property
|
|
'-------------------------------------------------------
|
|
End Property
|
|
'-------------------------------------------------------
|
|
|
|
'-------------------------------------------------------
|
|
Private Sub AddIcon(hwnd As Long, Id As Long, Tip As String, Icon As StdPicture)
|
|
'-------------------------------------------------------
|
|
Dim Tray As NOTIFYICONDATA ' Notify Icon Data structure
|
|
Dim tFlags As Long ' Tray action flag
|
|
Dim rc As Long ' API return code
|
|
'-------------------------------------------------------
|
|
Tray.uID = Id ' Unique ID for each HWND and callback message.
|
|
Tray.hwnd = hwnd ' HWND receiving messages.
|
|
|
|
If Not (Icon Is Nothing) Then ' Validate Icon picture
|
|
Tray.hIcon = Icon.Handle ' Tray icon.
|
|
Tray.uFlags = Tray.uFlags Or NIF_ICON ' Set ICON flag to validate data item
|
|
Set gTrayIcon = Icon ' Save icon
|
|
End If
|
|
|
|
If (Tip <> "") Then ' Validate Tip text
|
|
Tray.szTip = Tip & vbNullChar ' Tray tool tip
|
|
Tray.uFlags = Tray.uFlags Or NIF_TIP ' Set TIP flag to validate data item
|
|
gTrayTip = Tip ' Save tool tip
|
|
End If
|
|
|
|
Tray.uCallbackMessage = TRAY_CALLBACK ' Set user defigned message
|
|
Tray.uFlags = Tray.uFlags Or NIF_MESSAGE ' Set flags for valid data item
|
|
Tray.cbSize = Len(Tray) ' Size of struct.
|
|
|
|
rc = Shell_NotifyIcon(NIM_ADD, Tray) ' Send data to Sys Tray.
|
|
'-------------------------------------------------------
|
|
End Sub
|
|
'-------------------------------------------------------
|
|
|
|
'-------------------------------------------------------
|
|
Private Sub DeleteIcon(hwnd As Long, Id As Long)
|
|
'-------------------------------------------------------
|
|
Dim Tray As NOTIFYICONDATA ' Notify Icon Data structure
|
|
Dim rc As Long ' API return code
|
|
'-------------------------------------------------------
|
|
Tray.uID = Id ' Unique ID for each HWND and callback message.
|
|
Tray.hwnd = hwnd ' HWND receiving messages.
|
|
Tray.uFlags = 0& ' Set flags for valid data items
|
|
Tray.cbSize = Len(Tray) ' Size of struct.
|
|
|
|
rc = Shell_NotifyIcon(NIM_DELETE, Tray) ' Send delete message.
|
|
'-------------------------------------------------------
|
|
End Sub
|
|
'-------------------------------------------------------
|
|
|
|
'-------------------------------------------------------
|
|
Friend Sub SendEvent(MouseEvent As Long, Id As Long)
|
|
'-------------------------------------------------------
|
|
Select Case MouseEvent ' Dispatch mouse events to control
|
|
Case WM_MOUSEMOVE
|
|
RaiseEvent MouseMove(Id)
|
|
Case WM_LBUTTONDOWN
|
|
RaiseEvent MouseDown(vbLeftButton, Id)
|
|
Case WM_LBUTTONUP
|
|
RaiseEvent MouseUp(vbLeftButton, Id)
|
|
Case WM_LBUTTONDBLCLK
|
|
RaiseEvent MouseDblClick(vbLeftButton, Id)
|
|
Case WM_RBUTTONDOWN
|
|
RaiseEvent MouseDown(vbRightButton, Id)
|
|
Case WM_RBUTTONUP
|
|
RaiseEvent MouseUp(vbRightButton, Id)
|
|
Case WM_RBUTTONDBLCLK
|
|
RaiseEvent MouseDblClick(vbRightButton, Id)
|
|
End Select
|
|
'-------------------------------------------------------
|
|
End Sub
|
|
'-------------------------------------------------------
|
|
|