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 End If Tray.uCallbackMessage = TRAY_CALLBACK Tray.uFlags = Tray.uFlags Or NIF_MESSAGE Tray.cbSize = Len(Tray) rc = Shell_NotifyIcon(NIM_ADD, Tray) '------------------------------------------------------- End Sub '------------------------------------------------------- '------------------------------------------------------- Private Sub DeleteIcon(hwnd As Long, Id As Long) '------------------------------------------------------- Dim Tray As NOTIFYICONDATA Dim rc As Long '------------------------------------------------------- Tray.uID = Id Tray.hwnd = hwnd Tray.uFlags = 0& Tray.cbSize = Len(Tray) rc = Shell_NotifyIcon(NIM_DELETE, Tray) '------------------------------------------------------- End Sub '------------------------------------------------------- '------------------------------------------------------- Friend Sub SendEvent(MouseEvent As Long, Id As Long) '------------------------------------------------------- Select Case MouseEvent 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 '------------------------------------------------------- -----------------End cSysTray.ctl------------------------ Sau khi tạo xong hai phần trên, bạn biên dịch nó thành một Control OCX và đặt tên là cSysTray.ocx . Vậy là bạn đã xong phần thứ nhất PHẦN II: tạo một project mới để dùng OCX cSysTray.ocx Bạn nhập đoạn mã sau vào : Private Sub cSysTray1_MouseUp(Button As Integer, Id As Long) 'Nếu bạn nhấn chuột phải lên systray Icon Select Case Button Case vbRightButton PopupMenu MainMenu End Select End Sub Private Sub Form_Load() Me.Visible=False cSysTray1.InTray=True cSysTray1.TrayTip="http://www.khunglongbeo.com/ End Sub . 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. Sau khi tạo xong hai phần trên, bạn biên dịch nó thành một Control OCX và đặt tên là cSysTray.ocx . Vậy là bạn đã xong phần thứ nhất PHẦN II: tạo một project