uses Windows, ShellAPI, Types; {$r cpu.res} {$warnings off}
function RegisterServiceProcess(Address: Pointer): Cardinal;
asm
mov ecx, eax
jecxz @IsNT
push 01h
call GetCurrentProcessID
push eax
call ecx
@IsNT:
end;
var
Dummy, Canvas: Cardinal;
Saved: Cardinal = $00000010;
IconInfo: TIconInfo;
Icons: array[0..15] of HICON;
TrayIcon: TNotifyIconData = (cbSize: SizeOf(TNotifyIconData); uFlags: NIF_ICON);
hKey: Windows.HKEY;
function GetCPUUsage: Cardinal;
var Size: Cardinal;
begin
Size := SizeOf(Result);
RegQueryValueEx(hKey, 'KERNEL\CPUUsage', nil, nil, @Result, @Size);
end;
procedure RegOpenKey(const lpSubKey: PChar);
begin
RegCloseKey(hKey);
RegOpenKeyEx(HKEY_DYN_DATA, lpSubKey, 0, KEY_READ, hKey);
GetCPUUsage;
end;
begin
CreateMutex(nil, True, 'cpu');
if (GetLastError = ERROR_ALREADY_EXISTS) or (RegisterServiceProcess(GetProcAddress(GetModuleHandle('kernel32.dll'), 'RegisterServiceProcess')) = 0) then Exit;
Dummy := GetDC(0);
Canvas := CreateCompatibleDC(Dummy);
ReleaseDC(0, Dummy);
Icons[0] := LoadIcon(hInstance, MAKEINTRESOURCE(100));
GetIconInfo(Icons[0], IconInfo);
SelectObject(Canvas, IconInfo.hbmColor);
Dummy := CreateSolidBrush(RGB(0, 255, 0));
repeat Dec(Saved);
FillRect(Canvas, Rect(2, (Saved * 2) + 1, 30, 32), Dummy);
Icons[16 - Saved] := CreateIconIndirect(IconInfo);
until Saved = 0;
TrayIcon.hIcon := Icons[0];
TrayIcon.Wnd := FindWindow('Shell_TrayWnd', nil);
Shell_NotifyIcon(NIM_ADD, @TrayIcon);
RegOpenKey('PerfStats\StartStat');
RegOpenKey('PerfStats\StatData');
repeat Sleep(250);
Dummy := GetCPUUsage div 6;
if Saved <> Dummy then
begin
Saved := Dummy;
TrayIcon.hIcon := Icons[Dummy];
Shell_NotifyIcon(NIM_MODIFY, @TrayIcon);
end;
until FindWindow('Shell_TrayWnd', nil) = 0;
RegOpenKey('PerfStats\StopStat');
RegCloseKey(hKey);
end.