Solved

Run is systray

Posted on 2002-05-20
4
270 Views
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.

Cheers,
GMorgan
0
Comment
Question by:GMorgan
  • 2
  • 2
4 Comments
 
LVL 2

Accepted Solution

by:
Crin earned 50 total points
Comment Utility
Hi,

use this:

'user defined type required by Shell_NotifyIcon API call
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

'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

Public nid As NOTIFYICONDATA



Private Sub Form_Load()

  'system tray
  Me.Show
  Me.Refresh
  With nid
    .cbSize = Len(nid)
    .hwnd = Me.hwnd
    .uId = vbNull
    .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    .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
 Else
    msg = X / Screen.TwipsPerPixelX
 End If
 Select Case msg
    Case WM_LBUTTONUP        '514 restore form window
      Me.WindowState = vbNormal
      Result = SetForegroundWindow(Me.hwnd)
      Me.Show
    Case WM_LBUTTONDBLCLK    '515 restore form window
      Me.WindowState = vbNormal
      result = SetForegroundWindow(Me.hwnd)
      Me.Show
    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




Sincerely,
Crin
0
 
LVL 1

Expert Comment

by:Wildi
Comment Utility
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
  aSysTray.AddIcon



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

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

Private IT_SysTray As NOTIFYICONDATA
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
    AddIcon
  Else
    RemoveIcon
  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()
  RemoveIcon
  AddIcon
End Function

Public Property Let TrayTip(ByVal Tip As String)
  If Tip = "" Then
      IT_SysTray.szTip = vbNullChar
  Else
      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.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
  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
        Else
          aForm.Visible = True
          aForm.SetFocus
          SysTrayPopup = vbLeftButton
        End If
      Case vbRightButton
        SysTrayPopup = vbRightButton
      Case vbMiddleButton
        SysTrayPopup = vbMiddleButton
    End Select
    DoEvents
    '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
    Else
      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
0
 
LVL 2

Expert Comment

by:Crin
Comment Utility
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

Sincerely,
Crin

0
 
LVL 1

Expert Comment

by:Wildi
Comment Utility
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.
0

Featured Post

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
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…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

743 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

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now