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

[jfzlnyf]

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

[lingll]

很简单,在运行时动态改变图标就行了,
图标不固定定?那也很简单,在内存中自己创建一个图标,想画什么就画什么

[留下些什么]

类：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 = 0

Private 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 = &H2

Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean

Enum NIMAction
[NIM_ADD] = 0 '添加
[NIM_MODIFY] = 1 '修改
[NIM_DELETE] = 2 '删除

End Enum

Private 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 Property

Public Property Let Icon(ByVal vData As Long)
'设置压入托盘的图标
On Error Resume Next
mvarPicture = vData
ni.hIcon = mvarPicture

End Property

Public Property Let hwnd(ByVal vData As Long)

On Error Resume Next
mvarHwnd = vData
ni.hwnd = mvarHwnd

End Property

Sub 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 Sub

Private 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 Sub

Private Sub Form_Unload(Cancel As Integer)
ni.Delete
End Sub

Private 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

[lingll]

大概说一下做法,首先使用的是纯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就可以输出图标了,

[lingll]

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

[jfzlnyf]

楼上的我运行了怎么没有效果？还有我要显示剩余内存可能有很多数字啊，怎么办呢？

[jfzlnyf]

我的是VB6，XP sp2

[jfzlnyf]

很简单,在运行时动态改变图标就行了,
图标不固定定?那也很简单,在内存中自己创建一个图标,想画什么就画什么


怎么动态创建？

[jfzlnyf2]

我又弄了，有效果了。
可是我要显示的1-1000数字怎么办？我总不能准备1000张图标吧