vb 托盘

vb 托盘

Option   Explicit

Public   Const  MAX_TOOLTIP  As   Integer   =   64
Public   Const  NIF_ICON  =   & H2
Public   Const  NIF_MESSAGE  =   & H1
Public   Const  NIF_TIP  =   & H4
Public   Const  NIM_ADD  =   & H0
Public   Const  NIM_MODIFY  =   & H1
Public   Const  NIM_DELETE  =   & H2
Public   Const  WM_MOUSEMOVE  =   & H200
Public   Const  WM_LBUTTONDOWN  =   & H201
Public   Const  WM_LBUTTONUP  =   & H202
Public   Const  WM_LBUTTONDBLCLK  =   & H203
Public   Const  WM_RBUTTONDOWN  =   & H204
Public   Const  WM_RBUTTONUP  =   & H205
Public   Const  WM_RBUTTONDBLCLK  =   & H206

Public   Const  SW_RESTORE  =   9
Public   Const  SW_HIDE  =   0

Public  nfIconData  As  NOTIFYICONDATA


Public  Type NOTIFYICONDATA
cbSize  As   Long
hWnd  As   Long
uID  As   Long
uFlags  As   Long
uCallbackMessage  As   Long
hIcon  As   Long
szTip  As   String   *  MAX_TOOLTIP
End  Type

Public  Declare  Function  ShowWindow Lib  " user32 "  (ByVal hWnd  As   Long , ByVal nCmdShow  As   Long )  As   Long
Public  Declare  Function  Shell_NotifyIcon Lib  " shell32.dll "  Alias  " Shell_NotifyIconA "  (ByVal dwMessage  As   Long , lpData  As  NOTIFYICONDATA)  As   Long

Private   Sub  Form_Load()
     If  App.PrevInstance  Then
          End   '  退出新运行的程序
     End   If
    Me.Caption  =   " 我的第一个程序 "
    
' 以下把程序放入System Tray====================================System Tray Begin
With  nfIconData
.hWnd  =  Me.hWnd
.uID  =  Me.Icon
.uFlags  =  NIF_ICON  Or  NIF_MESSAGE  Or  NIF_TIP
.uCallbackMessage  =  WM_MOUSEMOVE
.hIcon  =  Me.Icon.Handle
' 定义鼠标移动到托盘上时显示的Tip
.szTip  =  App.Title  +   " (版本  "   &  App.Major  &   " . "   &  App.Minor  &   " . "   &  App.Revision  &   " ) "   &  vbNullChar
.cbSize  =   Len (nfIconData)
End   With
Call  Shell_NotifyIcon(NIM_ADD, nfIconData)
' =============================================================System Tray End
Me.Show
End Sub

Private   Sub  Form_MouseMove(Button  As   Integer , Shift  As   Integer , X  As   Single , Y  As   Single )
Dim  lMsg  As   Single
lMsg  =  X  /  Screen.TwipsPerPixelX
Select   Case  lMsg
Case  WM_LBUTTONUP
' MsgBox "请用鼠标右键点击图标!", vbInformation, "实时播音专家"
' 单击左键，显示窗体
Timer1.Enabled  =   False
Call  ShowWindow(Me.hWnd, SW_RESTORE)

' 下面两句的目的是把窗口显示在窗口最顶层
Me.Show
Me.SetFocus
' ' Case WM_RBUTTONUP
' '   PopupMenu MenuTray '如果是在系统Tray图标上点右键，则弹出菜单MenuTray
' ' Case WM_MOUSEMOVE
' ' Case WM_LBUTTONDOWN
' ' Case WM_LBUTTONDBLCLK
' ' Case WM_RBUTTONDOWN
' ' Case WM_RBUTTONDBLCLK
' ' Case Else
End   Select
End Sub

Private   Sub  Form_QueryUnload(Cancel  As   Integer , UnloadMode  As   Integer )
     Call  Shell_NotifyIcon(NIM_DELETE, nfIconData)
End Sub

Private   Sub  Form_Resize()
     If  Me.WindowState  =   1   Then
        Me.Hide
     End   If
End Sub

Private   Sub  leftBtn_Click()
    Static b1  As   Boolean       ' 定义一个布尔型变量用于开关作用
    b1  =   Not  b1
    Timer1.Enabled  =  b1      ' 用Timer1来控制图标的闪烁
     If   Not  b1  Then
        leftBtn.Caption  =   " 开始 "
     Else
        leftBtn.Caption  =   " 停止 "
     End   If
End Sub

Private   Sub  rightBtn_Click()
    infoLabel.Caption  =   " 右边按钮 "
End Sub

Private   Sub  Timer1_Timer()
  Static b2  As   Boolean     '  定义一个布尔型变量用于开关作用，当为True时托盘图标为Picture2图片，为False时为Picture1的图片
  b2  =   Not  b2
   If  b2  Then
        nfIconData.hIcon  =  Image1.Picture      ' 托盘图标为Picture2的图片
         infoLabel.Caption  =   " b "
   Else
        nfIconData.hIcon  =  Image2.Picture        ' 托盘图标为Picture1的图片
        infoLabel.Caption  =   " a "
   End   If
    Call  Shell_NotifyIcon(NIM_MODIFY, nfIconData)      ' 修改托盘图标


End Sub