Find Code:
All Words
Any of the Words
Exact Phrase
Home
:
Code
:
Forums
:
Submit
:
Mailing List
:
About
:
Contact
Code
All
VB.NET
ASP.NET
C#
VB Classic
ASP Classic
Snippets
Popular
Resources
Submit Code
Forums
Articles
Tips
Links
Books
Contest
Link to us
Display systray Icon when Project running
Author:
Krishna
E-mail:
Click to e-mail author
Submitted:
10/30/2006
Version:
VB6
Compatibility:
VB6
Category:
Miscellaneous
Views:
13701
To display Systray ICON in System Tray when project runs. It adds proffessional look to ur Project(4 better results Change the Forms ICON with .ico File with gud Logo)
Declarations:
Public Const WM_RBUTTONDOWN = &H204 Public Const WM_RBUTTONUP = &H205 Public Const WM_ACTIVATEAPP = &H1C Public Const NIF_ICON = &H2 Public Const NIF_form1SSAGE = &H1 Public Const NIF_TIP = &H4 Public Const NIM_ADD = &H0 Public Const NIM_DELETE = &H2 Public Const MAX_TOOLTIP As Integer = 64 Public Const GWL_WNDPROC = (-4) Option Explicit Public Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwform1ssage As Long, lpData As NOTIFYICONDATA) As Long Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _ ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public Type NOTIFYICONDATA cbSize As Long hWnd As Long uID As Long uFlags As Long uCallbackform1ssage As Long hIcon As Long szTip As String * MAX_TOOLTIP End Type Public nfIconData As NOTIFYICONDATA Public FHandle As Long ' Storage for form handle Public WndProc As Long ' Address of our handler Public Hooking As Boolean ' Hooking indicator Public Sub Command1_Click() On Error Resume Next Hook CMAE_INVISBLE_FORM.hWnd ' Set up our handler AddIconToTray CMAE_INVISBLE_FORM.hWnd, CMAE_INVISBLE_FORM.Icon, CMAE_INVISBLE_FORM.Icon.Handle, "I am printing Quotes, Dont terminate me" End Sub ' Handler for mouse events occuring in system tray. Public Sub SysTrayMouseEventHandler() On Error Resume Next SetForegroundWindow CMAE_INVISBLE_FORM.hWnd End Sub Public Sub command2_Click() On Error Resume Next Unhook ' Return event control to windows RemoveIconFromTray End Sub ' Example - AddIconToTray CMAE_INVISBLE_FORM.Hwnd, CMAE_INVISBLE_FORM.Icon, CMAE_INVISBLE_FORM.Icon.Handle, "This is a test tip" Public Sub AddIconToTray(form1Hwnd As Long, form1Icon As Long, form1IconHandle As Long, Tip As String) On Error Resume Next With nfIconData .hWnd = form1Hwnd .uID = form1Icon .uFlags = NIF_ICON Or NIF_form1SSAGE Or NIF_TIP .uCallbackform1ssage = WM_RBUTTONUP .hIcon = form1IconHandle .szTip = Tip & Chr$(0) .cbSize = Len(nfIconData) End With Shell_NotifyIcon NIM_ADD, nfIconData End Sub ' Remove your application from the system tray. ' Call when you quit your application. Public Sub RemoveIconFromTray() On Error Resume Next Shell_NotifyIcon NIM_DELETE, nfIconData End Sub ' Call this routine to ensure my app gets notified of all events ' Example - Hook form1.hWnd Public Sub Hook(Lwnd As Long) On Error Resume Next If Hooking = False Then FHandle = Lwnd WndProc = SetWindowLong(Lwnd, GWL_WNDPROC, 0) Hooking = True End If End Sub ' Call this routine to transfer event notification back to standard handler ' Example - Unhook Public Sub Unhook() On Error Resume Next If Hooking = True Then SetWindowLong FHandle, GWL_WNDPROC, WndProc Hooking = False End If End Sub ' Detect a right click event on our system tray icon - pass control to a handler routine ' in the main form (change as required) Public Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long On Error Resume Next ' Ensure that its our app thats affected and that its the right event If Hooking = True Then If uMsg = WM_RBUTTONUP And lParam = WM_RBUTTONDOWN Then Call SysTrayMouseEventHandler ' Pass the event back to the form handler WindowProc = True ' Let windows know we handled it Exit Function End If WindowProc = CallWindowProc(WndProc, hw, uMsg, wParam, lParam) ' Pass it along End If End Function Public Sub CreateShortcut(ByVal datedir As String) On Error Resume Next Dim wscript Dim wshshell Dim strdesktop As String Dim oshelllink Set wshshell = CreateObject("WScript.Shell") strdesktop = wshshell.SpecialFolders("Desktop") Set oshelllink = wshshell.CreateShortcut(strdesktop & "\Printing Quotes.lnk") oshelllink.TargetPath = datedir oshelllink.WindowStyle = 1 ' oShellLink.Hotkey = "CTRL+SHIFT+F" '//REMOVED ON 23rd JUL 06 oshelllink.IconLocation = "notepad.exe, 0" oshelllink.Description = "Printed Quotes" oshelllink.WorkingDirectory = strdesktop oshelllink.Save End Sub
Code:
' Put above declarations part in a seperate Module '------------------------------------------------------------------------ '----------- private sub form_load() 'Just call command1_click to display systray icon call command1_click end sub '------------- private sub form_unload() 'Just call command2_click to remove systray icon '------------------------------------------------------------------- call command2_click end sub '---------------
Home
|
Forums
|
Submit
|
Books
|
Mailing List
|
Advertising
|
About
|
Contact
© 2024 A1VBCode. All rights reserved.
Legal disclaimer & terms of use
Privacy statement