将程序图标加到任务栏中的程序代码!

本文提供了使用VBA在任务栏创建和管理托盘图标的示例代码,包括添加、删除图标,设置提示文字,以及响应图标点击事件。通过这些代码,可以实现窗体最小化到任务栏托盘区并处理用户交互。

一个模块:

Option Explicit

Public OldWindowProc As Long
Public TheForm As Form
Public TheMenu As Menu

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
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

'判断窗口是否最小化
Declare Function IsIconic Lib "user32" (ByVal hwnd As Long) As Long

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

'记录 设置托盘图标的数据 的数据类型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 * 64
End Type

'TheData变量记录设置托盘图标的数据
Private TheData As NOTIFYICONDATA

' *********************************************
' 新的窗口过程--主程序中采用SetWindowLong函数改变了窗口函数的地址,消息转向由NewWindowProc处理
' *********************************************
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
            '而这时窗体的状态是最小化时
            If TheForm.WindowState = vbMinimized Then
                '恢复到最小化前的窗体状态
                TheForm.WindowState = TheForm.LastState
                TheForm.Show
                TheForm.MinFlag = False
                RemoveFromTray
                Exit Function
            End If
        End If
        '如果点击了右键
        If lParam = WM_RBUTTONUP Then
            '则弹出右键菜单
            TheForm.PopupMenu TheMenu
            Exit Function
        End If
    End If
   
    '如果是其他类型的消息则传递给原有默认的窗口函数
    NewWindowProc = CallWindowProc(OldWindowProc, hwnd, Msg, wParam, lParam)
End Function

' *********************************************
' 把主窗体的图标(Form1.icon属性可改变)添加到托盘中
' *********************************************
Public Sub AddToTray(frm As Form, mnu As Menu)

    '保存当前窗体和菜单信息
    Set TheForm = frm
    Set TheMenu = mnu
   
    'GWL_WNDPROC获得该窗口的窗口函数的地址
    OldWindowProc = SetWindowLong(frm.hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
   
    '知识点滴:HWnd属性
    '返回窗体或控件的句柄。语法: object.HWnd
    '说明:Microsoft Windows 运行环境,通过给应用程序中的每个窗体和控件
    '分配一个句柄(或 hWnd)来标识它们。hWnd 属性用于Windows API调用。

    '将主窗体图标添加在托盘中
    With TheData
        .Uid = 0    '忘了吗?参考一下前面内容,Uid图标的序号,做动画图标有用
        .hwnd = frm.hwnd
        .cbSize = Len(TheData)
        .HIcon = frm.Icon.Handle
        .UFlags = NIF_ICON                  '指明要对图标进行设置
        .UCallbackMessage = TRAY_CALLBACK
        .UFlags = .UFlags Or NIF_MESSAGE    '指明要设置图标或返回信息给主窗体,此句不能省去
        .cbSize = Len(TheData)              '为什么呢?我们需要在添加图标的同时,让其返回信息
    End With                                '给主窗体,Or的意思是同时进行设置和返回消息
    Shell_NotifyIcon NIM_ADD, TheData       '根据前面定义NIM_ADD,设置为“添加模式”
End Sub

' *********************************************
' 删除系统托盘中的图标
' *********************************************
Public Sub RemoveFromTray()
    '删除托盘中的图标
    With TheData
        .UFlags = 0
    End With
    Shell_NotifyIcon NIM_DELETE, TheData   '根据前面定义NIM_DELETE,设置为“删除模式”
   
    '恢复原有的设置
    SetWindowLong TheForm.hwnd, GWL_WNDPROC, OldWindowProc
End Sub

' *********************************************
' 为托盘中的图标加上浮动提示(也就是鼠标移上去时出现的提示字条)
' *********************************************
Public Sub SetTrayTip(tip As String)
    With TheData
        .SzTip = tip & vbNullChar
        .UFlags = NIF_TIP   '指明要对浮动提示进行设置
    End With
    Shell_NotifyIcon NIM_MODIFY, TheData    '根据前面定义NIM_MODIFY,设置为“修改模式”
End Sub

' *********************************************
' 设置托盘的图标(在本例中没有用到,如果要动态改变托盘内显示的图标,它非常有用)
' 例如:1、显示动画图标(方法你一定猜到了,对!使用Timer控件,不断调用此过程,注意把动画放在pic数组中)
'       2、程序处于不同状态时,显示不同的图标,方法是类似的
' 有兴趣的话试一试吧。
' *********************************************
Public Sub SetTrayIcon(pic As Picture)
    '判断一下pic中存放的是不是图标
    If pic.Type <> vbPicTypeIcon Then Exit Sub

    '更换图标为pic中存放的图标
    With TheData
        .HIcon = pic.Handle
        .UFlags = NIF_ICON
    End With
    Shell_NotifyIcon NIM_MODIFY, TheData
End Sub

 

一个窗体:

'标示主窗体原有状态
Public LastState As Integer
'标识窗口是否已经按过最小化按纽
Public MinFlag As Boolean

 

Private Sub MDIForm_Load()
    MinFlag = False
    IIf WindowState = vbMinimized, LastState = vbNormal, LastState = WindowState
End Sub

 

Private Sub MDIForm_Resize()
    '判断窗口是否最小化状态,并且是按最小化按纽后第一次发生Resize事件
    If IsIconic(Me.hwnd) <> 0 And MinFlag = False Then
        MinFlag = True
        Me.Visible = False '隐藏主窗口
        '将窗口图标加入通知栏
        AddToTray Me, m_PopM
        SetTrayTip Me.Caption
    End If
    If WindowState <> vbMinimized Then LastState = WindowState
End Sub

Private Sub m_PopM_Exit_Click(Index As Integer)
    RemoveFromTray '删除通知栏图标
    End '退出程序
End Sub

Private Sub m_PopM_Show_Click(Index As Integer)
    RemoveFromTray '删除通知栏图标
    Me.WindowState = Me.LastState
    Me.Show '调出窗口
    MinFlag = False
End Sub

评论
成就一亿技术人!
拼手气红包6.0元
还能输入1000个字符
 
红包 添加红包
表情包 插入表情
 条评论被折叠 查看
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值