vb6下制作托盘程序

最新推荐文章于 2024-05-06 07:12:42 发布

笨笨兔兔兔兔兔

最新推荐文章于 2024-05-06 07:12:42 发布

阅读量3.4k

点赞数

分类专栏： Visual Basic 文章标签： vb function shell integer delete string

本文链接：https://blog.csdn.net/liuxiaoyi666/article/details/776400

版权

Visual Basic 专栏收录该内容

3 篇文章 0 订阅

订阅专栏

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 WM_MOUSEMOVE = &H200

Public Const trayLBUTTONDOWN = 7695
Public Const trayLBUTTONUP = 7710
Public Const trayLBUTTONDBLCLK = 7725

Public Const trayRBUTTONDOWN = 7740
Public Const trayRBUTTONUP = 7755
Public Const trayRBUTTONDBLCLK = 7770

Public Const trayMOUSEMOVE = 7680

Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_LBUTTONDBLCLK = &H203

Public rc As Long

Type NOTIFYICONDATA
    cbSize As Long
    hwnd As Long
    uID As Long
    uFlags As Long
    uCallbackMessage As Long
    hIcon As Long
    szTip As String * 64
End Type

Dim trayStructure As NOTIFYICONDATA

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

Public Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long

Public Declare Function GetTickCount Lib "kernel32" () As Long

Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" _
(ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

Public Sub Pause(lngInterval As Long)
   Dim lngEnd As Long, lngNow As Long, count1 As Long
   count1 = GetTickCount()
   lngEnd = count1 + (lngInterval * 1000)
   Do
     DoEvents
     lngNow = GetTickCount()
   Loop Until lngNow >= lngEnd
End Sub

Public Function AddIcon(pic As PictureBox, tip$)
   trayStructure.szTip = tip$ & Chr$(0)
   trayStructure.uFlags = NIF_MESSAGE + NIF_ICON + NIF_TIP
   trayStructure.uID = 100
   trayStructure.cbSize = Len(trayStructure)

   trayStructure.hwnd = pic.hwnd
   trayStructure.uCallbackMessage = WM_MOUSEMOVE
   trayStructure.hIcon = pic.Picture
   rc = Shell_NotifyIcon(NIM_ADD, trayStructure)
End Function

Public Function ChangeIcon(pic As PictureBox, tip$)
   trayStructure.szTip = tip$ & Chr$(0)
   trayStructure.uFlag = NIF_ICON + NIF_TIP
   trayStructure.hIcon = pic.Picture
   Shell_NotifyIcon NIM_MODIFY, trayStructure
End Function

Public Function DeleteIcon(pic As Control)
   trayStructure.uID = 100
   trayStructure.cbSize = Len(trayStructure)
   trayStructure.hwnd = pic.hwnd
   trayStructure.uCallbackMessage = WM_MOUSEMOVE
   rc = Shell_NotifyIcon(NIM_DELETE, trayStructure)
End Function

Public Sub NewTip(pic As Control, tip$)
    trayStructure.uFlag = NIF_TIP
    trayStructure.uID = 100
    trayStructure.cbSize = Len(trayStructure)
    trayStructure.hwnd = pic.hwnd
    trayStructure.uCallbackMessage = WM_MOUSEMOVE
    trayStructure.szTip = tip$ & Chr$(0)
    rc = Shell_NotifyIcon(NIM_MODIFY, trayStructure)
End Sub

需要说明的是Shell_NotifyIcon这个api，微软自带的api浏览器下写的是错的

Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias _
" Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
" Shell_NotifyIconA" 多加了一个空格

调用的时候

Private Sub Form_Load()
AddIcon Picture1, "hello world..."
Me.Hide
App.TaskVisible = False
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Hex(X) = "1E3C" Then
Me.PopupMenu file
End If
End Sub

file是菜单，这个很简单自己随便写一个就成了，别忘了写个end退出