براي قرار دادن آيکون برنامه در
system tray ابتدا يک ماژول تعريف کرده و اطلاعات زير را در آن قرار دهيد
:
ابتدا تعريف constant هاي مورد نياز :
Public Const WM_RBUTTONUP =
&H205
Global Const WM_MOUSEMOVE = &H200
Global Const NIM_ADD =
0
Global Const NIM_DELETE = 2
Global Const NIM_MODIFY = 1
Global Const
NIF_ICON = 2
Global Const NIF_MESSAGE = 1
Global Const ABM_GETTASKBARPOS =
&H5
سپس تعريف يک type با نام RECT براي
نشان دادن يک مستطيل :
Type RECT
Left As Long
Top As
Long
Right As Long
Bottom As Long
End Type
سپس تعريف يک type با نام
NOTIFYICONDATA براي توصيف آيکون :
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
حال تعريف يک type با نام
APPBARDATA براي توصيف اطلاعات application bar :
Type APPBARDATA
cbSize As
Long
hwnd As Long
uCallbackMessage As Long
uEdge As Long
rc As
RECT
lParam As Long
End Type
دو متغير را بصورت زير تعريف مي
کنيم :
Global Notify As
NOTIFYICONDATA
Global BarData As APPBARDATA
حال نياز به declare کردن توابع
Shell_NotifyIcon و SHAppBarMessage از کتابخانه shell32 داريم :
Private Declare Function
Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As
Long, lpData As NOTIFYICONDATA) As Long
Private Declare Function
SHAppBarMessage Lib "shell32.dll" (ByVal dwMessage As Long, pData As APPBARDATA)
As Long
روتين قراردادن آيکون بصورت زير است
:
Sub AddIcon(Form1 As Form, IconID
As Long, Icon As Object, ToolTip As String)x
Dim Result As
Long
BarData.cbSize = 36&
Result = SHAppBarMessage(ABM_GETTASKBARPOS,
BarData)x
Notify.cbSize = 88&
Notify.hwnd = Form1.hwnd
Notify.uID =
IconID
Notify.uFlags = NIF_ICON Or NIF_MESSAGE Or
NIF_TIP
Notify.uCallbackMessage = WM_MOUSEMOVE
Notify.hIcon =
Icon
Notify.szTip = ToolTip & Chr$(0)x
Result =
Shell_NotifyIcon(NIM_ADD, Notify)x
End Sub
روتين حذف آيکون بصورا زير است :
Sub delIcon(IconID As Long)
Dim
Result As Long
Notify.uID = IconID
Result = Shell_NotifyIcon(NIM_DELETE,
Notify)
End Sub
در فرم مورد نظرتان ابتدا يک
متغير از نوع object تعريف کنيد :
Public IconObject As Object
در Form load عبارات زير را بنويسيد
:
Set IconObject =
Form.Icon
AddIcon Form, IconObject.Handle, IconObject, "TrayIcon"x
در Form unload عبارات زير را
بنويسيد :
delIcon
IconObject.Handle
delIcon Form.Icon.Handle
فرض کنيد يک منو با نام popmenu در
فرم داريد و مي خواهيد با کليک راست روي آيکون برنامه در system tray ، آن منو باز
شود . ابتدا visible اين منو را false کنيد و سپس متد زير را براي mousemove
بنويسيد :
Private Sub Form_MouseMove(Button
As Integer, Shift As Integer, X As Single, Y As Single)
Static Message As
Long
Message = X / Screen.TwipsPerPixelX
Select Case Message
Case
WM_RBUTTONUP:
Me.PopupMenu Popup
End Select
End Sub