Các chiêu thức trong lập trình Tạo một SystemTray cho ứng dụng của bạn home

Tạo một SystemTray cho ứng dụng của bạn home
Xuất xứ : www.ttvnol.com
Binh khí sử dụng : Tương đối nhiều
Đoạn mã :
PHẦN I _ Tạo một OCX đặt tên là cSysTray.ocx
Bạn vào VB tạo một ActiveX Control, sau đó add một Module đặt tên là: mSysTray.bas và có nội dung
như sau :
--------- Module mSysTray.bas ----------
Option Explicit
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc
As Long, ByVal hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As
Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long,
ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long,
ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage
As Long, lpData As NOTIFYICONDATA) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As
Any, ByVal ByteLen As Long)
Public Declare Function DrawEdge Lib "user32" (ByVal hDC As Long, qrc As RECT, ByVal edge As
Long, ByVal grfFlags As Long) As Boolean
Public Const GWL_USERDATA = (-21&)
Public Const GWL_WNDPROC = (-4&)
Public Const WM_USER = &H400&
Public Const TRAY_CALLBACK = (WM_USER + 101&)
Public Const NIM_ADD = &H0&
Public Const NIM_MODIFY = &H1&
Public Const NIM_DELETE = &H2&
Public Const NIF_MESSAGE = &H1&
Public Const NIF_ICON = &H2&

Public Const NIF_TIP = &H4&
Public Const WM_MOUSEMOVE = &H200&
Public Const WM_LBUTTONDOWN = &H201&
Public Const WM_LBUTTONUP = &H202&
Public Const WM_LBUTTONDBLCLK = &H203&
Public Const WM_RBUTTONDOWN = &H204&
Public Const WM_RBUTTONUP = &H205&
Public Const WM_RBUTTONDBLCLK = &H206&
Public Const BDR_RAISEDOUTER = &H1&
Public Const BDR_RAISEDINNER = &H4&
Public Const BF_LEFT = &H1&
Public Const BF_TOP = &H2&
Public Const BF_RIGHT = &H4&
Public Const BF_BOTTOM = &H8&
Public Const BF_RECT = BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM
Public Const BF_SOFT = &H1000&
Public 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
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long

End Type
Public PrevWndProc As Long
'------------------------------------------------------------
Public Function SubWndProc(ByVal hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal
lParam As Long) As Long
'------------------------------------------------------------
Dim SysTray As cSysTray
Dim ClassAddr As Long
'------------------------------------------------------------
Select Case MSG
Case TRAY_CALLBACK
ClassAddr = GetWindowLong(hwnd, GWL_USERDATA)
CopyMemory SysTray, ClassAddr, 4
SysTray.SendEvent lParam, wParam
CopyMemory SysTray, 0&, 4
End Select
SubWndProc = CallWindowProc(PrevWndProc, hwnd, MSG, wParam, lParam)
'------------------------------------------------------------
End Function
'------------------------------------------------------------
--------- End mSysTray.bas -------------------
Sau khi bạn tạo module trên rồi, bạn tạo tiếp một cSysTray.ctl như sau:
----------------- cSysTray.ctl---------------------
Option Explicit
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 = "System Tray Control" & vbNullChar
Private Const sInTray = "InTray"
Private Const sTrayIcon = "TrayIcon"
Private Const sTrayTip = "TrayTip"
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
gAddedToTray = False
gTrayId = 0
gTrayHwnd = hwnd
'-------------------------------------------------------
End Sub
'-------------------------------------------------------
'-------------------------------------------------------
Private Sub UserControl_InitProperties()
'-------------------------------------------------------
InTray = defInTray
TrayTip = defTrayTip
Set TrayIcon = Picture
'-------------------------------------------------------
End Sub
'-------------------------------------------------------
'-------------------------------------------------------

Private Sub UserControl_Paint()
'-------------------------------------------------------
Dim edge As RECT
'-------------------------------------------------------
edge.Left = 0
edge.Top = 0
edge.Bottom = ScaleHeight
edge.Right = ScaleWidth
DrawEdge hDC, edge, BDR_RAISEDOUTER, BF_RECT Or BF_SOFT
'-------------------------------------------------------
End Sub
'-------------------------------------------------------
'-------------------------------------------------------
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
'-------------------------------------------------------
With PropBag
InTray = .ReadProperty(sInTray, defInTray)
Set TrayIcon = .ReadProperty(sTrayIcon, Picture)
TrayTip = .ReadProperty(sTrayTip, defTrayTip)
End With
'-------------------------------------------------------
End Sub
'-------------------------------------------------------
'-------------------------------------------------------
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
'-------------------------------------------------------
With PropBag
.WriteProperty sInTray, gInTray
.WriteProperty sTrayIcon, gTrayIcon
.WriteProperty sTrayTip, gTrayTip

End With
'-------------------------------------------------------
End Sub
'-------------------------------------------------------
'-------------------------------------------------------
Private Sub UserControl_Resize()
'-------------------------------------------------------
Height = MAX_SIZE
Width = MAX_SIZE
'-------------------------------------------------------
End Sub
'-------------------------------------------------------
'-------------------------------------------------------
Private Sub UserControl_Terminate()
'-------------------------------------------------------
If InTray Then
InTray = False
End If
'-------------------------------------------------------
End Sub
'-------------------------------------------------------
'-------------------------------------------------------
Public Property Set TrayIcon(Icon As StdPicture)
'-------------------------------------------------------
Dim Tray As NOTIFYICONDATA
Dim rc As Long
'-------------------------------------------------------
If Not (Icon Is Nothing) Then
If (Icon.Type = vbPicTypeIcon) Then
If gAddedToTray Then

Tray.uID = gTrayId
Tray.hwnd = gTrayHwnd
Tray.hIcon = Icon.Handle
Tray.uFlags = NIF_ICON
Tray.cbSize = Len(Tray)
rc = Shell_NotifyIcon(NIM_MODIFY, Tray)
End If
Set gTrayIcon = Icon
Set Picture = Icon
PropertyChanged sTrayIcon
End If
End If
'-------------------------------------------------------
End Property
'-------------------------------------------------------
'-------------------------------------------------------
Public Property Get TrayIcon() As StdPicture
'-------------------------------------------------------
Set TrayIcon = gTrayIcon
'-------------------------------------------------------
End Property
'-------------------------------------------------------
'-------------------------------------------------------
Public Property Let TrayTip(Tip As String)
'-------------------------------------------------------
Dim Tray As NOTIFYICONDATA
Dim rc As Long
'-------------------------------------------------------
If gAddedToTray Then
Tray.uID = gTrayId

Tray.hwnd = gTrayHwnd
Tray.szTip = Tip & vbNullChar
Tray.uFlags = NIF_TIP
Tray.cbSize = Len(Tray)
rc = Shell_NotifyIcon(NIM_MODIFY, Tray)
End If
gTrayTip = Tip
PropertyChanged sTrayTip
'-------------------------------------------------------
End Property
'-------------------------------------------------------
'-------------------------------------------------------
Public Property Get TrayTip() As String
'-------------------------------------------------------
TrayTip = gTrayTip
'-------------------------------------------------------
End Property
'-------------------------------------------------------
'-------------------------------------------------------
Public Property Let InTray(Show As Boolean)
'-------------------------------------------------------
Dim ClassAddr As Long
'-------------------------------------------------------
If (Show <> gInTray) Then
If Show Then
If Ambient.UserMode Then
PrevWndProc = SetWindowLong(gTrayHwnd, GWL_WNDPROC, AddressOf SubWndProc)
SetWindowLong gTrayHwnd, GWL_USERDATA, ObjPtr(Me)
AddIcon gTrayHwnd, gTrayId, TrayTip, TrayIcon
gAddedToTray = True

End If
Else
If gAddedToTray Then
DeleteIcon gTrayHwnd, gTrayId
SetWindowLong gTrayHwnd, GWL_WNDPROC, PrevWndProc
gAddedToTray = False
End If
End If
gInTray = Show
PropertyChanged sInTray
End If
'-------------------------------------------------------
End Property
'-------------------------------------------------------
'-------------------------------------------------------
Public Property Get InTray() As Boolean
'-------------------------------------------------------
InTray = gInTray
'-------------------------------------------------------
End Property
'-------------------------------------------------------
'-------------------------------------------------------
Private Sub AddIcon(hwnd As Long, Id As Long, Tip As String, Icon As StdPicture)
'-------------------------------------------------------
Dim Tray As NOTIFYICONDATA
Dim tFlags As Long
Dim rc As Long
'-------------------------------------------------------
Tray.uID = Id
Tray.hwnd = hwnd

If Not (Icon Is Nothing) Then
Tray.hIcon = Icon.Handle
Tray.uFlags = Tray.uFlags Or NIF_ICON
Set gTrayIcon = Icon
End If
If (Tip <> "") Then
Tray.szTip = Tip & vbNullChar
Tray.uFlags = Tray.uFlags Or NIF_TIP
gTrayTip = Tip