Das deutsche QBasic- und FreeBASIC-Forum :: Thema anzeigen - CPU Last / Speicher auslesen unter dem Mauszeiger [Windows]

Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!

FAQ

Suchen

Mitgliederliste

Benutzergruppen

Registrieren

Profil

Einloggen, um private Nachrichten zu lesen

Zur Begleitseite des Forums / Chat / Impressum

Aktueller Forenpartner:

CPU Last / Speicher auslesen unter dem Mauszeiger [Windows]

Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Projektvorstellungen

Vorheriges Thema anzeigen :: Nächstes Thema anzeigen

Autor

Nachricht

UEZ

Anmeldungsdatum: 24.06.2016
Beiträge: 137
Wohnort: Opel Stadt

Verfasst am: 20.03.2025, 23:16 Titel: CPU Last / Speicher auslesen unter dem Mauszeiger [Windows]

Hier ein Tool zum Anzeigen der CPU Last / des Speicher (privat / working set) für sichtbare Applikationen unter dem Mauszeiger.

Code:

'Coded by UEZ build 2025-04-01 beta
'alt+c terminates the program

#cmdline "'Show CPU Usage under Cursor.rc'"
#include "crt.bi"
#include "windows.bi"
#include "win\commctrl.bi"
#include "win\psapi.bi"
#include "win\tlhelp32.bi"
#include "win\commctrl.bi"

Declare Function WndProc(hWnd As HWND, uMsg As UINT, wParam As WPARAM, lParam As LPARAM) As Integer
Declare Function _WinAPI_GetProcessName(iPid As DWORD) As String
Declare Function _WinAPI_GetNumberOfProcessors() As DWORD

Dim Shared As Long sw, sh
Dim As HWND hHWND_Dt
Dim Shared As RECT tDesktop

hHWND_Dt = FindWindow("Progman","Program Manager")
GetWindowRect(hHWND_Dt, @tDesktop)

sw = tDesktop.right + Abs(tDesktop.left)
sh = tDesktop.bottom + Abs(tDesktop.top)

Const w = 200, h = 47, w2 = w Shr 1, iBGColor = &h404040
Dim Shared As HWND g_hGUI, hLabel_CPU, hLabel_Mem, hLabel_ProcName, hLabel_PID, hLabel1, hLabel2, hLabel3, hLabel4
Dim Shared As DWORD iCPUs
Dim Shared As Double fTimer

Dim Shared As FILETIME ct, et, kt, ut
Dim Shared As DWORD ekt, eut

fTimer = Timer
iCPUs = _WinAPI_GetNumberOfProcessors()

Dim wc As WNDCLASSEX
Dim msg As MSG

With wc
.style = CS_HREDRAW Or CS_VREDRAW
.lpfnWndProc = @WndProc
.cbClsExtra = NULL
.cbWndExtra = NULL
.hInstance = GetModuleHandle(NULL)
.hIcon = LoadIcon(NULL, IDI_APPLICATION)
.hCursor = LoadCursor(NULL, IDC_ARROW)
.hbrBackground = Cast(HGDIOBJ, CreateSolidBrush(iBGColor))
.lpszMenuName = NULL
.lpszClassName = Cast(LPTSTR, StrPtr("FB GUI"))
.cbSize       = SizeOf(WNDCLASSEX)
End With

RegisterClassEx(@wc)

Dim As Point pt
GetCursorPos(@pt)

Dim As HFONT hFont = CreateFont(12, 0, 0, 0, 400, False, False, False, _
                     1, OUT_DEFAULT_PRECIS, _
                     CLIP_DEFAULT_PRECIS, _
                     PROOF_QUALITY, _
                     DEFAULT_PITCH, _
                     "New Times Roman")

g_hGUI = CreateWindowEx(WS_EX_TOPMOST Or WS_EX_COMPOSITED, wc.lpszClassName, "Show CPU Usage", _
               WS_POPUPWINDOW Or WS_VISIBLE, _
               pt.x, pt.y + 20, _
               w, h, _
               NULL, NULL, wc.hInstance, NULL)

Dim As UByte s1 = 70, s2 = w - s1, dy = 15
hLabel1 = CreateWindowEx(0, "Static", "CPU usage: ", WS_VISIBLE Or WS_CHILD, 2, 2, s1, 15, g_hGUI, NULL, NULL, NULL)
hLabel2 = CreateWindowEx(0, "Static", "Mem usage: ", WS_VISIBLE Or WS_CHILD, 2, 2 + dy, s1, 15, g_hGUI, NULL, NULL, NULL)
hLabel3 = CreateWindowEx(0, "Static", "Process name: ", WS_VISIBLE Or WS_CHILD, 2, 2 + 2 * dy, s1, 15, g_hGUI, NULL, NULL, NULL)
hLabel4 = CreateWindowEx(0, "Static", "PID: ", WS_VISIBLE Or WS_CHILD, s1 + 70, 2, 19, 15, g_hGUI, NULL, NULL, NULL)

hLabel_CPU = CreateWindowEx(0, "Static", "0%", WS_VISIBLE Or WS_CHILD, s1 + 5, 2, 40, 15, g_hGUI, NULL, NULL, NULL)
hLabel_PID = CreateWindowEx(0, "Static", "0", WS_VISIBLE Or WS_CHILD, s1 + 92, 2, 50, 15, g_hGUI, NULL, NULL, NULL)
hLabel_Mem = CreateWindowEx(0, "Static", "", WS_VISIBLE Or WS_CHILD, s1 + 5, 2 + dy, s2, 15, g_hGUI, NULL, NULL, NULL)
hLabel_ProcName = CreateWindowEx(0, "Static", "", WS_VISIBLE Or WS_CHILD, s1 + 5, 2 + 2 * dy, s2, 15, g_hGUI, NULL, NULL, NULL)

SendMessage(hLabel1, WM_SETFONT, Cast(WPARAM, hFont), Cast(LPARAM, True))
SendMessage(hLabel_CPU, WM_SETFONT, Cast(WPARAM, hFont), Cast(LPARAM, True))
SendMessage(hLabel2, WM_SETFONT, Cast(WPARAM, hFont), Cast(LPARAM, True))
SendMessage(hLabel_Mem, WM_SETFONT, Cast(WPARAM, hFont), Cast(LPARAM, True))
SendMessage(hLabel3, WM_SETFONT, Cast(WPARAM, hFont), Cast(LPARAM, True))
SendMessage(hLabel_ProcName, WM_SETFONT, Cast(WPARAM, hFont), Cast(LPARAM, True))
SendMessage(hLabel4, WM_SETFONT, Cast(WPARAM, hFont), Cast(LPARAM, True))
SendMessage(hLabel_PID, WM_SETFONT, Cast(WPARAM, hFont), Cast(LPARAM, True))

ShowWindow(g_hGUI, SW_SHOW)
UpdateWindow(g_hGUI)

Dim Shared As PROCESS_MEMORY_COUNTERS_EX tPMCex
tPMCex.cb = SizeOf(PROCESS_MEMORY_COUNTERS_EX)

RegisterHotKey(g_hGUI, 100, MOD_ALT, VK_C)

SetTimer(g_hGUI, 1, 50, NULL)

While GetMessage(@msg, 0, 0, 0)
TranslateMessage(@msg)
DispatchMessage(@msg)
Wend
UnregisterHotKey(g_hGUI, 100)
KillTimer(g_hGUI, 1)
DestroyWindow(g_hGUI)
DeleteObject(hFont)

Function WndProc(hWnd As HWND, uMsg As UINT, wParam As WPARAM, lParam As LPARAM) As Integer
Select Case uMsg
   Case WM_CLOSE
      PostQuitMessage(0)
      Return 0
   Case WM_HOTKEY
If wParam = 100 Then PostQuitMessage(0)
Return 0
   Case WM_TIMER
      Static As Long oldX, oldY
      Dim As Long newX, newY
      Dim As Point pt
      GetCursorPos(@pt)
      If pt.x <> oldX Or pt.y <> oldY Then
         pt.x = IIf(pt.x < tDesktop.left + w2, tDesktop.left + w2, pt.x)
         pt.x = IIf(pt.x > tDesktop.right - w2, tDesktop.right - w2, pt.x)
         pt.y = IIf(pt.y > tDesktop.bottom - h - 20, pt.y - 36 - h, pt.y)
         MoveWindow(hWnd, pt.x - w2, pt.y + 20, w, h, True)
         SetWindowPos(hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
         oldX = pt.x
         oldY = pt.y
      End If

      If Timer - fTimer > 0.99 Then
         Dim As Long iPID
         GetWindowThreadProcessId(WindowFromPoint(pt), @iPID)
         SetWindowText(hLabel_PID, Str(iPID))

         Dim As HANDLE hProcess = OpenProcess(PROCESS_VM_READ Or PROCESS_QUERY_LIMITED_INFORMATION, False, iPID) 'PROCESS_ALL_ACCESS
         GetProcessTimes(hProcess, @ct, @et, @kt, @ut)
         Dim As Double cpuUsage = min(100, max(0, (kt.dwLowDateTime - ekt + ut.dwLowDateTime - eut) / 100000 / iCPUs))
         Dim As ZString * 20 text
sprintf(text, "%.2f%%", cpuUsage)
         SetWindowText(hLabel_CPU, text)
         ekt = kt.dwLowDateTime
         eut = ut.dwLowDateTime

         GetProcessMemoryInfo(hProcess, Cast(PROCESS_MEMORY_COUNTERS Ptr, @tPMCex), SizeOf(tPMCex))
         SetWindowText(hLabel_Mem, Str(Int(tPMCex.PrivateUsage / 1024 ^ 2)) & " mb / " & Str(Int(tPMCex.WorkingSetSize / 1024 ^ 2)) & " mb")

         Dim As String sProcessname = _WinAPI_GetProcessName(iPID)
         If Len(sProcessname) > 24 Then sProcessname = Mid(sProcessname, 1, 21) & "..."
         SetWindowText(hLabel_ProcName, sProcessname)

         CloseHandle(hProcess)
         fTimer = Timer
      EndIf
      Return False
   Case WM_CTLCOLORSTATIC
         Dim As HDC hdcStatic = Cast(HDC, wParam)
         SetTextColor(hdcStatic, &hFFFFFF)
         SetBkColor(hdcStatic, iBGColor)
         Static As HBRUSH hbrBkgnd
         If hbrBkgnd = 0 Then hbrBkgnd = CreateSolidBrush(iBGColor)
         Return Cast(INT_PTR, hbrBkgnd)
   Case Else
      Return DefWindowProc(hWnd, uMsg, wParam, lParam)
End Select
End Function

Function _WinAPI_GetProcessName(iPid As DWORD) As String
Dim As HANDLE hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, iPid)
If hSnapshot = 0 Then Return ""
Dim As PROCESSENTRY32W tPROCESSENTRY32W
tPROCESSENTRY32W.dwSize = SizeOf(PROCESSENTRY32W)
Process32FirstW(hSnapshot, @tPROCESSENTRY32W)
While True
   If tPROCESSENTRY32W.th32ProcessID = iPid Then Exit While
   If Process32NextW(hSnapshot, @tPROCESSENTRY32W) = 0 Then Exit While
Wend
CloseHandle(hSnapshot)
Return tPROCESSENTRY32W.szExeFile
End Function

Function _WinAPI_GetNumberOfProcessors() As DWORD
Dim As SYSTEM_INFO si
GetSystemInfo(@si) 'https://docs.microsoft.com/en-us/windows/win32/api/processthreadsapi/nf-processthreadsapi-getprocesstimes
Return si.dwNumberOfProcessors
End Function

Download: Show CPU Usage under Cursor

Der Speicher wird nicht rekursiv ausgelesen. Alt+c beendet das Programm.

Ich kann diese Woche leider nicht auf Multi-Monitor Umgebung testen, ob die Anzeige richtig funktioniert. DPI Awareness ist auch nicht implementiert.

Kann sein, dass man die Exe mit Admin Rechten aufrufen muss.
_________________
Gruß,
UEZ

Zuletzt bearbeitet von UEZ am 01.04.2025, 19:38, insgesamt 2-mal bearbeitet

Nach oben

hhr

Anmeldungsdatum: 15.07.2020
Beiträge: 111

Verfasst am: 31.03.2025, 19:41 Titel:

Das Programm hat mir schon beim Optimieren geholfen. Ich halte es für sehr nützlich. Es lässt sich ohne Admin Rechte öffnen. Aber was bedeutet privat / working set?

Nach oben

UEZ

Anmeldungsdatum: 24.06.2016
Beiträge: 137
Wohnort: Opel Stadt

Verfasst am: 01.04.2025, 08:45 Titel:

hhr hat Folgendes geschrieben:

Das Programm hat mir schon beim Optimieren geholfen. Ich halte es für sehr nützlich.

Es lässt sich ohne Admin Rechte öffnen. Aber was bedeutet privat / working set?

Danke für dein Feedback.

Der Unterschied zwischen WorkingSetSize und PrivateUsage liegt in der Art des gemessenen Speichers:

1. WorkingSetSize (WS) – Physischer Speicherverbrauch

2. PrivateUsage – Privat reservierter Speicher

Ich habe den Code auf meinem 1Drv aktualisiert. Sollte jetzt auch auf Multi-Monitor Umgebung mit unterschiedlichen DPIs funktionieren. Im Manifest steht"permonitorv2". Falls das BS < Win10 ist, dann müsste dies entsprechenend angepasst werden.
_________________
Gruß,
UEZ

Nach oben

Beiträge der letzten Zeit anzeigen:

	Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Projektvorstellungen	Alle Zeiten sind GMT + 1 Stunde
Seite 1 von 1

Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.

Impressum :: Datenschutz