چی جوری آیکون برنامه را در کنار ساعت ویندوز بگذارم؟ مثل برنامه Dap یا آنتیویروس ها
Printable View
چی جوری آیکون برنامه را در کنار ساعت ویندوز بگذارم؟ مثل برنامه Dap یا آنتیویروس ها
کسی بلد نیست؟ خدایان کمک کنید
براي قرار دادن آيکون برنامه در 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
[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ] :منبع
این کد را داخل یه ماژول بزار
بعد این کد رو داخل لود برنامه بزار بزارکد:Public Const WM_RBUTTONUP = &H205
Public Const WM_LBUTTONUP = &H202
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
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
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
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
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)
Dim Result As Long
BarData.cbSize = 36&
Result = SHAppBarMessage(ABM_GETTASKBARPOS, BarData)
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)
Result = Shell_NotifyIcon(NIM_ADD, Notify)
End Sub
Sub delIcon(IconID As Long)
Dim Result As Long
Notify.uID = IconID
Result = Shell_NotifyIcon(NIM_DELETE, Notify)
End Sub
اینم داخل قسمت Mouse_move بزارکد:Set IconObject = Me.Icon
AddIcon Me, IconObject.Handle, IconObject, "TrayIcon"
این آخرین کد هم در قسمت Unload بزارکد:Static Message As Long
Message = X / Screen.TwipsPerPixelX
Select Case Message
Case WM_LBUTTONUP
Me.Visible = True
End Select
کد:delIcon Me.Icon.Handle
ببین من ocx کامل ان را دارم
حتی می تونی در taslbar به صورت انیمیشن هم icon بزاری
]چطوره !
-----------------
یه ندایی بده
------------------
هر کسی خاص من در خدمتم
با سلام
سایت خیلی باحالی دارید من این سایت رو توی گوگل پیدا کردم! ولی خیلی خوبه مرسی