Atlanta Custom Software Development 

 
   Search        Code/Page
 

User Login
Email

Password

 

Forgot the Password?
Services
» Web Development
» Maintenance
» Data Integration/BI
» Information Management
Programming
  Database
Automation
OS/Networking
Graphics
Links
Tools
» Regular Expr Tester
» Free Tools


In article we will learn how to use powerful subclassing technique to implement system tray icon which can show Ondemand Balloon Tooltip, simple mouse over tooltip and right click popup menu.

Basic for system tray icon implementation

You can implement system tray icon using Shell_NotifyIcon API. You will find more information about Shell_NotifyIcon API and NOTIFYICONDATA structure on MSDN.

To make this code reusable as ActiveX component or ActiveX Dll I have created a very easy to use class. Since we know that to use subclassing technique we must provide a window handle which can receive all window messages. This code will create a hidden window as a message receiver so you dont really need any VB form handle to use this class.

Here is few steps for implementing SystemTray icon
  • Create a hidden window and get a valid window handle
  • Initialize NOTIFYICONDATA structure which we will use through out the code. Make sure that you assign WM_USER_TRAY to uCallbackMessage member of the NOTIFYICONDATA structure. This will only send system tray related messages to our hidden window.
  • If hidden window is created the start Hook for that window
  • When we start hook we do couple of things
    1. call RegisterWindowMessage("TaskbarCreated") so system sends WM_TASKBARCREATED message when taskbar is created or refreshed.
    2. Call SetProp to store class instance pointer as a window property. We might have multiple instances for the same class so we need class object pointer to Fire Events for that instance only.
    3. Call SetProp to store current window procedure pointer before we bind our window with new window procedure. later we can attach old procedure when we unhook the window.
    4. Now call SetWindowLong to assign new windows procedure which will process our task bar related messages

  • Inside window procedure code try to get object pointer from window handle. Now using the object pointer you can execute ProcessMessage for that instance only. According to lParam and wParam ProcessMessage will raise different event which user can trap inside the code
  • In the class_terminate event remove icon from tray, unhook the hidden window, close the hidden window and very last unregister window class which we used for our hidden window.


Now lets see the actual code

Step-By-Step Example
- Create a standard exe project
- Add one class module, rename it to CBalloonToolTipNotify
- Add one standard module (Module1.bas)
- Now place 3 textbox, 1 list box, 1 combobox and one commandbutton control on the form1
- Change text2 MultiLine=True and scrollbar=Verticle
- Right Click on the form and select menu editor to create the following menu for our tray popup menu

Click here to copy the following block
"ContextMenu" (Name=mnuPopup)
+ -- "About Binaryworld" (Name=mnuAbout)
+ -- "Close" (Name=mnuClose)

- Add the following code in form1

Form1.frm

Click here to copy the following block
Dim WithEvents tt As CBalloonToolTipNotify

Private Sub Command1_Click()
  SetTip
  tt.ShowNotifyBalloonTip
End Sub

Private Sub Form_Load()
  Text1 = "Low Disk Space"
  Text2 = "Your C: Drive is full. " & _
      "To complete the installation you atleast need 500MB free." & vbCrLf & vbCrLf & _
      "For Moreinfo visit: www.binaryworld.net"
  Text3 = 5000  '5 sec timeout
  Text1.MaxLength = 128
  Text2.MaxLength = 256
  Combo1.AddItem "(No Icon)"
  Combo1.AddItem "Information"
  Combo1.AddItem "Warning"
  Combo1.AddItem "Error"
  Combo1.ListIndex = 2
  mnuPopup.Visible = False

  Set tt = New CBalloonToolTipNotify

  tt.ContextMenu = mnuPopup
  tt.TrayIcon = Me.Icon
  tt.Visible = True

  Call SetTip

  Command1.Caption = "Show Balloon ToolTip"
End Sub
Sub SetTip()
  tt.BalloonTitle = Text1
  tt.BalloonText = Text2
  tt.BalloonTimeOut = CInt(Text3)
  tt.BalloonIconType = Combo1.ListIndex
  '//tt.Text = ""
  tt.Text = "simple mouse over tip"
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Set tt = Nothing
End Sub

Private Sub mnuAbout_Click()
  MsgBox "This code is provided by Binaryworld"
End Sub

Private Sub mnuClose_Click()
  '//Doesn't work. stay in memory coz after unload if you try to access controls
  '//then form is loaded once again and stay in memory
  'Unload Me

  '//More relaable
  'Postmessage will delay message execution untill all pending messages are processed
  Call PostMessage(Me.hwnd, WM_CLOSE, 0&, ByVal 0&)
End Sub
'///////////////////////////////////
'//Tooltip Object Events
'///////////////////////////////////
Private Sub tt_BalloonClick(X As Long, Y As Long)
  List1.AddItem "tt_BalloonClick (" & X & "," & Y & ")", 0
End Sub

Private Sub tt_BalloonHide()
  List1.AddItem "tt_BalloonHide (" & X & "," & Y & ")", 0
End Sub

Private Sub tt_BalloonShow()
  List1.AddItem "tt_BalloonShow", 0
End Sub

Private Sub tt_BalloonTimeOut()
  List1.AddItem "tt_BalloonTimeOut", 0
End Sub

Private Sub tt_Click()
  List1.AddItem "tt_Click", 0
End Sub

Private Sub tt_DoubleClick(Button As Integer, X As Long, Y As Long)
  List1.AddItem "tt_DoubleClick (" & X & "," & Y & ") Button=" & Button, 0
End Sub

Private Sub tt_MouseDown(Button As Integer, X As Long, Y As Long)
  List1.AddItem "tt_MouseDown (" & X & "," & Y & ") Button=" & Button, 0
End Sub

Private Sub tt_MouseMove(X As Long, Y As Long)
  List1.AddItem "tt_MouseMove (" & X & "," & Y & ")", 0
End Sub

Private Sub tt_MouseUp(Button As Integer, X As Long, Y As Long)
  List1.AddItem "tt_MouseUp (" & X & "," & Y & ") Button=" & Button, 0
End Sub

Private Sub tt_Reload()
  List1.AddItem "tt_Reload", 0
End Sub

- Add the following code in module1

Module1.bas

Click here to copy the following block
'API Calls
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) 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.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, lParam As Long) As Long
Public Declare Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

Public Declare Function CreateWindowEx Lib "user32.dll" 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 RegisterClass Lib "user32" Alias "RegisterClassA" (Class As WNDCLASS) As Long
Public Declare Function UnregisterClass Lib "user32" Alias "UnregisterClassA" (ByVal lpClassName As String, ByVal hInstance As Long) As Long
Public Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Public Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, ByRef lpData As NOTIFYICONDATA) As Boolean

Public Const WM_CLOSE As Long = &H10
'our app-specific message to trap
'in the WindowProc routine
Private Const WM_APP As Long = &H8000&
Public Const WM_MYHOOK As Long = WM_APP + &H15
Public Const NOTIFYICON_VERSION = &H3

Public Const NIF_MESSAGE = &H1
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const NIF_STATE = &H8
Public Const NIF_INFO = &H10

Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const NIM_SETFOCUS = &H3
Public Const NIM_SETVERSION = &H4
Public Const NIM_VERSION = &H5

Public Const NIS_HIDDEN = &H1
Public Const NIS_SHAREDICON = &H2

'icon flags
Public Const NIIF_NONE = &H0
Public Const NIIF_INFO = &H1
Public Const NIIF_WARNING = &H2
Public Const NIIF_ERROR = &H3
Public Const NIIF_GUID = &H5
Public Const NIIF_ICON_MASK = &HF
Public Const NIIF_NOSOUND = &H10

Public Type POINTAPI
  X As Long
  Y As Long
End Type

Public Type WNDCLASS
  style As Long
  lpfnwndproc As Long
  cbClsextra As Long
  cbWndExtra2 As Long
  hInstance As Long
  hIcon As Long
  hCursor As Long
  hbrBackground As Long
  lpszMenuName As Long
  lpszClassName As String
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 * 128  'shell 5+ use 64 for shell 4+
  dwState As Long  'shell 5+
  dwStateMask As Long  'shell 5+
  szInfo As String * 256  'shell 5+
  uTimeOutAndVersion As Long  'shell 5+
  szInfoTitle As String * 64  'shell 5+
  dwInfoFlags As Long  'shell 5+
  '//guidItem As GUID     'shell 6+
End Type

'API Constants
Public Const WM_USER = &H400
Public Const WM_USER_TRAY = WM_USER + 1
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 WM_MBUTTONDOWN = &H207
Public Const WM_MBUTTONUP = &H208
Public Const WM_MBUTTONDBLCLK = &H209

Public Const NIN_BALLOONSHOW As Long = &H402
Public Const NIN_BALLOONHIDE As Long = &H403
Public Const NIN_BalloonTimeOut As Long = &H404
Public Const NIN_BALLOONUSERCLICK As Long = &H405

Public Const GWL_WNDPROC = (-4)

Const PROP_OLDWINDOW = "OldWindowProc"
Const PROP_OBJPTR = "ObjectPointer"

Public Enum enumEventType
  DoubleClick
  MouseDown
  MouseMove
  MouseUp
  BalloonShow
  BalloonHide
  BalloonTimeOut
  BalloonClick
  Reload
End Enum

'This does two things it tells windows that the current form should be sent "TaskbarCreated" event notifications
'and what event ID will represent that message.
Public Declare Function RegisterWindowMessage Lib "user32.dll" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long

'This stores the window message ID number returned when explorer is restarted
'(Please don't hard code this, because it won't work without using the RegisterWindowMessage Command)
Public WM_TASKBARCREATED As Long

Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  If uMsg = WM_USER_TRAY Then
    Dim ptrWin As Long
    Dim clsThis As CBalloonToolTipNotify

    ptrWin = GetProp(hwnd, PROP_OBJPTR)

    If ptrWin <> 0 Then
      Set clsThis = ObjectFromPtr(ptrWin)
      Call clsThis.ProcessMessage(uMsg, wParam, lParam)
    End If
  End If

  'Call the default Window Procedure to provide default processing
  'for any window messages that an application does not process.
  WindowProc = DefWindowProc(hwnd, uMsg, wParam, lParam)
End Function

Public Sub HookWindow(hwnd As Long, obj As Object)
  Dim ptr As Long

  'This does two things it tells windows that the current form should be sent "TaskbarCreated" event notifications
  'and what event ID will represent that message.
  If WM_TASKBARCREATED = 0 Then
    WM_TASKBARCREATED = RegisterWindowMessage("TaskbarCreated")
  End If

  ptr = ObjPtr(obj)

  '//store pointer to window object in window itself as a property, this is very kool technique when you work with MultiInstances
  Call SetProp(hwnd, PROP_OBJPTR, ptr)
  '//Store current windows procedure pointer as a window property so later we can restore it back when we unhook
  Call SetProp(hwnd, PROP_OLDWINDOW, GetWindowLong(hwnd, GWL_WNDPROC))

  '//Set new windows procedure
  Call SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub UnhookWindow(hwnd As Long)
  Dim ptrOldWinProc As Long
  '//get old winproc which we stored
  ptrOldWinProc = GetProp(hwnd, PROP_OLDWINDOW)
  '//Set old windows default procedure
  If (ptrOldWinProc <> 0) Then
    Call SetWindowLong(hwnd, GWL_WNDPROC, ptrOldWinProc)
  End If
End Sub

Public Property Get ObjectFromPtr(ByVal lPtr As Long) As CBalloonToolTipNotify
  Dim oTHis As CBalloonToolTipNotify
  CopyMemory oTHis, lPtr, 4
  Set ObjectFromPtr = oTHis
  CopyMemory oTHis, 0&, 4
End Property

- Add the following code in CBalloonToolTipNotify

CBalloonToolTipNotify.cls

Click here to copy the following block
Private Const HIDDEN_WIN_CLASS_NAME = "VB Tray Class"
Private Const HIDDEN_WIN_NAME = "VB Tray Msg Window"

Private uNIF As NOTIFYICONDATA

Public Enum enumIconType
  ICON_NONE = NIIF_NONE
  ICON_INFO = NIIF_INFO
  ICON_WARNING = NIIF_WARNING
  ICON_ERROR = NIIF_ERROR
End Enum

'Button: 0=left,1=right,2=middle : X, Y in Pixels
Public Event Click()
Public Event DoubleClick(Button As Integer, X As Long, Y As Long)
Public Event MouseDown(Button As Integer, X As Long, Y As Long)
Public Event MouseUp(Button As Integer, X As Long, Y As Long)
Public Event MouseMove(X As Long, Y As Long)
Public Event BalloonShow()
Public Event BalloonHide()
Public Event BalloonTimeOut()
Public Event BalloonClick(X As Long, Y As Long)
Public Event Reload()

Private m_IsBalloonTip As Boolean
Private m_hHiddenMsgWnd As Long
Private m_Cur As POINTAPI
Private m_ContextMenu As Menu  '//Assign Contex menu
Private m_Visible As Boolean
Private m_BalloonTimeOut As Integer
Private m_BalloonIconType As enumIconType
Private m_TrayIcon As Long  '//Icon Handle which will appear in system tray
Private m_TrayIconPic As StdPicture  '//Icon Picture which will appear in system tray

'//Public hWndContextMenu As Long

'/////////////////////////////////////////////////////////////
'//Popupmenu for tray icon : This can be VB Menu or you can
'/////////////////////////////////////////////////////////////
Public Property Let ContextMenu(Value As Menu)
  Set m_ContextMenu = Value
End Property
Public Property Get ContextMenu() As Menu
  Set ContextMenu = m_ContextMenu
End Property

'/////////////////////////////////////////////////////////////
'//Get or Set ballon Icon type
'/////////////////////////////////////////////////////////////
Public Property Get TrayIcon() As Long
  TrayIcon = m_TrayIcon
End Property
Public Property Let TrayIcon(Value As Long)
  m_TrayIcon = Value

  uNIF.uFlags = uNIF.uFlags Or NIF_ICON
  uNIF.hIcon = Value  '//assign handle to icon
  If Visible = True Then
    Call Shell_NotifyIcon(NIM_MODIFY, uNIF)
  End If
End Property
Public Property Let TrayIconPic(Value As StdPicture)
  TrayIcon = Value.Handle
  Set m_TrayIconPic = Value
End Property

'/////////////////////////////////////////////////////////////
'//Timeout for balloon
'/////////////////////////////////////////////////////////////
Public Property Get BalloonTimeOut() As Integer
  BalloonTimeOut = m_BalloonTimeOut
End Property
Public Property Let BalloonTimeOut(Value As Integer)
  m_BalloonTimeOut = Value
  uNIF.uTimeOutAndVersion = Value
  If Visible Then
    uNIF.uFlags = uNIF.uFlags Or NIF_TIP
    Call Shell_NotifyIcon(NIM_MODIFY, uNIF)
  End If
End Property

'/////////////////////////////////////////////////////////////
'//IconType for balloon
'/////////////////////////////////////////////////////////////
Public Property Get BalloonIconType() As enumIconType
  BalloonIconType = m_BalloonIconType
End Property
Public Property Let BalloonIconType(Value As enumIconType)
  m_BalloonIconType = Value
  uNIF.dwInfoFlags = CLng(Value)
  If Visible Then
    uNIF.uFlags = uNIF.uFlags Or NIF_TIP
    Call Shell_NotifyIcon(NIM_MODIFY, uNIF)
  End If
End Property

'/////////////////////////////////////////////////////////////
'//Simple mouseover tool tip text
'/////////////////////////////////////////////////////////////
Public Property Get Text() As String
  Text = uNIF.szTip
End Property
Public Property Let Text(Value As String)
  uNIF.szTip = Value & vbNullChar
  If Visible Then
    uNIF.uFlags = uNIF.uFlags Or NIF_TIP
    Call Shell_NotifyIcon(NIM_MODIFY, uNIF)
  End If
End Property

'/////////////////////////////////////////////////////////////
'//Balloon Tooltip Title
'/////////////////////////////////////////////////////////////
Public Property Get BalloonTitle() As String
  BalloonTitle = uNIF.szInfoTitle
End Property
Public Property Let BalloonTitle(Value As String)
  uNIF.szInfoTitle = Value & vbNullChar
  If Visible Then
    uNIF.uFlags = uNIF.uFlags Or NIF_TIP
    Call Shell_NotifyIcon(NIM_MODIFY, uNIF)
  End If
End Property

'/////////////////////////////////////////////////////////////
'//Balloon Tooltip text
'/////////////////////////////////////////////////////////////
Public Property Get BalloonText() As String
  BalloonText = uNIF.szInfo
End Property
Public Property Let BalloonText(Value As String)
  uNIF.szInfo = Value & vbNullChar
  If Visible Then
    uNIF.uFlags = uNIF.uFlags Or NIF_TIP
    Call Shell_NotifyIcon(NIM_MODIFY, uNIF)
  End If
End Property

'/////////////////////////////////////////////////////////////
'Show/Hide icon from the tray
'/////////////////////////////////////////////////////////////
Public Property Get Visible() As Boolean
  Visible = m_Visible
End Property
Public Property Let Visible(Value As Boolean)
  m_Visible = Value

  If m_Visible Then
    Call Shell_NotifyIcon(NIM_ADD, uNIF)
  Else
    Call Shell_NotifyIcon(NIM_DELETE, uNIF)
  End If
End Property

Public Sub ShowNotifyBalloonTip(Optional ByVal sText As String = "", _
  Optional ByVal sTitle As String = "", _
  Optional ByVal nIconType As Integer = -1, _
  Optional ByVal nTimeOut As Integer = -1)

  With uNIF
    .uFlags = .uFlags Or NIF_INFO
    .uTimeOutAndVersion = IIf(nTimeOut = -1, BalloonTimeOut, nTimeOut)
    .szInfo = IIf(sText = "", BalloonText, sText)
    .szInfoTitle = IIf(sTitle = "", BalloonTitle, sTitle)
    .dwInfoFlags = IIf(nIconType = -1, BalloonIconType, nIconType)
  End With

  If Not Visible Then
    '//By changing Visble Property it will show icon in sys tray
    Visible = True
  Else
    '//This will modify attributes if already visible
    Call Shell_NotifyIcon(NIM_MODIFY, uNIF)
  End If

  '//After showing balloon tip again switch to standard tooltip
  uNIF.uFlags = uNIF.uFlags And Not NIF_INFO
End Sub

'/////////////////////////////////////////////////////////////
'Function should only be called from modInTray to process windows
'messages generated from the System Tray
'
'Note: Friend Functions can be only used within the Project.
'/////////////////////////////////////////////////////////////
Friend Sub ProcessMessage(uMsg As Long, wParam As Long, lParam As Long)
  Select Case uMsg
    Case WM_USER_TRAY
      GetCursorPos m_Cur
      Select Case lParam
        Case WM_LBUTTONDBLCLK, WM_RBUTTONDBLCLK, WM_MBUTTONDBLCLK
          If lParam = WM_LBUTTONDBLCLK Then RaiseEvent DoubleClick(0, m_Cur.X, m_Cur.Y)
          If lParam = WM_RBUTTONDBLCLK Then RaiseEvent DoubleClick(1, m_Cur.X, m_Cur.Y)
          If lParam = WM_MBUTTONDBLCLK Then RaiseEvent DoubleClick(2, m_Cur.X, m_Cur.Y)
        Case WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MBUTTONDOWN
          If lParam = WM_LBUTTONDOWN Then RaiseEvent MouseDown(0, m_Cur.X, m_Cur.Y)
          If lParam = WM_RBUTTONDOWN Then RaiseEvent MouseDown(1, m_Cur.X, m_Cur.Y)
          If lParam = WM_MBUTTONDOWN Then RaiseEvent MouseDown(2, m_Cur.X, m_Cur.Y)
        Case WM_MOUSEMOVE
          RaiseEvent MouseMove(m_Cur.X, m_Cur.Y)
        Case WM_LBUTTONUP
          RaiseEvent MouseUp(0, m_Cur.X, m_Cur.Y)
          RaiseEvent Click
        Case WM_RBUTTONUP
          RaiseEvent MouseUp(1, m_Cur.X, m_Cur.Y)
          RaiseEvent Click
          '//only show if menu already set
          If Not (ContextMenu Is Nothing) Then
            ContextMenu.Parent.PopupMenu ContextMenu
          End If
        Case WM_MBUTTONUP
          RaiseEvent MouseUp(2, m_Cur.X, m_Cur.Y)
          RaiseEvent Click
        Case NIN_BALLOONSHOW
          RaiseEvent BalloonShow
        Case NIN_BALLOONHIDE
          RaiseEvent BalloonHide
        Case NIN_BalloonTimeOut
          RaiseEvent BalloonTimeOut
        Case NIN_BALLOONUSERCLICK
          RaiseEvent BalloonClick(m_Cur.X, m_Cur.Y)
        Case Else
          'Debug.Print lParam
      End Select
      'Debug.Print wParam & " : " & lParam
    Case WM_TASKBARCREATED
      RaiseEvent Reload
    Case Else
  End Select
End Sub

Public Sub Class_Initialize()
  m_hHiddenMsgWnd = CreateHiddenMsgWindow
  If m_hHiddenMsgWnd = 0 Then Debug.Print "Failed to create hidden message window"

  With uNIF
    .hwnd = m_hHiddenMsgWnd  '//Message window which will receive all events
    .cbSize = Len(uNIF)  '//structure size
    '//NIF_TIP=> simple mouse over tip
    '//NIF_INFO=> Balloon tooltip
    .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE  '//flag for simple mouse over tip
    '.uID = 1234  '//(optional) Uniue application sys tray id
    .uTimeOutAndVersion = NOTIFYICON_VERSION  '//use this to get functionality of win2k+
    .szTip = "" & vbNullChar  '//no mouseover tip right now
    '.szInfoTitle = "" & vbNullChar
    '.szInfo = "" & vbNullChar
    .uCallbackMessage = WM_USER_TRAY  '//send ony tray related messages
  End With

  If m_hHiddenMsgWnd <> 0 Then Call HookWindow(m_hHiddenMsgWnd, Me)
End Sub

Private Sub Class_Terminate()
  '//remove tray icon
  Visible = False

  If m_hHiddenMsgWnd <> 0 Then Call UnhookWindow(m_hHiddenMsgWnd)

  '//Close the dummy window
  SendMessage m_hHiddenMsgWnd, WM_CLOSE, 0, ByVal 0&

  '//unregister the dummy window class
  UnregisterClass HIDDEN_WIN_CLASS_NAME, App.hInstance
  Debug.Print "Terminate"
End Sub

Private Function CreateHiddenMsgWindow() As Long
  '//Register a class for, and create the dummy window
  Dim wc As WNDCLASS
  wc.style = 0
  wc.lpfnwndproc = PtrToFun(AddressOf WindowProc)
  wc.hInstance = App.hInstance
  wc.lpszClassName = HIDDEN_WIN_CLASS_NAME
  RegisterClass wc
  CreateHiddenMsgWindow = CreateWindowEx(0, HIDDEN_WIN_CLASS_NAME, HIDDEN_WIN_NAME, 0, 0, 0, 100, 100, 0, 0, 0, ByVal 0)
End Function

'Dummy function to allow AddressOf to assign to a variable
Private Function PtrToFun(ptr As Long) As Long
  PtrToFun = ptr
End Function



Submitted By : Nayan Patel  (Member Since : 5/26/2004 12:23:06 PM)

Job Description : He is the moderator of this site and currently working as an independent consultant. He works with VB.net/ASP.net, SQL Server and other MS technologies. He is MCSD.net, MCDBA and MCSE. In his free time he likes to watch funny movies and doing oil painting.
View all (893) submissions by this author  (Birth Date : 7/14/1981 )


Home   |  Comment   |  Contact Us   |  Privacy Policy   |  Terms & Conditions   |  BlogsZappySys

© 2008 BinaryWorld LLC. All rights reserved.