这是NotifyIcon类,动态显示在系统栏的图标.
- Private mNotifyIcon As NOTIFYICONDATA
- Private mIcons(12) As Long
- Private Sub Class_Initialize()
- Dim IconInf As ICONINFO
- Dim hOldBitmap As Long
- Dim hOldBrush As Long
- Dim hOldPen As Long
- Dim hBitmap As Long
- Dim hDC As Long
- Dim iw As Long
- Dim ih As Long
- Dim i As Long
- Dim t As Long
- '获取小图标的尺寸
- iw = GetSystemMetrics(SM_CXSMICON)
- ih = GetSystemMetrics(SM_CYSMICON)
- '创建后台DC
- hDC = CreateCompatibleDC(0&)
- hBitmap = CreateCompatibleBitmap(dc, iw, ih)
- hOldBitmap = SelectObject(hDC, hBitmap)
- '设置画笔与刷子
- hOldBrush = SelectObject(hDC, GetStockObject(DC_BRUSH))
- hOldPen = SelectObject(hDC, GetStockObject(DC_PEN))
- '用系统颜色清除Bitmap
- SetDCBrushColor hDC, GetSysColor(COLOR_BTNFACE)
- SetDCPenColor hDC, GetSysColor(COLOR_BTNFACE)
- Rectangle hDC, 0, 0, iw, ih
- '开始绘背景图
- SetDCBrushColor hDC, RGB(55, 55, 55)
- SetDCPenColor hDC, RGB(55, 55, 55)
- Rectangle hDC, 2, 2, iw - 3, ih - 3
- '顶
- SetDCPenColor hDC, GetSysColor(COLOR_BTNSHADOW)
- Rectangle hDC, 1, 1, iw - 2, 2
- Rectangle hDC, 1, 1, 2, ih - 2
- SetDCPenColor hDC, GetSysColor(COLOR_BTNHIGHLIGHT)
- Rectangle hDC, iw - 2, 1, iw - 3, ih - 2
- Rectangle hDC, 2, ih - 2, iw - 2, ih - 3
- '将位图中部分区域转换为ICON对象
- SetDCBrushColor hDC, RGB(255, 0, 0)
- SetDCPenColor hDC, RGB(255, 0, 0)
- For i = 0 To UBound(mIcons)
- '开始画图标
- t = ih - 3 - i * ((ih - 5) / 10)
- If t < 2 Then t = 2
- Rectangle hDC, 2, t, iw - 3, ih - 3
- '转换成HICON对象
- With IconInf
- .fIcon = True
- .xHotspot = 0
- .yHotspot = 0
- .hbmColor = hBitmap
- .hbmMask = hBitmap
- End With
- '储存HICON到数组
- mIcons(i) = CreateIconIndirect(IconInf)
- Next
- '恢复DC对象,释放资源
- SelectObject hDC, hOldBitmap
- SelectObject hDC, hOldBrush
- SelectObject hDC, hOldPen
- DeleteObject hBitmap
- DeleteDC hDC
- End Sub
- Public Function RegisterNotifyIcon(ByVal hWnd As Long) As Long
- '初始化NotifyIcon;
- With mNotifyIcon
- .uID = 0
- .hWnd = hWnd
- .hIcon = mIcons(0)
- .cbSize = Len(mNotifyIcon)
- .szTip = "CPU使用率:0%" & Chr(0)
- .uCallbackMessage = RegisterWindowMessage( "WM_TRAYCALLBACK" )
- .uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
- End With
- If Shell_NotifyIcon(NIM_ADD, mNotifyIcon) = 0 Then Exit Function
- RegisterNotifyIcon = mNotifyIcon.uCallbackMessage
- End Function
- Public Sub Modfiy(ByVal szTipText As String, ByVal hTaskBarIcon As Long)
- mNotifyIcon.szTip = szTipText & Chr(0)
- mNotifyIcon.hIcon = hTaskBarIcon
- Shell_NotifyIcon NIM_MODIFY, mNotifyIcon
- End Sub
- Public Sub Remove()
- Shell_NotifyIcon NIM_DELETE, mNotifyIcon
- End Sub
- Public Sub Restore()
- Remove
- Shell_NotifyIcon NIM_ADD, mNotifyIcon
- End Sub
- Public Sub ChangeData(ByVal cpu As Long)
- If cpu < 10 Then
- Modfiy "CPU使用率:" & cpu & "%", mIcons(0)
- Exit Sub
- End If
- If cpu < 95 Then
- Modfiy "CPU使用率:" & cpu & "%", mIcons(cpu / 10)
- Exit Sub
- End If
- If cpu < 100 Then
- Modfiy "CPU使用率:" & cpu & "%", mIcons(11)
- Exit Sub
- End If
- Modfiy "CPU使用率:" & cpu & "%", mIcons(12)
- End Sub
- Private Sub Class_Terminate()
- Dim i As Integer
- Remove
- For i = 0 To UBound(mIcons)
- DestroyIcon mIcons(i)
- Next
- End Sub
这个是获取CPU使用率的类:
- Option Explicit
- Private liOldIdleTime As LARGE_INTEGER
- Private liOldSystemTime As LARGE_INTEGER
- Private Sub Class_Initialize()
- Dim SysPerfInfo As SYSTEM_INF_PREF
- Dim SysTimeInfo As SYSTEM_INF_TIME
- GetSysPerfTime SysPerfInfo, SysTimeInfo
- LSet liOldIdleTime = SysPerfInfo.liIdleTime
- LSet liOldSystemTime = SysTimeInfo.liKeSystemTime
- End Sub
- Public Function GetCPUUsage() As Long
- Dim SysBaseInfo As SYSTEM_INF_BASIC
- Dim SysPerfInfo As SYSTEM_INF_PREF
- Dim SysTimeInfo As SYSTEM_INF_TIME
- Dim dbIdleTime As Double
- Dim dbSystemTime As Double
- If NtQuerySystemInformation(SI_BASIC, ByVal VarPtr(SysBaseInfo), Len(SysBaseInfo), 0&) <> NO_ERROR Then Exit Function
- GetSysPerfTime SysPerfInfo, SysTimeInfo
- If liOldIdleTime.HighPart <> 0# Or liOldIdleTime.LowPart <> 0# Then
- dbIdleTime = ULL2Dbl(SysPerfInfo.liIdleTime) - ULL2Dbl(liOldIdleTime)
- dbSystemTime = ULL2Dbl(SysTimeInfo.liKeSystemTime) - ULL2Dbl(liOldSystemTime)
- If dbSystemTime > 0# Then
- dbIdleTime = dbIdleTime / dbSystemTime
- dbIdleTime = 100# - dbIdleTime * 100# / CDbl(SysBaseInfo.bKeNumberProcessors) + 0.5
- End If
- End If
- LSet liOldIdleTime = SysPerfInfo.liIdleTime
- LSet liOldSystemTime = SysTimeInfo.liKeSystemTime
- GetCPUUsage = dbIdleTime
- If GetCPUUsage > 100 Then GetCPUUsage = 100
- End Function
- Private Sub GetSysPerfTime(ByRef sp_inf As SYSTEM_INF_PREF, ByRef st_inf As SYSTEM_INF_TIME)
- If NtQuerySystemInformation(SI_PERF, ByVal VarPtr(sp_inf), LenB(sp_inf), 0&) <> NO_ERROR Then Exit Sub
- If NtQuerySystemInformation(SI_TIME, ByVal VarPtr(st_inf), LenB(st_inf), 0&) <> NO_ERROR Then Exit Sub
- End Sub
用到的函数与类型声明:
- Public Type LARGE_INTEGER
- LowPart As Long
- HighPart As Long
- End Type
- Public Type SYSTEM_INF_PREF
- liIdleTime As LARGE_INTEGER
- dwSpare(76) As Long
- End Type
- Public Type SYSTEM_INF_TIME
- liKeBootTime As LARGE_INTEGER
- liKeSystemTime As LARGE_INTEGER
- liExpTimeZoneBias As LARGE_INTEGER
- uCurrentTimeZoneId As Long
- dwReserved As Long
- End Type
- Public Declare Function NtQuerySystemInformation Lib "Ntdll.dll" ( _
- ByVal SystemInfClass As Long, _
- ByVal SystemInfoAddr As Long, _
- ByVal cbLength As Long, _
- Optional rltLenth As Long) As Long
- Public Declare Function FileTimeToSystemTime Lib "kernel32" ( _
- lpFileTime As FILETIME, _
- lpSystemTime As SYSTEMTIME) As Long
- Public Declare Function GetLastError Lib "kernel32" () As Long
- Public Declare Function GetProcessIoCounters Lib "kernel32" ( _
- ByVal hProcess As Long, _
- lpIoCounters As PIO_COUNTERS) As Long
- Public Declare Function CreateCompatibleBitmap Lib "gdi32" ( _
- ByVal hDC As Long, _
- ByVal nWidth As Long, _
- ByVal nHeight As Long) As Long
- Public Declare Function CreateCompatibleDC Lib "gdi32" ( _
- ByVal hDC As Long) As Long
- Public Declare Function SelectObject Lib "gdi32" ( _
- ByVal hDC As Long, _
- ByVal hObject As Long) As Long
- Public Declare Function DeleteObject Lib "gdi32" ( _
- ByVal hObject As Long) As Long
- Public Declare Function ReleaseDC Lib "user32" ( _
- ByVal hWnd As Long, _
- ByVal hDC As Long) As Long
- Public Declare Function DeleteDC Lib "gdi32" ( _
- ByVal hDC As Long) As Long
- Public Declare Function BitBlt Lib "gdi32" ( _
- ByVal hDestDC As Long, _
- ByVal X As Long, _
- ByVal Y As Long, _
- ByVal nWidth As Long, _
- ByVal nHeight As Long, _
- ByVal hSrcDC As Long, _
- ByVal xSrc As Long, _
- ByVal ySrc As Long, _
- ByVal dwRop As Long) As Long
- Public Declare Function CreateIcon Lib "user32" ( _
- ByVal hInstance As Long, _
- ByVal nWidth As Long, _
- ByVal nHeight As Long, _
- ByVal nPlanes As Byte, _
- ByVal nBitsPixel As Byte, _
- lpANDbits As Byte, _
- lpXORbits As Byte) As Long
- Public Declare Function CreateIconIndirect Lib "user32" ( _
- piconinfo As ICONINFO) As Long
- Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" ( _
- ByVal hDC As Long, _
- ByVal X As Long, _
- ByVal Y As Long, _
- ByVal lpString As String, _
- ByVal nCount As Long) As Long
- Public Declare Function SetBkMode Lib "gdi32" ( _
- ByVal hDC As Long, _
- ByVal nBkMode As Long) As Long
- Public Declare Function SetTextColor Lib "gdi32" ( _
- ByVal hDC As Long, _
- ByVal crColor As Long) As Long
- Public Declare Function DestroyIcon Lib "user32" ( _
- ByVal hIcon As Long) As Long
- Public Declare Function SetBkColor Lib "gdi32" ( _
- ByVal hDC As Long, _
- ByVal crColor As Long) As Long
- Public Declare Function SetDCBrushColor Lib "gdi32" ( _
- ByVal hDC As Long, _
- ByVal crColor As Long) As Long
- Public Declare Function SetDCPenColor Lib "gdi32" ( _
- ByVal hDC As Long, _
- ByVal crColor As Long) As Long
- Public Declare Function ExtFloodFill Lib "gdi32" ( _
- ByVal hDC As Long, _
- ByVal X As Long, _
- ByVal Y As Long, _
- ByVal crColor As Long, _
- ByVal wFillType As Long) As Long
- Public Declare Function Rectangle Lib "gdi32" ( _
- ByVal hDC As Long, _
- ByVal X1 As Long, _
- ByVal Y1 As Long, _
- ByVal X2 As Long, _
- ByVal Y2 As Long) As Long
- Public Declare Function GetStockObject Lib "gdi32" ( _
- ByVal nIndex As Long) As Long
- Public Declare Function GetSysColorBrush Lib "user32" ( _
- ByVal nIndex As Long) As Long
- Public Declare Function GetSysColor Lib "user32" ( _
- ByVal nIndex As Long) As Long
- Public Declare Function CreatePen Lib "gdi32" ( _
- ByVal nPenStyle As Long, _
- ByVal nWidth As Long, _
- ByVal crColor As Long) As Long
- Public Declare Function GetSystemMetrics Lib "user32" ( _
- ByVal nIndex As Long) As Long