|
Form code '*************************************** **********************************
'** Module name: frmtest
'** Note: yfsoft copyright: 2004-2005 (c)
'** Creator: ye fan
'** Date: 09:08:28
'** Modifier:
'** Date:
'** Description: tray balloon prompt
'** Version: v1.0.0
'*************************************** **********************************
Option explicit '*************************************** **********************************
'** Function name: cmddel_click
'** Input: None
'** Output: None
'** Function Description: delete an icon.
'** Global variables:
'** Call module:
'** OPERATOR: ye fan
'** Date: 09:34:58
'** Modifier:
'** Date:
'** Version: v1.0.0
'*************************************** **********************************
Private sub role del_click ()
Delpolicyicon me
End sub '*************************************** **********************************
'** Function name: cmdshow_click
'** Input: None
'** Output: None
'** Function Description: displays a prompt.
'** Global variables:
'** Call module:
'** OPERATOR: ye fan
'** Date: 09:34:44
'** Modifier:
'** Date:
'** Version: v1.0.0
'*************************************** **********************************
Private sub cmdshow_click ()
Showpolicyicon me, txttitle, txtinfo, cmbtype. listindex
End sub '*************************************** **********************************
'** Function name: form_load
'** Input: None
'** Output: None
'** Function description:
'** Global variables:
'** Call module: initialization
'** OPERATOR: ye fan
'** Date: 09:08:57
'** Modifier:
'** Date:
'** Version: v1.0.0
'*************************************** **********************************
Private sub form_load ()
Cmbtype. listindex = 1' information icon
Cmdshow_click' display information
End sub
'*************************************** **********************************
'** Function name: form_unload
'** Input: Cancel (integer )-
'** Output: None
'** Function Description: End
'** Global variables:
'** Call module:
'** OPERATOR: ye fan
'** Date: 09:35:32
'** Modifier:
'** Date:
'** Version: v1.0.0
'*************************************** **********************************
Private sub form_unload (cancel as integer)
'Delete the icon
Cmddel_click
'Unmount all forms
Dim frm as form
For each frm in Forms
Unload FRM
Next
End sub --------------------------------------------------------------------------------
'Module code '*************************************** **********************************
'** Module name: mdlpolicybase
'** Note: yfsoft copyright: 2004-2005 (c)
'** Creator: ye fan
'** Date: 09:17:46
'** Modifier:
'** Date:
'** Description: display the tray prompt Module
'** Version: v1.0.0
'*************************************** **********************************
Option explicit
Private declare function setwindowlong lib "user32.dll" alias "setwindowlonga" (byval hwnd as long, byval nindex as long, byval dwnewlong as long) as long
Private declare function callwindowproc lib "user32.dll" alias "callwindowproca" (byval lpprevwndfunc as long, byval hwnd as long, byval MSG as long, byval wparam as long, byval lparam as long) as long
Private const wm_rbuttonup = & h205
Private const wm_user = & H400
Private const wm_policyicon = wm_user + 1' custom message
Private const wm_lbuttondblclk = & h203
Private const gwl_wndproc = (-4)
'Custom messages about balloon prompts are not generated under 2000.
Private const nin_balloonshow = (wm_user + & H2) 'Run when the balloon tips pop-up
Private const nin_balloonhide = (wm_user + & H3) 'is executed when the balloon tips disappears (for example, the categorrayicon is deleted ),
'However, this message is not sent if the specified Timeout time is reached or the message disappears after you click balloon tips.
Private const nin_balloontimeout = (wm_user + & h4) 'is executed when the balloon tips timeout time is reached
Private const nin_balloonuserclick = (wm_user + & H5) 'run when you click balloon tips.
'Note: There is a close button on balloon tips when executing in XP,
'If you click the button to receive the nin_balloontimeout message. Private declare function shell_policyicon lib "shell32.dll" alias "shell_policyicona" (byval dwmessage as long, lpdata as policyicondata) as long
Private type policyicondata
Cbsize as long 'structure size (in bytes)
Hwnd as long 'handle of the Message Processing window
UID as long 'Unique Identifier
Uflags as long 'flags
Ucallbackmessage as long 'refers to the messages received in the message processing window.
Hicon as long 'tray icon handle
Sztip as string * 128 'tooltip prompt text
Dwstate as long 'tray icon status
Dwstatemask as long' status mask
Szinfo as string * 256 'balloon prompt text
Utimeoutorversion as long 'balloon prompts the disappearance time or version
'Utimeout-time when the balloon prompts to disappear (unit: MS, 10000 -- 30000)
'Uversion-version (0 for V4, 3 for V5)
Szinfotitle as string * 64 'balloon title
Dwinfoflags as long' balloon prompt icon
End type
'Dwstate to policyicondata Structure
Private const nis_hidden = & H1 'hide the icon
Private const nis_1_dicon = & H2 'share icon
'Dwinfoflags to notifiicondata Structure
Private const niif_none = & h0' no icon
Private const niif_info = & H1 '"message" icon
Private const niif_warning = & H2 '"warning" icon
Private const niif_error = & H3 '"error" icon
'Uflags to policyicondata Structure
Private const nif_icon as long = & H2
Private const nif_info as long = & H10
Private const nif_message as long = & H1
Private const nif_state as long = & H8
Private const nif_tip as long = & h4
'Dwmessage to shell_policyicon
Private const nim_add as long = & H0
Private const nim_delete as long = & H2
Private const nim_modify as long = & H1
Private const nim_setfocus as long = & h3
Private const lngnim_setversion as long = & h4
Private lngprewndproc as long '*************************************** **********************************
'** Function name: showpolicyicon
'** Input: FRM (form)-Form
'**: Strtitle (string)-tray title prompt
'**: Strinfo (string)-tray prompt information
'**: Optional lngtype (long = 1)-tray prompt Type 0 none 1 Info 2 warning 3 error
'**: Optional lngtime (long = 10000)-stay time
'** Output: None
'** Function Description: displays the tray icon prompt information.
'** Global variables:
'** Call module:
'** OPERATOR: ye fan
'** Date: 09:23:14
'** Modifier:
'** Date:
'** Version: v1.0.0
'*************************************** **********************************
Public sub showpolicyicon (FRM as form, strtitle as string, strinfo as string, optional lngtype as long = 1, optional lngtime as long = 10000)
'Add an icon to the tray Area
Dim icondata as policyicondata
Strtitle = strtitle & vbnullchar
Strinfo = strinfo & vbnullchar
With icondata
. Cbsize = Len (icondata)
. Hwnd = FRM. hwnd
. Uid = 0
. Uflags = nif_tip or nif_icon or nif_message or nif_info or nif_state
. Ucallbackmessage = wm_policyicon
. Sztip = strtitle
. Hicon = FRM. Icon. Handle
. Dwstate = 0
. Dwstatemask = 0
. Szinfo = strinfo
. Szinfotitle = strtitle
. Dwinfoflags = lngtype
. Utimeoutorversion = lngtime
End
If lngprewndproc = 0 then 'is not initialized
Shell_policyicon nim_add, icondata
Lngprewndproc = setwindowlong (FRM. hwnd, gwl_wndproc, addressof windowproc)
Else' initialized
Shell_policyicon nim_modify, icondata
End if
End sub '*************************************** **********************************
'** Function name: delpolicyicon
'** Input: FRM (form)-Form
'** Output: None
'** Function Description: Delete the tray icon
'** Global variables:
'** Call module:
'** OPERATOR: ye fan
'** Date: 09:33:01
'** Modifier:
'** Date:
'** Version: v1.0.0
'*************************************** **********************************
Public sub delpolicyicon (FRM as form)
If lngprewndproc <> 0 then
'Delete the tray area icon
Dim icondata as policyicondata
With icondata
. Cbsize = Len (icondata)
. Hwnd = FRM. hwnd
. Uid = 0
. Uflags = nif_tip or nif_icon or nif_message
. Ucallbackmessage = wm_policyicon
. Sztip = ""
. Hicon = FRM. Icon. Handle
End
Shell_policyicon nim_delete, icondata
Setwindowlong frm. hwnd, gwl_wndproc, lngprewndproc
Lngprewndproc = 0
End if
End sub
'*************************************** **********************************
'** Function name: windowproc
'** Input: byval hwnd (long )-
'**: Byval MSG (long )-
'**: Byval wparam (long )-
'**: Byval lparam (long )-
'** Output: (long )-
'** Function Description: frmtest window entry function
'** Global variables:
'** Call module:
'** OPERATOR: ye fan
'** Date: 09:19:06
'** Modifier:
'** Date:
'** Version: v1.0.0
'*************************************** **********************************
Function windowproc (byval hwnd as long, byval MSG as long, byval wparam as long, byval lparam as long) as long
'Intercept wm_policyicon message
If MSG = wm_policyicon then
Select case lparam
Case wm_rbuttonup
'Right-click the icon to run the code here. You can add the code that pops up the right-click menu here.
Case wm_lbuttondblclk
'Left-click display form
Frmtest. Show
Case nin_balloonshow
Debug. Print "display balloon prompt"
Case nin_balloonhide
Debug. Print "delete tray icon"
Case nin_balloontimeout
Debug. Print "balloon prompts disappear"
Case nin_balloonuserclick
Debug. Print "click the balloon prompt"
End select
End if
Windowproc = callwindowproc (lngprewndproc, hwnd, MSG, wparam, lparam)
End Function |
