vb6下制作托盘程序

原创 2006年06月06日 17:44:00

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退出

Delphi7高级应用开发随书源码

  • 2003年04月30日 00:00
  • 676KB
  • 下载

VB 将程序图标添加到托盘

  • 2010年06月07日 15:37
  • 38KB
  • 下载

利用c#制作托盘程序,并禁止多个应用实例运行

托盘程序的制作: 1.把NotifyIcon控件拉一个到窗体上,并设置NotifyIcon的Icon(很重要!否则运行后看不到效果) 2.窗体关闭时,将程序最小化到系统托盘上 //开...

VB实现托盘程序

  • 2013年06月08日 15:57
  • 9KB
  • 下载

VB2010托盘程序

  • 2013年05月03日 15:07
  • 1.9MB
  • 下载

MFC 为程序制作一个系统托盘图标、显示隐藏任务栏图标

以MFC对话框程序为例,为此对话框程序制作一个系统托盘图标。     1、 首先定义一个 NOTIFYICONDATA 类型的类成员变量 m_NotifyIcon;     2、  在BOOL C...

vb net托盘程序

  • 2013年05月10日 11:28
  • 192KB
  • 下载

VC编程制作系统托盘程序

Windows操作系统中的某些程序运行时不显示运行窗口,只在任务栏上显示一个图标,表示程序正在运行,用户可以通过鼠标与应用程序交互,比如金山毒霸等应用程序,我们有时也需要编制一些仅在后台运行的类似程序...
  • Becomly
  • Becomly
  • 2011年02月21日 09:32
  • 479

VB托盘程序,包含多种方法

  • 2008年12月19日 23:13
  • 25KB
  • 下载
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:vb6下制作托盘程序
举报原因:
原因补充:

(最多只允许输入30个字)