Not a Member Yet,
Click here to Register
How do you like the new design?






ID: 455
Viewed: 2585
Added: Aug 19, 2002
Version:
Snippet uploaded by: snippet
Written By: Unknown
Demo: Sorry, no demo



User Rated at: 0 Stars
Rate This:

Thank you for your vote. Please wait...

It appears you already voted for this snippet

It appears your vote value was empty

Here's an example of how I make a systray icon with a popup menu when the right mouse button is clicked:

Highlight all by clicking in box
<!---Declaration--->
'modular code
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Public Type POINTAPI
X As Long
Y As Long
End Type

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 Const NIM_ADD = &H0
Public Const NIM_DELETE = &H2
Public Const NIM_MODIFY = &H1

Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4

Public Const WM_MOUSEMOVE = &H200
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDOWN = &H204

Global TrayIcon As NOTIFYICONDATA


Public Sub AddToTray(frm As Form, ToolTip As String, Icon)
On Error Resume Next
TrayIcon.cbSize = Len(TrayIcon)
TrayIcon.hwnd = frm.hwnd
TrayIcon.szTip = ToolTip & vbNullChar
TrayIcon.hIcon = Icon
TrayIcon.uID = vbNull
TrayIcon.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
TrayIcon.uCallbackMessage = WM_MOUSEMOVE

Shell_NotifyIcon NIM_ADD, TrayIcon

End Sub


Public Function GetY()
Dim Point As POINTAPI, RetVal As Long
RetVal = GetCursorPos(Point)
GetY = Point.Y
End Function


Public Sub RemoveFromTray()
Shell_NotifyIcon NIM_DELETE, TrayIcon
End Sub

Highlight All
<!---Code--->
'***************************************
'put this on a form with the visible property set to false
Private Sub Form_Load()
Dim listen As Long

AddToTray Me, "Marathon", Me.Icon
Me.Visible = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
RemoveFromTray
End Sub

'here is the part that get's the position of the mouse over the systray icon
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Message As Long
Dim temp As Variant
On Error Resume Next
Message = X / Screen.TwipsPerPixelX
Select Case Message
Case WM_RBUTTONUP
temp = GetY
If temp > (Screen.Height / Screen.TwipsPerPixelY) - 30 Then
PopupMenu mnuSysTray
End If
End Select
End Sub;


No Comments to show

Please completely fill out the form below if you want to review this snippet. All reviews are subject to validation.


Replying to a Comment...


Adding your comment. Please wait...

Thanks for adding your comment!. After further review it will be added.

There was a problem adding your comment. Please try again.

Please complete all the fields in the form before sending.

© 2002 - 2017 snippetlibrary.com All Rights Reserved. Conditions