系统托盘.bas

VB6.0图书管理 使用ACEESE数据库

Attribute VB_Name = "Moduletray"
'*****************系统托盘********************


Option Explicit

Public thefrm As Form
Public themnu As Menu
Public oldwindowproc 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 Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIM_DELETE = &H2
Public Const NIM_MODIFY = &H1
Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)
Public Const WM_LBUTTONUP = &H202
Public Const WM_MBUTTONUP = &H208
Public Const WM_RBUTTONUP = &H205
Public Const WM_USER = &H400
Public Const TRAY_CALLBACK = (WM_USER + 1001&)

 
   
'其中各参数的意义如下表:

'参数:  意义
'dwMessage 为消息设置值，它可以是以下的几个常数值：0、1、2
'NIM_ADD = 0　 加入图标到系统状态栏中
'NIM_MODIFY = 1  修改系统状态栏中的图标
'NIM_DELETE = 2  删除系统状态栏中的图标

    'LpData 用以传入NOTIFYICONDATA数据结构变量，其结构如下所示：

Type NOTIFYICONDATA

    cbSize As Long               '需填入NOTIFYICONDATA数据结构的长度
    HWnd As Long                 '设置成窗口的句柄
    Uid As Long                  '为图标所设置的ID值
    UFlags As Long               '设置uCallbackMessage,hIcon,szTip是否有效
    UCallbackMessage As Long     '消息编号
    HIcon As Long                '显示在状态栏上的图标
    SzTip As String * 64         '提示信息
End Type
Private theData As NOTIFYICONDATA
    '返回值 Long，非零表示成功，零表示失败
    
:

      Public Function NewWindowProc(ByVal HWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
      '如果用户点击了托盘中的图标，则进行判断是点击了左键还是右键
      If Msg = TRAY_CALLBACK Then
          '如果点击了左键
          If lParam = WM_LBUTTONUP Then
                '恢复到最小化前的窗体状态
                thefrm.WindowState = 0
                thefrm.Show
                delicon
                Exit Function
          End If
          '如果点击了右键
          If lParam = WM_RBUTTONUP Then
              '则弹出右键菜单
              thefrm.PopupMenu themnu
              Exit Function
          End If
      End If
      '如果是其他类型的消息则传递给原有默认的窗口函数
      NewWindowProc = CallWindowProc(oldwindowproc, HWnd, Msg, wParam, lParam)
      End Function
   
    
    
    
    
    '*********************************************]
'添加图标
Sub addicon(frm As Form, mnu As Menu)
Set thefrm = frm
Set themnu = mnu

oldwindowproc = SetWindowLong(frm.HWnd, GWL_WNDPROC, AddressOf NewWindowProc)
  
With theData
        .Uid = 0
        .HWnd = frm.HWnd              'frm.HWnd是程序主窗体的句柄
        .cbSize = Len(theData)
        .HIcon = frm.Icon.Handle    'frm.Icon.Handle指向主窗体的图标
        .UFlags = NIF_ICON
        .UCallbackMessage = TRAY_CALLBACK
         '作用是允许返回消息
        .UFlags = .UFlags Or NIF_MESSAGE
        .cbSize = Len(theData)
      End With
      Shell_NotifyIcon NIM_ADD, theData
      thefrm.Visible = False
    '根据前面定义NIM_ADD，设置为“添加模式”，然后添加
End Sub
  
'删除图标
Sub delicon()
With theData
        .UFlags = 0
End With
Shell_NotifyIcon NIM_DELETE, theData
'根据前面定义NIM_DELETE，设置为“删除模式”

SetWindowLong thefrm.HWnd, GWL_WNDPROC, oldwindowproc
End Sub
'更改图标
 Sub changeicon(pic As Picture)
 With theData
    .HIcon = pic.Handle
    'pic是图片PictureBox，存放图标文件
    .UFlags = NIF_ICON
End With
Shell_NotifyIcon NIM_MODIFY, theData
'根据前面定义NIM_MODIFY，设置为“更改模式”
 End Sub
'图标提示
Sub iconshow(tip As String)
With theData
        .SzTip = tip & vbNullChar
           'tip是字符串string，存储提示信息
        .UFlags = NIF_TIP
        '指明要对浮动提示进行设置
End With
Shell_NotifyIcon NIM_MODIFY, theData
'根据前面定义NIM_MODIFY，设置为“修改模式”
End Sub