在系统栏显示CPU使用率

来源：互联网发布：淘宝查关键词排名工具编辑：程序博客网时间：2024/05/20 08:27

这是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