?
Solved

System Tray Icon not firing Mouse Events

Posted on 2010-01-12
10
Medium Priority
?
508 Views
Last Modified: 2013-11-25
i have two apps, the first one the sys tray icon works great but the second one, when i click on the sys tray icon it does not activate the mouse event. the mouse event only activates if i click on the main form.  here is the source for the main form and the module
Main Form:


Private DbaseConn As ADODB.Connection
Private RecSet As ADODB.Recordset
Private objCMD As ADODB.Command
Private SQL As String
Private objCurrLI As ListItem
Public strID As String
Private strConn As String
Private sAppName As String, sAppPath As String

Private Sub Form_Activate()
 'NOTHING
End Sub


Private Sub Form_Unload(Cancel As Integer)
    Set RecSet = Nothing
    'DbaseConn.Close
    Set DbaseConn = Nothing
    Shell_NotifyIcon NIM_DELETE, nid
End Sub

Private Sub Form_Load()
   
Set DbaseConn = New ADODB.Connection




With lstv_Display
        .ColumnHeaders.Clear
        .ColumnHeaders.Add , , "ID", .Width * 0.04
        .ColumnHeaders.Add , , "Name", .Width * 0.1
        .ColumnHeaders.Add , , "Fax Number", .Width * 0.1
        .ColumnHeaders.Add , , "Status", .Width * 0.1
        .ColumnHeaders.Add , , "Delete Date", .Width * 0.1
End With
lstv_Display.ListItems.Clear
'Call check_update

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 = Me.Icon
    .szTip = "Your ToolTip" & 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)

Dim Result As Long
Dim msg As Long

If Me.ScaleMode = vbPixels Then
    msg = x
Else
    msg = x / Screen.TwipsPerPixelX
End If

Select Case msg
    Case WM_LBUTTONUP
        Me.WindowState = vbNormal
        Result = SetForegroundWindow(Me.hwnd)
        Me.Show
    Case WM_LBUTTONDBLCLK
    Me.WindowState = vbNormal
        Result = SetForegroundWindow(Me.hwnd)
        Me.Show
    Case WM_RBUTTONUP
        Result = SetForegroundWindow(Me.hwnd)
        Me.PopupMenu Me.mPopupSys
End Select

End Sub

Private Sub Form_Resize()
       'this is necessary to assure that the minimized window is hidden
       If Me.WindowState = vbMinimized Then Me.Hide
      End Sub

Private Sub mnu_Exit_Click()
    Unload Me
End Sub

Private Sub mPopExit_Click()
'called when user clicks the popup menu Exit command
Unload Me
End Sub

Private Sub mPopRestore_Click()
'called when the user clicks the popup menu Restore command
Me.WindowState = vbNormal
Result = SetForegroundWindow(Me.hwnd)
Me.Show
End Sub

Private Sub btn_cancel_Click()
    txt_Name.Text = ""
    txt_FaxNum.Text = ""
    cbo_Status.Text = "ALL"
    txt_Name.SetFocus
    lstv_Display.ListItems.Clear
End Sub

Private Sub btn_Modify_Click()
    strID = lstv_Display.SelectedItem.Text
    frmModify.Show
End Sub

Private Sub btn_Search_Click()
    On Error Resume Next
    
Dim strUSED As Integer
Dim strUNUSED As Integer
Set RecSet = New ADODB.Recordset

lstv_Display.ListItems.Clear

If txt_Name.Text = "" And txt_FaxNum.Text = "" And cbo_Status.Text = "ALL" Then

    SQL = "SELECT * FROM FAX_NUMS"
    
End If

If txt_Name.Text = "" And txt_FaxNum.Text = "" And cbo_Status.Text = "USED" Then

    SQL = "SELECT * FROM FAX_NUMS WHERE FAX_STATUS = 'USED'"
    
End If

If txt_Name.Text = "" And txt_FaxNum.Text = "" And cbo_Status.Text = "UNUSED" Then

    SQL = "SELECT * FROM FAX_NUMS WHERE FAX_STATUS = 'UNUSED' AND FAX_USER IS NULL"
    
End If

If txt_Name.Text = "" And txt_FaxNum.Text = "" And cbo_Status.Text = "REUSED" Then

    SQL = "SELECT * FROM FAX_NUMS WHERE FAX_USER = ''"
    
End If

If txt_Name.Text = "" And txt_FaxNum.Text = "" And cbo_Status.Text = "DELETE" Then

    SQL = "SELECT * FROM FAX_NUMS WHERE FAX_DATE IS NOT NULL"
    
End If

If txt_Name.Text <> "" And txt_FaxNum.Text = "" Then

    SQL = "SELECT * FROM FAX_NUMS WHERE FAX_USER LIKE '%" & txt_Name.Text & "%'"
    
End If

If txt_Name.Text = "" And txt_FaxNum.Text <> "" Then

    SQL = "SELECT * FROM FAX_NUMS WHERE FAX_NUM LIKE '%" & txt_FaxNum.Text & "%'"
    
End If

If txt_Name.Text <> "" And txt_FaxNum.Text <> "" Then

    SQL = "SELECT * FROM FAX_NUMS WHERE FAX_NUM LIKE '%" & txt_FaxNum.Text & "%' AND FAX_USER LIKE '%" & txt_Name.Text & "%'"
    
End If

With RecSet
    .ActiveConnection = DbaseConn
    .CursorLocation = adUseClient
    .CursorType = adOpenDynamic
    .LockType = adLockOptimistic
    .Open SQL
End With

lstv_Display.ListItems.Clear
RecSet.MoveFirst
    Do While Not RecSet.EOF
            
          Set objCurrLI = lstv_Display.ListItems.Add(, , RecSet("ID"))
          objCurrLI.SubItems(1) = RecSet("FAX_USER")
          objCurrLI.SubItems(2) = RecSet("FAX_NUM")
          objCurrLI.SubItems(3) = RecSet("FAX_STATUS")
          objCurrLI.SubItems(4) = RecSet("FAX_DATE")
            
        RecSet.MoveNext
        
        If RecSet("FAX_STATUS") = "USED" Then
            strUSED = strUSED + 1
        Else
            strUNUSED = strUNUSED + 1
        End If
Loop
    
lbl_used.Caption = strUSED
lbl_available.Caption = strUNUSED
    
    With lstv_Display
    
        If .ListItems.Count > 0 Then
         Set .SelectedItem = .ListItems(1)
         .Sorted = True
         .SortKey = 1
        End If
    
    End With
    
    RecSet.Close
    Set RecSet = Nothing
    
    Dim lStyle As Long
        lStyle = SendMessage(lstv_Display.hwnd, _
           LVM_GETEXTENDEDLISTVIEWSTYLE, 0, 0)
        lStyle = lStyle Or LVS_EX_FULLROWSELECT
        Call SendMessage(lstv_Display.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, _
           0, ByVal lStyle)

End Sub

Private Sub lstv_Display_ColumnClick(ByVal ColumnHeader As ComctlLib.ColumnHeader)
    Call LV_ColumnSort(lstv_Display, ColumnHeader)
End Sub

Private Sub LV_ColumnSort(ListViewControl As ListView, _
  Column As ColumnHeader)
 With ListViewControl
  If .SortKey <> Column.Index - 1 Then
   .SortKey = Column.Index - 1
   .SortOrder = lvwAscending
  Else
   If .SortOrder = lvwAscending Then
    .SortOrder = lvwDescending
   Else
    .SortOrder = lvwAscending
   End If
  End If
  .Sorted = -1
 End With
End Sub

Private Sub lstv_Display_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
        
    If Button = 2 Then
        If lstv_Display.SelectedItem Is Nothing Then
            smnu_modify.Enabled = False
            smnu_delete.Enabled = False
        Else
            smnu_modify.Enabled = True
            smnu_delete.Enabled = True
        End If
        PopupMenu Fax_Menu, , x + lstv_Display.Left, y + lstv_Display.Top
        
    End If
End Sub

Private Sub smnu_delete_Click()
    Call delete_record
End Sub

Private Sub smnu_modify_Click()
    strID = lstv_Display.SelectedItem.Text
    frmModify.Show
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    On Error Resume Next
    
    Dim strPass As String
    
    Select Case Button.Key
    
    Case "add"
    
        frm_Import.Show
        
    Case "modify"
    
        strID = lstv_Display.SelectedItem.Text
        frmModify.Show
        
    Case "delete"
    
        Call delete_record
        
    Case "export"
    
        frm_Export.Show
        
    Case "exit"
        Unload Me
    End Select

End Sub
Private Sub delete_record()

Dim resp As String
        
        strID = lstv_Display.SelectedItem.Text
        
        If strID <> "" Then
        
            strPass = InputBox("Enter Password:", "Clear Database Password")
            
            If strPass = "W!p3D@t@" Then
        
                resp = MsgBox("Are you sure you want to detete record " & strID & "?", vbYesNo, "Delete Record")
                
                If resp = vbYes Then
                
                    Set objCMD = New ADODB.Command
                                
                    SQL = "DELETE FROM FAX_NUMS WHERE ID = " & CInt(strID)
                    
                    With objCMD
                        .ActiveConnection = DbaseConn
                        .CommandType = adCmdText
                        .CommandText = SQL
                        .CommandTimeout = 60
                        .Execute
                    End With
                    
                    Set objCMD = Nothing
                        
                    MsgBox "Record " & strID & " Deleted", vbInformation
                    
                End If
        End If
    Else
            
            
            strPass = InputBox("Enter Password:", "Clear Database Password")
            
            If strPass = "W!p3D@t@" Then
            
                resp = MsgBox("Are you sure you want to detete ALL record?", vbYesNo, "Delete ALL Record")
                
                If resp = vbYes Then
                
                    Set objCMD = New ADODB.Command
                                
                    SQL = "DELETE FROM FAX_NUMS"
                    
                    With objCMD
                        .ActiveConnection = DbaseConn
                        .CommandType = adCmdText
                        .CommandText = SQL
                        .CommandTimeout = 60
                        .Execute
                    End With
                    
                    Set objCMD = Nothing
                        
                    MsgBox "Record " & strID & " Deleted", vbInformation
                    
                End If
                
            End If

    End If
End Sub
Private Sub check_update()
 
 Dim strPath As String
     
 strPath = "\\192.168.25.48\Infrastructure\Software\Prospect Mortgage Fax Manager Install\Updates\version1.1.txt"
 Set fso = CreateObject("Scripting.FileSystemObject")
 
 If fso.FileExists(strPath) Then
 
 Shell "C:\Program Files\Fax_Manager\Fax_Manager_Updater.exe", 1
 
 End If
 
  
 
End Sub


Module:

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 Const LVS_EX_FULLROWSELECT = &H20
Public Const LVM_FIRST = &H1000
Public Const LVM_GETEXTENDEDLISTVIEWSTYLE = LVM_FIRST + &H37
Public Const LVM_SETEXTENDEDLISTVIEWSTYLE = LVM_FIRST + &H36


      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_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

Open in new window

0
Comment
Question by:metroexpert
[X]
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
  • 5
  • 5
10 Comments
 
LVL 18

Expert Comment

by:David Robitaille
ID: 26304266
ok, i guess its VB6 and`and you got inspiration from here...
http://www.devx.com/vb2themax/Tip/18407 
So the problem is the "I have two apps".
Is the 2 apps are 2 instance of the same program? it<s something you need?
if not, you could prevent multiple instences using "App.PrevInstance"
Here is an exemple
http://www.experts-exchange.com/Programming/Languages/Visual_Basic/Q_20912669.html 
0
 

Author Comment

by:metroexpert
ID: 26306536
no its 2 totally different applications using the same sys tray code running on different servers,  so there only one instance of the exe running. but for some reason the systray icon on the second app doesn't response to the mouse except for the tool tips pops up when the mouse pointer is placed over it. I thought the systray icon is suppose to be like an extension of the main form?
0
 
LVL 18

Expert Comment

by:David Robitaille
ID: 26306593
I thought the systray icon is suppose to be like an extension of the main form?
this is done by setting .uCallBackMessage = WM_MOUSEMOVE

But you said that apps are "running on different servers"
Are those 2 server using the same OS version??? dos it run ok on your developement computer?
0
Get your Conversational Ransomware Defense e‑book

This e-book gives you an insight into the ransomware threat and reviews the fundamentals of top-notch ransomware preparedness and recovery. To help you protect yourself and your organization. The initial infection may be inevitable, so the best protection is to be fully prepared.

 

Author Comment

by:metroexpert
ID: 26306691
yes they run the same OS, and it doesnt work on the dev pc either. my users also use the apps and it doesnt work on their pcs either.

here is a link to the vb6 project source code.

http://www.megaupload.com/?d=2QDSRP0E

try it for your self.
0
 
LVL 18

Expert Comment

by:David Robitaille
ID: 26306746
when i click on your link, i got this message
"The file you are trying to access is temporarily unavailable"
i will try later...
0
 

Author Comment

by:metroexpert
ID: 26306776
its working now.
0
 
LVL 18

Expert Comment

by:David Robitaille
ID: 26308227
thatts strange, but i found the problem.
if you remove the toolbar Toolbar1 from the mainFrm, it`s work....
 
0
 

Author Comment

by:metroexpert
ID: 26308254
so i cant use a toolbar?
0
 
LVL 18

Accepted Solution

by:
David Robitaille earned 2000 total points
ID: 26308317
I`m not sure why, but thant what causes the problem. it<s incompatible with the systemtray, at least the way you implement it...
It probably subcalss the from or something like that...
you could use something like the LaVolpe Buttons instead...
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=45279&lngWId=1 
0
 

Author Closing Comment

by:metroexpert
ID: 31676325
Thank you
0

Featured Post

Want to be a Web Developer? Get Certified Today!

Enroll in the Certified Web Development Professional course package to learn HTML, Javascript, and PHP. Build a solid foundation to work toward your dream job!

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…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
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…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

777 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