Option Explicit Private Const LP－HT－CAPTION = 2 Private Const WM－NCLBUTTONDOWN = ＆HA1 Private Declare Function ReleaseCapture Lib “user32" () As Long Private Declare Function SendMessage Lib “user32" Alias“SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private CPU As New CPUUsage Private Avg As Long Private Sum As Long Private Index As Long Private Sub Form_Load() Me.Caption = App.Title ‘初始化应用程序标题栏 CPU.InitCPUUsage End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) ‘程序结束前关闭定时器和释放内存 Timer.Enabled = False Set CPU = Nothing Cancel = 0 End Sub Private Sub Frame1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) ‘用左键可以拖动程序 Call Form_MouseDown(Button, Shift, X, Y) End Sub Private Sub pctPrg_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) ‘右键单击退出程序 If Button = 2 Then Unload Me End End If Call Form_MouseDown(Button, Shift, X, Y) End Sub Private Sub Timer_Timer() ‘利用定时器周期性的读取资源状况 Dim tmp As Long tmp = CPU.GetCPUUsage Me.Caption = App.Title ＆ FormatPercent(tmp / 100) ‘ ‘在标题栏用百分比数字形式反映占用率 Sum = Sum ＋ tmp Index = Index ＋ 1 Avg = Int(Sum / Index) pctPrg.Cls pctPrg.Line (0, 0)－(tmp, 18), , BF pctPrg.Line (Avg, 0)－(Avg, 18), ＆HFF pctPrg.Line (Avg ＋ 1, 0)－(Avg ＋ 1, 18), ＆HFF ‘用图式形式反映占用率 End Sub Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) ‘使程序可以被拖动 Dim rc As Long rc = ReleaseCapture rc = SendMessage(hwnd, WM－NCLBUTTONDOWN, LP_HT－CAPTION, ByVal 0＆) End Sub （2）编写读取注册表中CPU使用状况的类模块； 添加一个类模块，命名为“CPUusage”，写入以下代码： Option Explicit Private Declare Function RegQueryValueEx Lib “advapi32.dll" Alias “RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long Private Declare Function RegOpenKey Lib“advapi32.dll" Alias “RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Private Declare Function RegCloseKey Lib“advapi32.dll" (ByVal hKey As Long) As Long Private Const REG_DWORD = 4 Private Const HKEY_DYN_DATA = ＆H80000006 Public Sub InitCPUUsage() Dim Data As Long, Typ As Long, Size As Long Dim hKey As Long, hRet As Long hRet = RegOpenKey(HKEY－DYN－DATA, “PerfStats\StartStat", hKey) hRet = Reg QueryValueEx(hKey, “KERNEL\CPUUsage", 0, REG－DWORD, Data, 4) hRet = RegCloseKey(hKey) End Sub Public Function GetCPUUsage() As Long On Error GoTo eee ‘如果注册表错误的话转到eee： Dim Data As Long, Typ As Long, Size As Long Dim hKey As Long Dim hRet As Long hRet = RegOpenKey(HKEY－DYN－DATA,“PerfStats\StatData", hKey) ‘打开主键 hRet = RegQueryValueEx(hKey, “KERNEL\CPUUsage", 0＆, REG_DWORD, Data, 4) ‘读取参数 GetCPUUsage = Data hRet = RegCloseKey(hKey) Exit Function eee:
没有相关教程
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
