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&

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

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

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

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