System Tray Icon not firing Mouse Events
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
ASKER
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?
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?
ASKER
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.
here is a link to the vb6 project source code.
http://www.megaupload.com/?d=2QDSRP0E
try it for your self.
when i click on your link, i got this message
"The file you are trying to access is temporarily unavailable"
i will try later...
"The file you are trying to access is temporarily unavailable"
i will try later...
ASKER
its working now.
thatts strange, but i found the problem.
if you remove the toolbar Toolbar1 from the mainFrm, it`s work....
if you remove the toolbar Toolbar1 from the mainFrm, it`s work....
ASKER
so i cant use a toolbar?
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thank you
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
https://www.experts-exchange.com/questions/20912669/VB6-How-to-prevent-multiple-instances-of-same-application-from-loading.html