|
First off, we're going to need a private window class for this: (Pardon my lack of color coordination, ...)
' internal ID's for message's used by the system for SendMessage
Public Const WM_USER = &H400
Public Const UM_NOTIFYCREATE = WM_USER + 1
Public Const UM_NOTIFYMODIFY = UM_NOTIFYCREATE + 1
Public Const UM_NOTIFYCLICK = UM_NOTIFYMODIFY + 1
Public Const UM_NOTIFYME = UM_NOTIFYCLICK + 1
Public Const PM_ABOUT = UM_NOTIFYME + 1
Public Const PM_SHOWHIDE = PM_ABOUT + 1
Public Const PM_EDITOR = PM_SHOWHIDE + 1
Public Const PM_EXITBOT = PM_EDITOR + 1
' Window Class Sample
' Copyright (c) 2002 Nir Sofer
' Web site: http://nirsoft.cjb.net
'
' The following module shows you how to register a new window class in Visual Basic and
' use that class to create new windows, and show them on a form.
' Be aware that this example is designated for advanced Visual Basic programmers.
' If you don't have extensive knowledge in Win32 API, you won't understand this source code.
Public Type WNDCLASS
style As Long
lpfnWndProc As Long
cbClsExtra As Long
cbWndExtra As Long
hInstance As Long
hIcon As Long
hCursor As Long
hbrBackground As Long
lpszMenuName As Long
lpszClassName As Long
End Type
Public Const COLOR_WINDOW = 5
Public Declare Function UnregisterClass Lib "user32" _
Alias "UnregisterClassA" _
(ByVal lpClassName As String, ByVal hInstance As Long) As Long
Public Declare Function RegisterClass Lib "user32" _
Alias "RegisterClassA" _
(Class As WNDCLASS) As Long
Public Declare Function CreateWindowEx Lib "user32" _
Alias "CreateWindowExA" _
(ByVal dwExStyle As Long, ByVal lpClassName As String, _
ByVal lpWindowName As String, ByVal dwStyle As Long, _
ByVal x As Long, ByVal y As Long, _
ByVal nWidth As Long, ByVal nHeight As Long, _
ByVal hWndParent As Long, ByVal hMenu As Long, _
ByVal hInstance As Long, lpParam As Any) As Long
Public Declare Function DefWindowProc Lib "user32" _
Alias "DefWindowProcA" _
(ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const WS_CHILD = &H40000000
Public Const WS_BORDER = &H800000
Public Const WS_VISIBLE = &H10000000
Public Const WM_CREATE = &H1
Public Const WM_DESTROY = &H2
Public Const WM_CLOSE = &H10
Public Const WM_COMMAND = &H111
Public Const SC_CLOSE = &HF060&
Public Const SERVER_CLASS = "SockClassServer"
Public Const MESSAGE_PUMP = "ServerMessagePump"
Public Const CLIENT_CLASS = "SocketClassClient"
Public Const NOTIFY_CLASS = "ShellNotifyClient"
GeSHi parsed in 0.0391252040863 seconds.
That takes care of all the definations for creating a private window class to handle the Shell Notify actions, now we want to create a window for it. But first, we need to register the class, so our class registration function needs to be dealt with, so this is the code for that, along with the window creator.
Private Function GetAddressOf(A As Long) As Long
GetAddressOf = A
End Function
Public Sub UnregisterWindowClass(WhichClass As String)
UnregisterClass WhichClass, App.hInstance
End Sub
Public Sub RegisterWindowClass(MyWndProc As Long, WhichClass As String)
Dim wc As WNDCLASS
Dim hAtom As Long
Dim BytesArray() As Byte
'The following code fills the WNDCLASS structure:
wc.style = 0
wc.lpfnWndProc = GetAddressOf(MyWndProc)
wc.cbClsExtra = 0
wc.cbWndExtra = 0
wc.hInstance = App.hInstance
wc.hIcon = 0
wc.hCursor = 0
wc.hbrBackground = COLOR_WINDOW
wc.lpszMenuName = 0
'Convert the class name from Unicode to array of bytes.
BytesArray = StrConv(WhichClass & Chr$(0), vbFromUnicode)
wc.lpszClassName = VarPtr(BytesArray(0))
'Register the new class
hAtom = RegisterClass(wc)
End Sub
Public Function CreateMyWindow(WhichClass As String, hParent As Long) As Long
CreateMyWindow = CreateWindowEx(0, WhichClass, "", _
WS_CHILD Or WS_BORDER Or WS_VISIBLE, _
0, 0, 1, 1, hParent, 0, App.hInstance, ByVal 0)
End Function
GeSHi parsed in 0.0183651447296 seconds.
Then we're going to need that function as required by the above to handle the events, a private window class needs a private function to handle wMsg's that are sent to it:
Option Explicit
Private 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
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Declare Function Shell_NotifyIcon Lib "shell32" _
Alias "Shell_NotifyIconA" _
(ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Dim TrayI As NOTIFYICONDATA
Dim TrayPopUp As Long
Public Function NotifyProc(ByVal hwnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Dim Results As Boolean, mPoint As POINTAPI
Select Case uMsg
Case UM_NOTIFYCREATE
' later versions of my coding use's the native WM_CREATE to handle this
TrayI.cbSize = Len(TrayI)
TrayI.hwnd = hwndNotify
TrayI.uId = UM_NOTIFYME
TrayI.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
TrayI.ucallbackMessage = UM_NOTIFYCLICK
TrayI.hIcon = wParam
TrayI.szTip = "Furbot WX" & Chr$(0)
Results = Shell_NotifyIcon(NIM_ADD, TrayI)
TrayPopUp = CreatePopupMenu()
AppendMenu TrayPopUp, MF_STRING, PM_ABOUT, "About"
AppendMenu TrayPopUp, MF_SEPARATOR, 0, 0&
AppendMenu TrayPopUp, MF_STRING, PM_SHOWHIDE, "Show / Hide"
AppendMenu TrayPopUp, MF_STRING, PM_EDITOR, "Botscript Editor"
AppendMenu TrayPopUp, MF_SEPARATOR, 0, 0&
AppendMenu TrayPopUp, MF_STRING, PM_EXITBOT, "Exit Bot"
Exit Function
Case UM_NOTIFYMODIFY
' we pass the pointer to the icon we want to use in wParam
TrayI.hIcon = wParam
TrayI.szTip = Trim$("Furbot " _
& Replace$(MINE.Item(fbBotName), "|", " ") _
& vbCrLf & proxy.MainStatus.Panels(pStatus).Text) & Chr$(0)
Call Shell_NotifyIcon(NIM_MODIFY, TrayI)
Exit Function
Case UM_NOTIFYCLICK
' UM_NOTICFYCLICK is an internal message needed by Shell_NotifyIcon
' for when the user clicks the icon, the system has a message ID for the event
Select Case lParam
Case WM_LBUTTONDBLCLK
proxy.ToggleVisible
Case WM_RBUTTONUP
SetForegroundWindow hwndWinMain
GetCursorPos mPoint
TrackPopupMenu TrayPopUp, 0, mPoint.Px, mPoint.Py, 0, hwndNotify, vbNull
PostMessage hwndWinMain, WM_NULL, 0, 0
End Select
Case WM_COMMAND
' when the user makes a menu selection, standard uMsg handling is used
Select Case wParam
Case PM_ABOUT
' internal function that display stuff in the receive buffer
' never did implement this
PumpInternalMessage "Menu - About"
Case PM_SHOWHIDE
proxy.ToggleVisible
Case PM_EDITOR
' nor this, ...
PumpInternalMessage "Menu - Editor"
Case PM_EXITBOT
PostMessage hwndWinMain, WM_CLOSE, 0, 0
End Select
Exit Function
Case WM_CLOSE
' always clean up when closing
Shell_NotifyIcon NIM_DELETE, TrayI
DestroyMenu TrayPopUp
' notice that this handler does not exit the function
' DefWindowProc needs to get this message
End Select
NotifyProc = DefWindowProc(hwnd, uMsg, wParam, lParam)
End Function
GeSHi parsed in 0.0525438785553 seconds.
Now that we have that, somewhere in the program's start up, we register the class, and then create a window for the class, pointing to the function we defined for handling the events.
RegisterWindowClass AddressOf NotifyProc, NOTIFY_CLASS
hwndNotify = CreateMyWindow(NOTIFY_CLASS, hwnd)
SendMessage hwndNotify, UM_NOTIFYCREATE, proxy.Icon, 0
GeSHi parsed in 0.0027379989624 seconds.
Be sure to global that hwndNotify for future use!
Finally, we also need to clean up our Notify Icon when dismissing the program, so when the program ends, we execute the following before we exit the program.
SendMessage hwndNotify, WM_CLOSE, 0, 0
UnregisterWindowClass NOTIFY_CLASS
GeSHi parsed in 0.00166916847229 seconds.
And that's it for making a Shell Notify Icon for a program.
|
