Vb 6 pallet Program

Like the example found on the internet, here is just a more specific point of writing the code in Form

'-----------------------------------------
'Code in the module is as follows:
'-----------------------------------------
Option Explicit

Public OldWindowProc As Long
Public TheForm As Form
Public TheMenu As Menu
'[VB Declaration]
'Destare 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

'[Description]
'The process of sending a message to a window using this function

'[Return value]
'Long, varies based on the sent message

'[Parameter table]
'Lpprevwndfunc ----- Long, the original window process address

'Hwnd ------------ Long, window handle

'Msg ------------ Long, sent message

'Wparam ----------- Long, message type. For details, refer to the wParam parameter table.

'Lparam ----------- Long, which varies with the wParam Parameter

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

'[VB Declaration]
'Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

'[Description]
'Set the information for the specified window in the window structure

'[Return value]
'Long, the previous value of the specified data

'[Parameter table]
'Hwnd ----------- Long, the handle of the window for which you want to obtain information

'Nindex --------- Long, please refer to the description of the nIndex parameter of the GetWindowLong Function

'Dwnewlong ------ Long, the new value of the window information specified by nIndex
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal HWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

'[VB Declaration]
'Destare Function shell_policyicon Lib "shell32.dll" Alias "shell_policyicona" (ByVal dwMessage As Long, lpData As same yicondata) As Long

'[Description]

'[Parameter table]
'Parameter dwMessage ---- set the message value. It can be the following common values: 0, 1, and 2.

'Nim _ ADD = 0 ADD the icon to the system status bar
'Nim _ MODIFY = 1. MODIFY the icon in the system status bar.
'Nim _ DELETE = 2 DELETE the icon in the system status bar

The 'lpdata-parameter is used to input the policyicondata data Data Structure Variable. We also need to define its structure in the "module" as follows:

'Type policyicondata
'Cbsize As Long 'must be filled with the length of the policyicondata data Data Structure
'Hwnd As Long is set As the window handle
'Uid As Long is the ID value set by the icon
'Uflags As Long is used to set the following three parameters: uCallbackMessage, hIcon, and szTip.
'Ucallbackmessage As Long message No.
'Hicon As Long 'icon displayed on the status bar
'Sztip As String * 64 prompt information
'End Type

'---- The uCallbackMessage, hIcon, and szTip parameters should also be declared as the following constants in the module:
'Public Const NIF_MESSAGE = 1
'Public Const NIF_ICON = 2
'Public Const NIF_TIP = 4

Declare Function shell_policyicon Lib "shell32.dll" Alias "shell_policyicona" (ByVal dwMessage As Long, lpData As policyicondata) As Long

Public Const WM_USER = & H400
Public Const WM_LBUTTONUP = & H202
Public Const WM_MBUTTONUP = & H208
Public Const WM_RBUTTONUP = & H205
Public Const TRAY_CALLBACK = (wm_user+ 1001 &)
Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)
Public Const NIF_ICON = & H2
Public Const NIF_TIP = & H4
Public Const NIM_ADD = & H0
Public Const NIF_MESSAGE = & H1
Public Const NIM_MODIFY = & H1
Public Const NIM_DELETE = & H2

'Record the Data Type of the data set Tray Icon policyicondata
Public type policyicondata
Cbsize as long
Hwnd as long
UID as long
Uflags as long
Ucallbackmessage as long
Hicon as long
Sztip as string * 64
End type

'Thedata variable record set Tray Icon data
Private thedata as policyicondata
'*************************************** ******
'New window procedure -- the address of the window function is changed using the setwindowlong function in the main program, and the message is switched to newwindowproc for processing.
'*************************************** ******
Public Function newwindowproc (byval hwnd as long, byval MSG as long, byval wparam as long, byval lparam as long) as long

'If the user clicks the icon in the tray, it determines whether the left button is clicked or right-click
If MSG = tray_callback then
'If you left click
If lparam = wm_lbuttonup then
'At this time, the form state is minimized.
If theform. windowstate = vbminimized then _
'Restore to the form state before Minimization
Theform. windowstate = theform. laststate
Theform. setfocus
Exit Function
End if
End if
'If you right-click
If lparam = wm_rbuttonup then
', Right-click the menu
Theform. popupmenu themenu
Exit Function
End if
End if

'If messages of other types are passed to the original default Window Function
Newwindowproc = callwindowproc (oldwindowproc, hwnd, MSG, wparam, lparam)
End Function
'*************************************** ******
'Add the icon of the main form (the form1.icon attribute can be changed) to the tray.
'*************************************** ******
Public sub addtotray (FRM as form, MNU as menu)

'Save the current form and menu Information
Set theform = FRM
Set themenu = MNU

'Gwl _ wndproc: Obtain the window function address of the window.
OldWindowProc = SetWindowLong (frm. HWnd, GWL_WNDPROC, AddressOf NewWindowProc)

'Knowledge bit by bit: HWnd attribute
'Return the form or control handle. Syntax: object. HWnd
'Note: in the Microsoft Windows operating environment, each form and control in the application is provided.
'Assign a handle (or hWnd) to identify them. The hWnd attribute is used for Windows API calls.

'Add the main form icon to the tray
With TheData
. Uid = 0' forgot? Refer to the previous content, Uid icon serial number, which is useful for animation icons.
. HWnd = frm. HWnd
. CbSize = Len (TheData)
. HIcon = frm. Icon. Handle
. UFlags = NIF_ICON 'indicates the icon to be set.
. UCallbackMessage = TRAY_CALLBACK
. UFlags =. UFlags Or NIF_MESSAGE 'indicates to set the icon Or return information to the main form. This sentence cannot be omitted.
. CbSize = Len (TheData) 'Why? When adding an icon, we need to make it return information
End With 'to the main form. Or means setting and returning messages at the same time.
Shell_policyicon NIM_ADD, TheData 'according to the previous definition of NIM_ADD, set to "add mode"
End Sub
'*************************************** ******
'Delete the icon in the system tray
'*************************************** ******
Public Sub RemoveFromTray ()
'Delete the icons in the tray
With TheData
. UFlags = 0
End
Shell_policyicon NIM_DELETE, TheData 'according to the previous definition of NIM_DELETE, set to "delete mode"

'Restore the original settings
SetWindowLong TheForm. HWnd, GWL_WNDPROC, OldWindowProc
End Sub
'*************************************** ******
'Add a floating prompt to the icon in the tray (that is, the prompt note that appears when the mouse moves up)
'*************************************** ******
Public Sub SetTrayTip (tip As String)
With TheData
. SzTip = tip & vbNullChar
. UFlags = NIF_TIP 'indicates that you want to set the floating prompt
End
Shell_policyicon NIM_MODIFY, TheData 'according to the previous definition of NIM_MODIFY, set to "Modify mode"
End Sub
'*************************************** ******
'Set the tray icon (not used in this example. It is very useful if you want to dynamically change the icon displayed in the tray)
'Example: 1. display the animation icon. (You must have guessed it! Use the timer control to continuously call this process. Place the animation in the PIC array)
'2. Different icons are displayed when the program is in different States. The method is similar.
'Try it if you are interested.
'*************************************** ******
Public sub settrayicon (PIC as picture)
'Determine if the image is saved as an icon
If pic. Type <> vbpictypeicon then exit sub

'Change the icon to the icon stored in the pic.
With thedata
. Hicon = pic. Handle
. Uflags = nif_icon
End
Shell_policyicon nim_modify, thedata
End sub

 

 

'---------------------------------------------
'Demonstration using the system tray Program
'---------------------------------------------
'Program description:
'This is a complete program instance that uses the system tray, including
Now: add the tray icon, delete the tray icon, and dynamically change the tray icon,
'Add floating prompt information for the tray icon, right-click the tray icon
'Menu and other content.
'------- Name ------------------- function ------------
'Form1 main form
'Mnutrayclose exit menu
'Mnutray, mnuTrayMaximize, mnuTrayMinimize, mnuTrayMove, mnuTrayRestore, mnuTraySize... right-click the tray area and choose menu items
'---------------------------------------------

Option Explicit

The 'laststate variable indicates the original status of the main form.
Public LastState As Integer

'[VB Declaration]
'Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

'[Description]
'Call the window function of a window and send a message to that window. This function will not return unless the message is processed. SendMessageBynum,
'Sendmessagebystring is the "type security" Declaration Form of the function.

'[Return value]
'Long, determined by the specific message

'[Parameter table]
'Hwnd ----------- Long, the handle of the window to receive the message

'Wmsg --------- Long, message identifier

'Wparam --------- Long, depending on the message

'Lparam --------- Any, depending on the message
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal HWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

'Indicates that the system command is sent.
Private Const WM_SYSCOMMAND = & H112
Private Const SC _MOVE = & HF010 &
Private Const SC _RESTORE = & HF120 &
Private Const SC _SIZE = & HF000 &

'When the main form is loaded
Private Sub Form_Load ()

'Windowstate attribute of the form. A value is returned or set to specify the visual status of the form window during runtime.
'Vbnormal 0 (default value) is normal.
'Vbminimized 1 is minimized as an icon)
'Vbmaximized 2 maximized (expanded to the maximum size)
If WindowState = vbMinimized Then
LastState = vbNormal
Else
LastState = WindowState
End If

'Add the icon to the pallet function. See the description in the module.
'Note that this is the entry from the main program to the module. In this example, the shell_policyicon function is not directly called.
AddToTray Me, mnuTray

SetTrayTip "tray icon demonstration, right-click the pop-up menu"
End Sub

Private Sub Form_Resize ()
Select Case WindowState

'If the form is minimized, set the menu item "maximize" and "Restore" to available,
And set "minimal", "move", and "size" to unavailable.
'If you right-click the tray icon, you will find that the unavailable items become gray.
Case vbMinimized
MnuTrayMaximize. Enabled = True
MnuTrayMinimize. Enabled = False
MnuTrayMove. Enabled = False
MnuTrayRestore. Enabled = True
MnuTraySize. Enabled = False

'Form Maximization
Case vbMaximized
MnuTrayMaximize. Enabled = False
MnuTrayMinimize. Enabled = True
MnuTrayMove. Enabled = False
MnuTrayRestore. Enabled = True
MnuTraySize. Enabled = False

'Normal status
Case vbNormal
MnuTrayMaximize. Enabled = True
MnuTrayMinimize. Enabled = True
MnuTrayMove. Enabled = True
MnuTrayRestore. Enabled = False
MnuTraySize. Enabled = True
End Select

If WindowState <> vbMinimized Then LastState = WindowState
End Sub

'Ensure that the tray icon is deleted when the program exits.
Private Sub Form_Unload (Cancel As Integer)
RemoveFromTray
End Sub

When the "exit" item in the "file" menu is clicked
Private Sub mnuFileExit_Click ()
Unload Me
End Sub

'When the "exit" item on the right-click menu of the tray icon is clicked
Private Sub mnuTrayClose_Click ()
Unload Me
End Sub

'When the maximize option on the right-click Tray Icon menu is clicked
Private Sub mnuTrayMaximize_Click ()
WindowState = vbMaximized
End Sub

'When the "minimize" item on the right-click Tray Icon menu is clicked
Private Sub mnuTrayMinimize_Click ()
WindowState = vbMinimized
End Sub

'When the "move" item on the right-click Tray Icon menu is clicked
Private Sub mnuTrayMove_Click ()
SendMessage HWnd, WM_SYSCOMMAND ,_
SC _MOVE, 0 &
End Sub

'When the "Restore" item on the right-click menu of the tray icon is clicked
Private Sub mnuTrayRestore_Click ()
SendMessage HWnd, WM_SYSCOMMAND ,_
SC _RESTORE, 0 &
End Sub

'When the "exit" item on the right-click menu of the tray icon is clicked
Private Sub mnuTraySize_Click ()
SendMessage HWnd, WM_SYSCOMMAND ,_
SC _SIZE, 0 &
End Sub