[2 days left] What’s wrong with your cloud strategy? Learn why multicloud solutions matter with Nimble Storage.Register Now


Run is systray

Posted on 2002-05-20
Medium Priority
Last Modified: 2010-05-02
I have a little application that I would like to run in the systray but not be displayed in the taskbar unless activated (just like ICQ 2000a).  If you have any suggestions let me know.

Question by:GMorgan
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2

Accepted Solution

Crin earned 200 total points
ID: 7022370

use this:

'user defined type required by Shell_NotifyIcon API call
  cbSize As Long
  hwnd As Long
  uId As Long
  uFlags As Long
  uCallBackMessage As Long
  hIcon As Long
  szTip As String * 64
End Type

'constants required by Shell_NotifyIcon API call:
Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201     'Button down
Public Const WM_LBUTTONUP = &H202       'Button up
Public Const WM_LBUTTONDBLCLK = &H203   'Double-click
Public Const WM_RBUTTONDOWN = &H204     'Button down
Public Const WM_RBUTTONUP = &H205       'Button up
Public Const WM_RBUTTONDBLCLK = &H206   'Double-click

Public Declare Function SetForegroundWindow Lib "user32" _
  (ByVal hwnd As Long) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32" _
  Alias "Shell_NotifyIconA" _
  (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean


Private Sub Form_Load()

  'system tray
  With nid
    .cbSize = Len(nid)
    .hwnd = Me.hwnd
    .uId = vbNull
    .uCallBackMessage = WM_MOUSEMOVE
    .hIcon = frmMainAc.Icon
    .szTip = "Task Manager" & vbNullChar
  End With
  Shell_NotifyIcon NIM_ADD, nid

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As _
         Single, Y As Single)
'this procedure receives the callbacks from
'the System Tray icon.
Dim result As Long
Dim msg As Long
 'the value of X will vary depending upon the scalemode setting
 If Me.ScaleMode = vbPixels Then
    msg = X
    msg = X / Screen.TwipsPerPixelX
 End If
 Select Case msg
    Case WM_LBUTTONUP        '514 restore form window
      Me.WindowState = vbNormal
      Result = SetForegroundWindow(Me.hwnd)
    Case WM_LBUTTONDBLCLK    '515 restore form window
      Me.WindowState = vbNormal
      result = SetForegroundWindow(Me.hwnd)
    Case WM_RBUTTONUP        '517 display popup menu
      result = SetForegroundWindow(Me.hwnd)
      Me.PopupMenu Me.mPopupSys 'assuming your form has mPopupSys menu. Or you can add any other activity here
  End Select
End Sub


Expert Comment

ID: 7022508
Below the source code for a class module. As I had some troubles with correct handling of the mouse events I implemented two methods SysTrayPopup and MouseMoveTrap. I prefer using the MouseMoveTrap method because making less troubles.

Initialization (CmdSysTray should be a command button):

  aSysTray.OwnerControl = CmdSysTray
  aSysTray.TrayIcon = Me.Icon
  aSysTray.TrayTip = Me.Caption

Trapping mouse:

  Private Sub CmdSysTray_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
    If Me.WindowState = vbMinimized Then Me.WindowState = vbNormal
    If aSysTray.MouseMoveTrap(Button, Me, X, Y) = STRightClick Then
      PopupMenu mSysTray
    End If
  End Sub

---------------Begin Code Snippet

Option Explicit

'Left-click constants.
Private Const WM_LBUTTONDBLCLK = &H203   'Double-click
Private Const WM_LBUTTONDOWN = &H201     'Button down
Private Const WM_LBUTTONUP = &H202       'Button up

'Right-click constants.
Private Const WM_RBUTTONDBLCLK = &H206   'Double-click
Private Const WM_RBUTTONDOWN = &H204     'Button down
Private Const WM_RBUTTONUP = &H205       'Button up

'Middle-click constants.
Private Const WM_MBUTTONDBLCLK = &H209   'Double-click
Private Const WM_MBUTTONDOWN = &H207     'Button down
Private Const WM_MBUTTONUP = &H208       'Button up

Public SkipFlag As Integer

Public Enum eSysTrayEvent
  STleftClick = 1
  STRightClick = 2
  STleftDblClick = 4
  STRightDblClick = 8
  STMiddleClick = 16
  STMiddleDblClick = 32
  STNone = 64
End Enum

Public EnableSwitching As Boolean
Public ShowFormEvent As eSysTrayEvent

    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 Const WM_MOUSEMOVE = &H200

Private IT_InTray As Boolean
Private IT_OwnerControlSet As Boolean
Private IT_IconSet As Boolean
Private IT_OwnerControl As Object

Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Public Property Let InTray(Add As Boolean)
  If Add Then
  End If
  IT_InTray = Add
End Property

Public Property Get InTray() As Boolean
  InTray = IT_InTray
End Property

Public Property Let OwnerControl(ByVal vData As Object)
  If IT_InTray Then Exit Property 'can't set when active
  Set IT_OwnerControl = vData
  IT_OwnerControlSet = True
End Property

Public Property Get OwnerControl() As Object
  Set OwnerControl = IT_OwnerControl
End Property

Public Function Refresh()
End Function

Public Property Let TrayTip(ByVal Tip As String)
  If Tip = "" Then
      IT_SysTray.szTip = vbNullChar
      IT_SysTray.szTip = Tip & vbNullChar
  End If
  If IT_InTray Then Shell_NotifyIcon NIM_MODIFY, IT_SysTray
End Property

Public Property Get TrayTip() As String
  TrayTip = IT_SysTray.szTip
End Property

Public Property Let TrayIcon(ByVal vData As Object)
  IT_SysTray.hIcon = vData
  IT_IconSet = True
  If IT_InTray Then Shell_NotifyIcon NIM_MODIFY, IT_SysTray
End Property

Public Function RemoveIcon() As Boolean
  If IT_InTray = True Then
      Shell_NotifyIcon NIM_DELETE, IT_SysTray
      IT_InTray = False
  End If
  RemoveIcon = True
End Function

Public Function AddIcon() As Boolean
  If IT_InTray Then 'Already active
      Exit Function
  ElseIf Not IT_IconSet Then 'No icon specified
      Exit Function
  ElseIf Not IT_OwnerControlSet Then 'No owner control specified
      Exit Function
  End If
  IT_SysTray.hWnd = IT_OwnerControl.hWnd
  IT_SysTray.uID = 1&
  IT_SysTray.uCallbackMessage = WM_MOUSEMOVE
  IT_SysTray.cbSize = Len(IT_SysTray)
  Shell_NotifyIcon NIM_ADD, IT_SysTray
  IT_InTray = True
  AddIcon = True
  SkipFlag = 0
End Function

Public Sub Help()
  Dim s As String
  s = "To put in tray:" & vbCr
  s = s & "SysTray.TrayIcon = Me.Icon" & vbCr
  s = s & "SysTray.OwnerControl = <CommandBox Control>" & vbCr
  s = s & "SysTray.AddIcon" & vbCr
  s = s & "'After this trap the MouseMove Event of the control" & vbCr & vbCr
  s = s & "To remove from tray:" & vbCr
  s = s & "SysTray.RemoveIcon"
  MsgBox s
End Sub

Public Function SysTrayPopup(ByRef aButton As Integer, ByRef aForm As Object) As Integer
  On Error Resume Next
  SysTrayPopup = 0
  'Debug.Print aButton
  If aButton <> SkipFlag Then
    SkipFlag = aButton
    Select Case aButton
      Case vbLeftButton
        If aForm.Visible Then
          aForm.Visible = False
          aForm.Visible = True
          SysTrayPopup = vbLeftButton
        End If
      Case vbRightButton
        SysTrayPopup = vbRightButton
      Case vbMiddleButton
        SysTrayPopup = vbMiddleButton
    End Select
    'Button = 0
  End If
End Function

Public Function MouseMoveTrap(ByRef aButton As Integer, ByRef aForm As Object, ByRef X As Single, ByRef Y As Single) As eSysTrayEvent
  Dim aMsg As Long
  Dim aEvent As eSysTrayEvent
  On Error Resume Next
  aMsg = X / Screen.TwipsPerPixelX
  Select Case aMsg
    Case WM_MOUSEMOVE 'Only MouseMove - no Button clicked
      aEvent = STNone
    Case WM_LBUTTONDOWN 'Left Button Down
      aEvent = STNone
    Case WM_RBUTTONDOWN 'Right Button Down
      aEvent = STNone
    Case WM_MBUTTONDOWN 'Middle Button Down
      aEvent = STNone
    Case WM_LBUTTONUP 'Left Button Up
      aEvent = STleftClick
    Case WM_RBUTTONUP 'Right Button Up
      aEvent = STRightClick
    Case WM_MBUTTONUP 'Middle Button Up
      aEvent = STMiddleClick
    Case WM_LBUTTONDBLCLK 'Left Button Doubleclick (occurs instead of second click)
      aEvent = STleftDblClick
    Case WM_RBUTTONDBLCLK 'Right Button Doubleclick (occurs instead of second click)
      aEvent = STRightDblClick
    Case WM_MBUTTONDBLCLK 'Middle Button Doubleclick (occurs instead of second click)
      aEvent = STMiddleDblClick
    Case Else
      aEvent = STNone
  End Select
  If (aEvent And ShowFormEvent) = aEvent Then
    If EnableSwitching Then
      If Not aForm.Visible Then
        If aForm.WindowState = vbMinimized Then aForm.WindowState = vbNormal
      End If
      aForm.Visible = Not aForm.Visible
      If aForm.WindowState = vbMinimized Then aForm.WindowState = vbNormal
      aForm.Visible = True
    End If
    If aForm.Visible And aForm.WindowState = vbMinimized Then
      aForm.WindowState = vbNormal
    End If
    If aForm.Visible Then
      AppActivate GetCurrentProcessId()
      SetForegroundWindow aForm.hWnd
    End If
  End If
'  Select Case aEvent
'    Case 1 'STLeftClick, Left Button Click
'    Case 2 'STRightClick, Right Button Click
'    Case 4 'STLeftDblClick, Left Button Doubleclick
'    Case 8 'STRightDblClick, Right Button Doubleclick
'  End Select
  MouseMoveTrap = aEvent
End Function

Private Sub Class_Initialize()
  SkipFlag = 0
  ShowFormEvent = STleftDblClick
  EnableSwitching = True
End Sub

---------------Begin Code Snippet

Expert Comment

ID: 7022539
I had no problems with code I posted, why to use button? Isn't it just a complication of my code?

Also, I bet line
 aSysTray.OwnerControl = CmdSysTray
should look like
 Set aSysTray.OwnerControl = CmdSysTray
since CmdSysTray should be a command button...

By the way, I forgot to post code for icon removal, which is very simple and obvious...

Private Sub Form_Unload(Cancel As Integer)
Shell_NotifyIcon NIM_DELETE, nid
End Sub



Expert Comment

ID: 7023347
No, especially in this case the set command may not be used.

The problems I had were, that the event came multiple times with different values for the mousebutton and when you clicked to quickly the window did hide again immediately. I could have avoided only with removing the feature that another double click on the tray icon "pops down" the window again. You did not implemented this feature in your code so you did not face this problem.

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Suggested Courses

656 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question