有没有办法让程序在系统托盘右下角的图标显示动态的数字，就像一些内存整理软件一样？

Question

有没有办法让程序在系统托盘右下角的图标显示动态的数字，就像一些内存整理软件一样？ 
找到的托盘控件都只是一个图标而已
又没有能让程序在托盘里显示自己定义的数字一类的
很多内存整理的软件显示内存时都是这样，XP的任务管理器也是，怎么弄得呢？

Answer 1

类：clsNotifyIcon
Private Type NOTIFYICONDATA
    cbSize As Long
    hwnd As Long
    uId As Long
    uFlags As Long
    uCallBackMessage As Long
    hIcon As Long
    szTip As String * 128
    dwState As Long
    dwStateMask As Long
    szInfo As String * 256
    uTimeoutOrVersion As Long   '由于VB中没有Union类型，只能用Long型代替
    szInfoTitle As String * 64
    dwInfoFlags As Long
End Type
Private Const NOTIFYICON_VERSION = 3
Private Const NOTIFYICON_OLDVERSION = 0Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const NIF_STATE = &H8
Private Const NIF_INFO = &H10
 
Private Const NIS_HIDDEN = &H1
Private Const NIS_SHAREDICON = &H2Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As BooleanEnum NIMAction
    [NIM_ADD] = 0 '添加
    [NIM_MODIFY] = 1 '修改
    [NIM_DELETE] = 2 '删除End EnumPrivate ni As NOTIFYICONDATA
'保持属性值的局部变量
Private mvarHwnd As Long '局部复制
Private mvarPicture As Long '局部复制
Private mvarTip As String '局部复制Public Property Let Tip(ByVal vData As String)
    '设置鼠标在图标上移动时的提示内容
    On Error Resume Next
    mvarTip = vData
    ni.szTip = mvarTip & Chr(0)End PropertyPublic Property Let Icon(ByVal vData As Long)
    '设置压入托盘的图标
    On Error Resume Next
    mvarPicture = vData
    ni.hIcon = mvarPictureEnd PropertyPublic Property Let hwnd(ByVal vData As Long)    On Error Resume Next
    mvarHwnd = vData
    ni.hwnd = mvarHwndEnd PropertySub Add()
    NotifyIcon NIM_ADD
End Sub
Sub Modify()
    NotifyIcon NIM_MODIFY
End Sub
Sub Delete()
    NotifyIcon NIM_DELETE
End Sub
Sub NotifyIcon(ByVal action As NIMAction)
    On Error Resume Next    If ni.hwnd = 0 Then
        MsgBox "请设置对象的hwnd属性！", vbCritical, "提示"
        Exit Sub
    End If
    Shell_NotifyIcon action, ni
End Sub
Private Sub Class_Initialize()
    On Error Resume Next
    With ni
        .cbSize = Len(ni)
        .uId = 1&
        .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
        .uCallBackMessage = WM_MOUSEMOVE
        .dwState = 1
        .dwStateMask = 0
        .uTimeoutOrVersion = 10000
        .dwInfoFlags = 1
    End With    
End SubPrivate Sub Class_Terminate()
    On Error Resume Next
    'Me.Delete
End Sub窗体：
Dim ni As New clsNotifyIcon
Private Sub Form_Load()
    With ni
        .hwnd = Me.hwnd
        .Icon = Me.Image1(0).Picture
        .Tip = "多个图标示例"
        .Add
    End With
    Me.Timer1.Interval = 500
End SubPrivate Sub Form_Unload(Cancel As Integer)
    ni.Delete
End SubPrivate Sub Timer1_Timer()
    Static num As Integer
    ni.Icon = Me.Image1(num)
    ni.Modify
    num = num + 1
    If num = 3 Then num = 0
End Sub

Answer 2

大概说一下做法,首先使用的是纯api的方法
先用CreateCompatibleBitmap在内存中创建一个bitmap,同时用CreateCompatibleDC创建一个dc,然后用SelectObject将bitmap选进那个dc里面,
这个时候就可以用bitblt,drawtext等函数往里面画东西了,接下来,要创建icon了,为了方便,这里借助Imagelist来创建icon,用ImageList_Create创建一个imagelist,然后用ImageList_AddMasked将刚才创建的图片添加到Imagelist里面,接着就可以用ImageList_ExtractIcon输出icon了,记得完成后,该释放的内存都要释放调,
很复杂,是吧?下面说一下不使用api的方法,第一步,搞一个picturebox,autoredraw=true,然后将其设为图标大小,如16x16象素,然后往上面画东西就是了,写字的话用print方法,
第二步,添加ImageList control,然后将picturebox.image添加进去,然后用ListImage.ExtractIcon就可以输出图标了,

Answer 3

我倾向于用api的方法,不需要用到控件,使用起来更灵活