Das deutsche QBasic- und FreeBASIC-Forum :: Thema anzeigen - CPU- & RAM-Nutzung unter dem Mauszeiger v0.9 b 20260715

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- & RAM-Nutzung unter dem Mauszeiger v0.9 b 20260715

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: 148
Wohnort: Opel Stadt

Verfasst am: 20.03.2025, 23:16 Titel: CPU- & RAM-Nutzung unter dem Mauszeiger v0.9 b 20260715

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

Code:

'Coded by UEZ v0.9.0 build 2026-07-15 beta
'Alt+b or tray icon menu (right click -> Exit) terminates the program

#cmdline "-s gui -gen gcc -Wc -Os 'Show CPU Usage under Cursor.rc'"

#define UNICODE 'needed for unicode source code handling
#define _WIN32_WINNT &h0602 'needed for QueryFullProcessImageName + PROCESS_QUERY_LIMITED_INFORMATION

#include "crt.bi"
#include "windows.bi"
#include "win\commctrl.bi"
#include "win\psapi.bi"
#include "win\shellapi.bi"

Const WM_TRAYICON = WM_USER + 1
Const IDM_EXIT = 1000
#ifndef WM_DPICHANGED
Const WM_DPICHANGED = &h02E0
#endif

Declare Function WndProc(hWnd As HWND, uMsg As UINT, wParam As WPARAM, lParam As LPARAM) As LRESULT
Declare Function _WinAPI_GetProcessName(hProcess As HANDLE) As String
Declare Function _WinAPI_GetNumberOfProcessors() As DWORD
Declare Function FT2ULL(ft As FILETIME) As ULongInt
Declare Function _WinAPI_GetDpiForWindow(hWnd As HWND) As Long
Declare Sub ApplyDpi(iDpi As Long)

'base metrics @ 96 dpi
Const iBGColor = &h302020, BASE_W = 200, BASE_H = 47, BASE_DY = 15, BASE_S1 = 70, BASE_FONT = 12

Dim Shared As Long w, h, w2, g_iDpi = 96
Dim Shared As Long oldX = -99999, oldY = -99999 'forces initial reposition
Dim Shared As HWND g_hGUI, hLabel_CPU, hLabel_Mem, hLabel_ProcName, hLabel_PID, hLabel1, hLabel2, hLabel3, hLabel4
Dim Shared As HFONT hFont
Dim Shared As DWORD iCPUs
Dim Shared As Double fTimer

Dim Shared As FILETIME ct, et, kt, ut

fTimer = Timer
iCPUs = _WinAPI_GetNumberOfProcessors()

Dim wc As WNDCLASSEX
Dim msg As MSG

'icon from resource (ID 100), fallback to default app icon
Dim Shared As HICON g_hIcon
g_hIcon = LoadIcon(GetModuleHandle(NULL), WStr("FB_PROGRAM_ICON"))
If g_hIcon = NULL Then g_hIcon = LoadIcon(NULL, IDI_APPLICATION)

'small variant in proper tray size
Dim Shared As HICON g_hIconSm
g_hIconSm = Cast(HICON, LoadImage(GetModuleHandle(NULL), WStr("FB_PROGRAM_ICON"), IMAGE_ICON, GetSystemMetrics(SM_CXSMICON), GetSystemMetrics(SM_CYSMICON), LR_DEFAULTCOLOR))
If g_hIconSm = NULL Then g_hIconSm = g_hIcon

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

RegisterClassEx(@wc)

Dim As Point pt
GetCursorPos(@pt)

g_hGUI = CreateWindowEx(WS_EX_TOPMOST Or WS_EX_COMPOSITED Or WS_EX_TOOLWINDOW Or WS_EX_NOACTIVATE Or WS_EX_LAYERED, _
               wc.lpszClassName, "Show CPU Usage", _
               WS_POPUPWINDOW Or WS_VISIBLE, _
               pt.x, pt.y + 20, _
               BASE_W, BASE_H, _
               NULL, NULL, wc.hInstance, NULL)

SetLayeredWindowAttributes(g_hGUI, 0, 230, LWA_ALPHA) 'slight transparency

hLabel1 = CreateWindowEx(0, "Static", "CPU usage: ", WS_VISIBLE Or WS_CHILD, 0, 0, 0, 0, g_hGUI, NULL, NULL, NULL)
hLabel2 = CreateWindowEx(0, "Static", "Mem usage: ", WS_VISIBLE Or WS_CHILD, 0, 0, 0, 0, g_hGUI, NULL, NULL, NULL)
hLabel3 = CreateWindowEx(0, "Static", "Process name: ", WS_VISIBLE Or WS_CHILD, 0, 0, 0, 0, g_hGUI, NULL, NULL, NULL)
hLabel4 = CreateWindowEx(0, "Static", "PID: ", WS_VISIBLE Or WS_CHILD, 0, 0, 0, 0, g_hGUI, NULL, NULL, NULL)

hLabel_CPU = CreateWindowEx(0, "Static", "0%", WS_VISIBLE Or WS_CHILD, 0, 0, 0, 0, g_hGUI, NULL, NULL, NULL)
hLabel_PID = CreateWindowEx(0, "Static", "0", WS_VISIBLE Or WS_CHILD, 0, 0, 0, 0, g_hGUI, NULL, NULL, NULL)
hLabel_Mem = CreateWindowEx(0, "Static", "", WS_VISIBLE Or WS_CHILD, 0, 0, 0, 0, g_hGUI, NULL, NULL, NULL)
hLabel_ProcName = CreateWindowEx(0, "Static", "", WS_VISIBLE Or WS_CHILD, 0, 0, 0, 0, g_hGUI, NULL, NULL, NULL)

ApplyDpi(_WinAPI_GetDpiForWindow(g_hGUI)) 'scale window, labels and font to current monitor dpi

ShowWindow(g_hGUI, SW_SHOWNOACTIVATE)
UpdateWindow(g_hGUI)

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

'tray icon with exit menu
Dim Shared As NOTIFYICONDATA tNID
With tNID
.cbSize = SizeOf(NOTIFYICONDATA)
.hwnd = g_hGUI
.uID = 1
.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
.uCallbackMessage = WM_TRAYICON
.hIcon = g_hIconSm
.szTip = "Show CPU Usage under Cursor"
End With
Shell_NotifyIcon(NIM_ADD, @tNID)

SetTimer(g_hGUI, 1, 50, NULL)

While GetMessage(@msg, 0, 0, 0)
TranslateMessage(@msg)
DispatchMessage(@msg)
Wend
Shell_NotifyIcon(NIM_DELETE, @tNID)
KillTimer(g_hGUI, 1)
DestroyWindow(g_hGUI)
DeleteObject(hFont)

Function WndProc(hWnd As HWND, uMsg As UINT, wParam As WPARAM, lParam As LPARAM) As LRESULT
Select Case uMsg
   Case WM_CLOSE
      PostQuitMessage(0)
      Return 0
   Case WM_TRAYICON
      If lParam = WM_RBUTTONUP Then
         Dim As Point ptMenu
         GetCursorPos(@ptMenu)
         Dim As HMENU hMenu = CreatePopupMenu()
         AppendMenu(hMenu, MF_STRING, IDM_EXIT, "Exit")
         SetForegroundWindow(hWnd) 'needed so the menu closes properly
         If TrackPopupMenu(hMenu, TPM_RIGHTBUTTON Or TPM_RETURNCMD, ptMenu.x, ptMenu.y, 0, hWnd, NULL) = IDM_EXIT Then PostQuitMessage(0)
         DestroyMenu(hMenu)
      End If
      Return 0
   Case WM_DPICHANGED
      ApplyDpi(LoWord(wParam)) 'monitor with different scaling -> rescale everything
      Return 0
   Case WM_TIMER
      'Alt+b exit via polling -> works even if the hotkey is occupied by another app
      If (GetAsyncKeyState(VK_MENU) And &h8000) AndAlso (GetAsyncKeyState(&h42) And &h8000) Then PostQuitMessage(0)
      Dim As Point pt, ptWin
      GetCursorPos(@pt)
      ptWin = pt 'keep original pt untouched for WindowFromPoint
      If pt.x <> oldX Or pt.y <> oldY Then
         oldX = pt.x
         oldY = pt.y
         'clamp to the monitor the cursor is currently on (multi monitor safe)
         Dim As MONITORINFO mi
         mi.cbSize = SizeOf(MONITORINFO)
         GetMonitorInfo(MonitorFromPoint(pt, MONITOR_DEFAULTTONEAREST), @mi)
         ptWin.x = IIf(ptWin.x < mi.rcWork.left + w2, mi.rcWork.left + w2, ptWin.x)
         ptWin.x = IIf(ptWin.x > mi.rcWork.right - w2, mi.rcWork.right - w2, ptWin.x)
         ptWin.y = IIf(ptWin.y > mi.rcWork.bottom - h - 20, ptWin.y - 36 - h, ptWin.y)
         MoveWindow(hWnd, ptWin.x - w2, ptWin.y + 20, w, h, True)
         SetWindowPos(hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE)
      End If

      Dim As Double fNow = Timer
      If fNow - fTimer > 0.99 Then
         Dim As Double fElapsed = fNow - fTimer
         fTimer = fNow
         Dim As DWORD iPID
         GetWindowThreadProcessId(WindowFromPoint(pt), @iPID)
         SetWindowText(hLabel_PID, Str(iPID))

         Static As DWORD iOldPID = -1
         Static As ULongInt iOldKU
         Dim As HANDLE hProcess = OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, False, iPID)
         If hProcess = NULL Then 'e.g. protected / system process
            SetWindowText(hLabel_CPU, "n/a")
            SetWindowText(hLabel_Mem, "n/a")
            SetWindowText(hLabel_ProcName, "n/a")
            iOldPID = -1
         Else
            If GetProcessTimes(hProcess, @ct, @et, @kt, @ut) Then
               Dim As ULongInt iKU = FT2ULL(kt) + FT2ULL(ut) '64 bit -> no overflow
               If iPID = iOldPID Then
                  'kernel + user time delta in 100 ns units / real elapsed time / logical CPUs
                  Dim As Double cpuUsage = min(100, max(0, (iKU - iOldKU) / (fElapsed * 100000) / iCPUs))
                  Dim As ZString * 20 text
                  sprintf(text, "%.2f%%", cpuUsage)
                  SetWindowText(hLabel_CPU, text)
               Else
                  SetWindowText(hLabel_CPU, "...") 'process changed -> need one interval as baseline
               End If
               iOldKU = iKU
               iOldPID = iPID
            Else
               SetWindowText(hLabel_CPU, "n/a")
               iOldPID = -1
            End If

            If GetProcessMemoryInfo(hProcess, Cast(PROCESS_MEMORY_COUNTERS Ptr, @tPMCex), SizeOf(tPMCex)) Then
               SetWindowText(hLabel_Mem, Str(Int(tPMCex.PrivateUsage / 1024 ^ 2)) & " MB / " & Str(Int(tPMCex.WorkingSetSize / 1024 ^ 2)) & " MB")
            Else
               SetWindowText(hLabel_Mem, "n/a")
            End If

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

            CloseHandle(hProcess)
         End If
      EndIf
      Return 0
   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

Sub ApplyDpi(iDpi As Long)
If iDpi < 96 Then iDpi = 96
g_iDpi = iDpi
Dim As Double f = iDpi / 96
w = BASE_W * f
h = BASE_H * f
w2 = w Shr 1
Dim As Long dy = BASE_DY * f, s1 = BASE_S1 * f, s2 = w - s1, x2 = 2 * f, y2 = 2 * f, lh = 15 * f

If hFont Then DeleteObject(hFont)
hFont = CreateFont(BASE_FONT * f, 0, 0, 0, 400, False, False, False, _
               DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, _
               CLIP_DEFAULT_PRECIS, _
               PROOF_QUALITY, _
               DEFAULT_PITCH, _
               "Times New Roman")

MoveWindow(hLabel1, x2, y2, s1, lh, True)
MoveWindow(hLabel2, x2, y2 + dy, s1, lh, True)
MoveWindow(hLabel3, x2, y2 + 2 * dy, s1, lh, True)
MoveWindow(hLabel4, s1 + 70 * f, y2, 19 * f, lh, True)
MoveWindow(hLabel_CPU, s1 + 5 * f, y2, 40 * f, lh, True)
MoveWindow(hLabel_PID, s1 + 92 * f, y2, 50 * f, lh, True)
MoveWindow(hLabel_Mem, s1 + 5 * f, y2 + dy, s2, lh, True)
MoveWindow(hLabel_ProcName, s1 + 5 * f, y2 + 2 * dy, s2, lh, True)

Dim As HWND aLabels(...) = {hLabel1, hLabel2, hLabel3, hLabel4, hLabel_CPU, hLabel_PID, hLabel_Mem, hLabel_ProcName}
For i As Long = 0 To UBound(aLabels)
   SendMessage(aLabels(i), WM_SETFONT, Cast(WPARAM, hFont), Cast(LPARAM, True))
Next

SetWindowPos(g_hGUI, NULL, 0, 0, w, h, SWP_NOMOVE Or SWP_NOZORDER Or SWP_NOACTIVATE)
oldX = -99999 'force reposition on next timer tick
End Sub

Function _WinAPI_GetDpiForWindow(hWnd As HWND) As Long 'dynamic -> also runs on Windows < 10 1607 (fallback 96)
Static As Function(As HWND) As UINT pGetDpiForWindow
Static As Boolean bInit
If bInit = False Then
   pGetDpiForWindow = Cast(Any Ptr, GetProcAddress(GetModuleHandle("user32.dll"), "GetDpiForWindow"))
   bInit = True
End If
If pGetDpiForWindow Then Return pGetDpiForWindow(hWnd)
Return 96
End Function

Function _WinAPI_GetProcessName(hProcess As HANDLE) As String 'via QueryFullProcessImageName -> no snapshot needed
Dim As WString * (MAX_PATH + 1) wsPath
Dim As DWORD iSize = MAX_PATH
If QueryFullProcessImageNameW(hProcess, 0, @wsPath, @iSize) = 0 Then Return ""
Dim As String sPath = wsPath
Return Mid(sPath, InStrRev(sPath, "\") + 1)
End Function

Function _WinAPI_GetNumberOfProcessors() As DWORD
Dim As SYSTEM_INFO si
GetSystemInfo(@si)
Return si.dwNumberOfProcessors
End Function

Function FT2ULL(ft As FILETIME) As ULongInt
Return (CULngInt(ft.dwHighDateTime) Shl 32) Or ft.dwLowDateTime
End Function

Download: Show CPU Usage under Cursor

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

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

Zuletzt bearbeitet von UEZ am 16.07.2026, 17:12, insgesamt 8-mal bearbeitet

Nach oben

hhr

Anmeldungsdatum: 15.07.2020
Beiträge: 116

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: 148
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