'Language: Micrisift Visual Basic 6.0' functions: add icons 'Author: Huang Xudong' to the system tray area Date: 2004-10-22 'Copyright: CopyRight 2001-2005 By Faib Studio' website: http: //faib.yeah.net 'Mail: FAIB920@163.com
Option expedition
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As BooleanPrivate 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 LongPrivate Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Declare Function SetForegroundWindow Lib "user32" ( BYVAL HWND AS Long) As long
Private Const GWL_WNDPROC = (-4) Private Const GWL_USERDATA = (-21) Private Const NIM_ADD = & H0Private Const NIM_MODIFY = & H1Private Const NIM_DELETE = & H2Private Const NIF_MESSAGE = & H1Private Const NIF_ICON = & H2Private Const NIF_TIP = & H4Private Const NIF_INFO = & H10Private Const NIIF_NONE = & H0Private Const Niif_Warning = & H2Private const niif_error = & h3private const niif_info = & h1
Private Type NOTIFYICONDATA cbSize As Long hWnd As Long uId As Long uFlags As Long uCallBackMessage As Long hIcon As Long szTip As String * 128 dwState As Long dwStateMask As Long szInfo As String * 256 uTimeoutOrVersion As Long szInfoTitle As String * 64 dwInfoFlags As LongEnd Type
Public Enum EnumTrayEvent fbmNone = & H0 fbmOnLButtonUp = & H1 fbmOnRButtonUp = & H2 fbmOnMButtonUp = & H4 fbmOnLButtonDown = & H8 fbmOnRButtonDown = & H10 fbmOnMButtonDown = & H20 fbmOnLButtonDbClick = & H40 fbmOnRButtonDbClick = & H80 fbmOnMButtonDbClick = & H100 fbmOnAllClickEvents = & H1FFEnd EnumPublic Enum EnumTrayMessage fbmMouseMove = & H200 fbmLButtonDown = & H201 fbmLButtonUp = & H202 fbmLButtonDbClick = & H203 fbmRButtonDown = & H204 fbmRButtonUp = & H205 fbmRButtonDbClick = & H206 fbmMButtonDown = & H207 fbmMButtonUp = & H208 fbmMButtonDbClick = & H209End EnumEnum EnumTitleIcon fbiNone = 0 fbiInfo = 1 fbiWarning = 2 fbiError = 3End EnumDim sIcon As StdPictureDim sVis As BooleanDim sForm As FormDim sMenu As MenuDim shWnd As LongDim sTip AS STRINGDIM SSTYLE AS ENUMTRAYEVENTDIM NTRAY AS Notifyicondatadim Prownd As Longdim MHOOK AS LONGDIM MVIS As Boolean
Public Property Let Hookaddress (Byval NewVal As Long) 'Hook Address MHOOK = NewValend Property
Public property get popupstyle () as enumtrayevent 'Back / Set PopupStyle = SStyleEnd Property
Public Property Let PopupStyle (NewVal As EnumtrayEvent) SStyle = NewValend Property
Public property get icon () AS stdpicture 'icon set icon = SICONEND Property
Public property set icon (NewVal As stdpicture) if sicon is nothing the set sicon = newval else if not newval is SiCon the set sicon = newval end if if not svis thris thris, if no display is displayed, otherwise modify the icon modify "icon "End PropertyPublic Property Get TRAYFORM () AS Form 'Main Factive Set TrayForm = Sformend Property
Public Property Set TrayForm (NewVal As Form) if SForm Is Nothing the set sform = newval else if not newval is sform the set sform = newval end ifend print
Public property get popupmenu () AS menu 'pop-up menu set popupmenu = SMENUEND Property
Public Property Set Popupmenu (NewVal As Menu) If Smenu Is Nothing The Set Sthu = NewVal Else If Not Smenu Is Smenu THENU = NewVal End IFEnd Property
Public property get tiptext () AS String 'prompt information Tiptext = stipend property
Public Property Let TipText (NewVal AS String) stip = newval if not svis thris thris thruse If no display is displayed, otherwise modify the prompt information Modify "TIP" End Property
Public property get visible () as boolean 'Shows Visible = SVISEND Property
Public Property Let Visible (newval as boolean) if newval = svis thris, if the setting is the same, exit Svis = NewVal if NewVal Then Show else HideEnd Property
Public Sub Show () 'show If mVis Then Exit Sub With nTray .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE .cbSize = Len (nTray) .hWnd = sForm.hWnd .uId = vbNull .uCallBackMessage = fbmMouseMove .hIcon = sIcon.Handle. szTip = sTip & vbNullChar End With Shell_NotifyIcon NIM_ADD, nTray proWnd = SetWindowLong (sForm.hWnd, GWL_WNDPROC, AddressOf Wndproc) mVis = True: sVis = TrueEnd SubPublic Sub Hide () 'removing If Not mVis Then Exit Sub SetWindowLong sForm.hWnd, GWL_WNDPROC, ProWnd Shell_notifyicon Nim_Delete, Ntray MVIS = FALSE: SVIS = Falseend Sub
Public Sub ShowMessage (Title As String, Message As String, Optional TitleIcon As EnumTitleIcon = 0, Optional TimeOut As Long = 500) If Not sVis Then Exit Sub With nTray .uFlags = NIF_INFO Or NIF_MESSAGE .dwInfoFlags = NIIF_INFO .dwState = 0 .hIcon = Titleicon .dwStatemask = 0 .szinfo = message & vbnullchar .utimeoutorversion = timeout .szinfotitle = Title & vbnullchar End with shell_notifyicon nim_modify, NTRAYEND SUB
Private Function Wndproc (ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long On Error Resume Next If Msg = fbmMouseMove Then Select Case lParam Case & H2 Call Hide: Set sForm = Nothing: Set sIcon = Nothing Case fbmLButtonDbClick If mHook <> 0 Then Wndproc = CallWindowProc (mHook, hWnd, lParam, wParam, lParam) If sStyle <> fbmNone Then If CBool (sStyle And fbmOnLButtonDbClick) Then Popup Case fbmLButtonDown If mHook <> 0 Then Wndproc = CallWindowProc (mHook, hWnd, lParam, wParam, lParam) If sStyle <> fbmNone Then If CBool (sStyle And fbmOnLButtonDown) Then Popup Case fbmLButtonUp If mHook <> 0 Then Wndproc = CallWindowProc (mHook, hWnd, lParam, wParam, lParam) If sStyle <> fbmnone damnup (sStyle and fbmonlButton) THEN POP CASE FBMMBUTTONDBCLICK IF MHOOK <> 0 THEN WNDPROC = CallWindowProc (MHOOK, HWND, LPARAM, WP aram, lParam) If sStyle <> fbmNone Then If CBool (sStyle And fbmOnMButtonDbClick) Then Popup Case fbmMButtonDown If mHook <> 0 Then Wndproc = CallWindowProc (mHook, hWnd, lParam, wParam, lParam) If sStyle <> fbmNone Then If CBool ( sStyle And fbmOnMButtonDown) Then Popup Case fbmMButtonUp If mHook <> 0 Then Wndproc = CallWindowProc (mHook, hWnd, lParam, wParam, lParam) If sStyle <> fbmNone Then If CBool (sStyle And fbmOnMButtonUp) Then Popup Case fbmRButtonDbClick If mHook <> 0 Then wndproc =
CallWindowProc (mHook, hWnd, lParam, wParam, lParam) If sStyle <> fbmNone Then If CBool (sStyle And fbmOnRButtonDbClick) Then Popup Case fbmRButtonDown If mHook <> 0 Then Wndproc = CallWindowProc (mHook, hWnd, lParam, wParam, lParam) If sStyle <> fbmNone Then If CBool (sStyle And fbmOnRButtonDown) Then Popup Case fbmRButtonUp If mHook <> 0 Then Wndproc = CallWindowProc (mHook, hWnd, lParam, wParam, lParam) If sStyle <> fbmNone Then If CBool (sStyle And fbmOnRButtonUp) Then popup Case fbmMouseMove If mHook <> 0 Then Wndproc = CallWindowProc (mHook, hWnd, lParam, wParam, lParam) End Select End If Wndproc = CallWindowProc (proWnd, hWnd, Msg, wParam, lParam) End FunctionPrivate Sub Modify (s As String) WITH NTRAY SELECT CASE S CASE "icon" .hicon = sicon.handle .uflags = nif_icon case "tip" .uflags = nif_tip .sztip = stip & vbnullchar End select end with shell_notifyicon nim_modify, NTRAYEND SUB
Private sub popup () pop-up menu setForeGroup SFORM.HWND SFORM.POPUPMENU SMENUEND SUB
