Code upload

This commit is contained in:
nxshock 2025-04-05 15:43:40 +05:00
parent 119e7d1d38
commit 3b8aa4abe9
9 changed files with 668 additions and 0 deletions

View file

@ -1,2 +1,8 @@
# helper # helper
Provides simple CPU/memory load monitor in tray and other support functions.
Features:
* CPU and memory load tray icon
* Some functions which helps to build SQL queries

117
src/clipboardhistory.pas Normal file
View file

@ -0,0 +1,117 @@
unit ClipboardHistory;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, ExtCtrls, ClipBrd, LazUTF8, LCLType;
type
TClipHistory = class
public
constructor Create;
procedure MakeList;
procedure MakeSQLList;
end;
var
ClipHistory: TClipHistory;
Timer: TTimer;
implementation
procedure StripStrings(t: TStringList);
var i: integer;
begin
i:=0;
while i < t.Count do
if UTF8Trim(t[i]) = '' then
t.Delete(i)
else begin
t[i] := UTF8Trim(t[i]);
i:=i+1;
end;
end;
function ContainsStrings(t: TStringList): boolean;
var
i, j: integer;
begin
for i:=0 to t.Count-1 do begin
for j:=1 to UTF8Length(t[i]) do begin
if not(UTF8Copy(t[i], j, 1)[1] in ['0'..'9', '.']) or (UTF8Length(t.Strings[i]) >= 20) then
exit(true);
end;
end;
exit(false);
end;
constructor TClipHistory.Create;
begin
end;
procedure TClipHistory.MakeList;
var
items: TStringList;
i: integer;
begin
try
items := TStringList.Create();
items.Text := Clipboard.AsText;
StripStrings(items);
items.Delimiter := ',';
if ContainsStrings(items) then begin
for i:=0 to items.Count-1 do begin
items[i] := '''' + items[i] + '''';
end;
end;
i:=0;
while i < items.Count do
if UTF8Trim(items[i]) = '' then
items.Delete(i)
else
i:=i+1;
Clipboard.AsText := items.DelimitedText;
finally
items.Free;
end;
end;
procedure TClipHistory.MakeSQLList;
var
Text: TStringList;
i, n: integer;
isIntList: boolean;
begin
try
Text := TStringList.Create;
StripStrings(Text);
if Text.Count < 1 then
exit;
isIntList := True;
for i := 0 to Text.Count - 1 do
if (UTF8Length(Text[i]) > 9) or (not TryStrToInt(Text[i], n)) then begin
isIntList := False;
break;
end;
if isIntList then
Clipboard.AsText := 'SELECT ' + UTF8StringReplace(UTF8Trim(Text.Text), #13#10, ' UNION'#13#10'SELECT ', [rfReplaceAll]) + ' FROM DUAL'
else
Clipboard.AsText := 'SELECT ''' + UTF8StringReplace(UTF8Trim(Text.Text), #13#10, ''' UNION'#13#10'SELECT ''', [rfReplaceAll]) + ''' FROM DUAL';
finally
Text.Free;
end;
end;
begin
ClipHistory := TClipHistory.Create;
end.

158
src/mainunit.lfm Normal file
View file

@ -0,0 +1,158 @@
object MainForm: TMainForm
Left = 433
Height = 361
Top = 244
Width = 645
AutoSize = True
BorderStyle = bsNone
Caption = 'Helper'
ClientHeight = 361
ClientWidth = 645
OnCreate = FormCreate
Position = poScreenCenter
LCLVersion = '3.8.0.0'
object Panel1: TPanel
Left = 0
Height = 40
Top = 0
Width = 645
Align = alTop
BevelOuter = bvNone
TabOrder = 0
end
object TrayIcon: TTrayIcon
PopUpMenu = TrayPopupMenu
Visible = True
Left = 8
Top = 48
end
object TrayPopupMenu: TPopupMenu
Images = TrayMenuImageList
OnPopup = TrayPopupMenuPopup
Left = 72
Top = 48
object ToolsMenuItem: TMenuItem
Caption = 'Инструменты'
ImageIndex = 1
object MakeListMenuItem: TMenuItem
Caption = 'Строки → Список через запятую'
ImageIndex = 3
OnClick = MakeListMenuItemClick
end
object MakeSQLStringListMenuItem: TMenuItem
Caption = 'Строки → SQL-таблица строк'
ImageIndex = 4
OnClick = MakeSQLStringListMenuItemClick
end
end
object N1: TMenuItem
Caption = '-'
end
object ExitMenuItem: TMenuItem
Caption = 'Выход'
ImageIndex = 2
OnClick = ExitMenuItemClick
end
end
object UpdateTrayIconTimer: TTimer
OnTimer = UpdateTrayIconTimerTimer
Left = 104
Top = 48
end
object TrayMenuImageList: TImageList
Left = 40
Top = 48
Bitmap = {
4C7A070000001000000010000000240B00000000000078DAE5990950944716C7
7B936C74CDB526B595C42387D94A5592351E643DCA582EF72130801CE3302002
0A080A820CD7302020CA311C2A9020228203C325C8110302013C222A22A0C620
C865A242700886B81AF5BFDD1F331C166830D9A476D355FF9AD7AFDFAFBF3E5E
7FD30C00C8CE9D3B2FC5C4C4205A2A457474349574024573312C9632DF252424
10509ED55919BC756B620D0CE007A55851321CCFFA65A5B3A39D5347FB154E5D
9D23F52B6DAD686BBD8CD6CB2DC0830750321C2FA5636265E32677E4E6E5233B
2717D7AE7D8B4DEEEEC8CB67F51C747775A1B3B383F6D781FBF7EF73F319E6E3
76727C7FFF2DAA0128144CDF2BEBB77093DADFF529D0DB7B93132B4A86ECDAC2
BF2A7533C10E27036C5FAF8F70A6754C7A636DA5B639EA71718CA1AC2C76B325
EDE62E6E2B3A71A7BF0B77A9EEF4535B31A47F2BC5DAD8E7605F3B27C63056EA
6E81FB3FDE445FFB59B8B97B2137BF103979059CB2A9E4B907A1E868C046DA26
A7F5DEB633E8693D837B83373976E8F93FE1DE8F0A3CB8AD14EDEFFE28DDA362
7E66DFFDA18F1363181BE7697943EAC653CE4D67480E430AE3A4ADFCD441A8BD
362716CB986D2EBCC384900FA5B143EB3F99124D19CABECDE58F72FF5D5DDD20
CFCE815C9E8DAC2C3964B24CCEEFB2610364999963F8A851F9A3CADFC91465CE
717C5C5C5C3F777EB8B3138DA8A8A871151919C97D3296318C559679546A9314
63886A0CBFA75849DD1BFF5964843F62A203102B1D5FAC8DC5D0D852D5C4557C
415E147EEEDC0BF2A231869F529D43C817204F55813C5309F2E787F40CF53F4D
DB492DD531AA1354C79B47F84AEC4CA4EF0B511B3C987CDAE0E97B059E7E4372
17B563D396362425EC45627C00927606C2D58DCBBF613E3EF1069E7EB90EE405
AA974E61EAABA7F1FC8CD398F6FA693C35BD1EBC5529387DB20277EFDC42CF8D
6ED47D59036964E8038E9F46C748CAA93EE772ABE95C01B58F80FCA99CF35BD9
B7202ADC13D7BFED42495101A27784617BA81811E15BB91C24532B2074B90A57
9FEBB4DA8DC6B305D8E4DF03EFE0EBF094DC8093F74D446E17A1B5E5224ED456
232850044DD31E6EBD39FED923884F56E0C5392D983AA312D36655E1E5775B31
FDDD2B786E4E17C8ABDFE070891C575A5BD0D870167EDE1E08167B233438002A
DE375C81D73E6CC7AC059D98B5B00BAFCFFF062F7ED08F6DEBCD11E3178AA68B
5D686A3C87AF2E3663E0FBEFA0E8BB0E89D86768FE53CAE1E0ADC0EC45DD786B
C955CC5E7C1DD3170C22C4C91AADBBA7D02F96E3E83AEC8694F40AF88B9C10E4
B71E96565B47C63FB51CBC75FD98F3F10DBCB3BC1733970C62BB9B109777FF05
F8E12CAE66FC1303C5DA085A678397E6FD0475C11D081C5A47F66F5A0596F36F
E37DDD5B784F771033570017773D05DC6E4457C652F41E32C6B5FCA588D96287
B7351E60A9C51D9A534746F8178E0CB03EC834BA5F53D95E9E4673C20BE8C959
819E43ABD091AD01770B4BEAAF079942F390C53E4F9991FC9FFF708E97873D57
762CE61D9CD8F9010A02A7978D730EE68F3E3FE39439A362E74C146420968D95
248B4A3E46FA815944DBEF00F1D853454A9B7AC8D11605BFBE7BF0A715DEFBB1
529CA96433596CA141C8411884168E554801B402B3E191F205CA2EF4A2B8B107
359707A0E12703CF2F9718FAD36706503E280F5A4B164073D962682E5F322C8D
658BF0B1DA3F50D63288A0C21698279C41758B023A6239BDBC681033510131F6
C925460185305CBE0C069A9AD0D3D6829ECE9074B535A0F9F122ACD97F09C2E4
33E027D6E1F3E65EE807E7D197B72121F1BA6446F826F26AF84690445D98ADD0
064F571F46FA063034A0D2D38381C672D8A55D80CD2775E0EF3E818233DF6225
9D1B8935262496F611A34F489416D2AEB780C46BC142D300662B8DC03332A632
84918E3A6C539A204C388ED57135C83CD60EE3F0527AF9305490485D901D5A20
DB5680D4A421A9BB91F6AB09819E312C4D4CB1CA9447FBD28675723D84F13578
EBF020522BBE8269C4E760ECDACE73B06B3B0587D69320C7F6809C48414827B5
77EB4268620EFEAA55B0E2194090780AD6B1559853761B09A5CD30975670BC43
DF3990F369204DA920675240EA53E0DE4AF378970ED69A5B41686509EB5546B0
DA7D1CFC980AE86ED9831D050DB08AAB06895A3930347E6D903075909674D87D
5D4CE7A501677301ECAD85B0130A60C73783795C2D2CA2CB61BC351F92CC9310
EC66EFE251B91FAD035E1B5D53A9265CF9B658676B0787B576B0B75B03471B2B
984AAB60167918A6DB4BE0B5AF16364975586F69435C2C84E4AFE11BC92B21AE
DC98370BEDB1C1DE014E8E0E58EFC83EEDE1BCD61ABCC82330092F012FEC109C
13CAB0664F3D6CAD85648D40481CF8ABC90A1719BCD73BC1C3D9051B5D5CE0B6
4125676C72B28761041DFBB62218851E844D7411EC531B21140A39D95A0B602B
580D1B8100D6026B08AC47644D7DC2D596B07216C15872008634EF4C4272B12E
FD029EE07B5F6D914D809F7E40FA3DE7035F4F78F81F535EA65AA87A7FFE3F8A
BD1A55FA25EC93F4F17BF3E3F5F14BD7F18FC2FE11355E9E8CB786E3ADE9E37C
13D9BF26FFF0F827C38FF7DCDF929FE88C3E6A4F269BDFFFEDB3F0A83C79785F
7E6E5E3D69BE3C6ECD27CB3FC91E3E3CDFDF722F262B7E540EB18B2B20419955
C43C424EED7C62162E27FCB86212E8E3452454C61179C430F400D195EC25E6DB
1B886564C3AC0FAD92601C5657FC285E2CF2A2F22486E1393008DE0FDDC0BD3C
8B8846BFB91649D0F1AFC23C757F4CC8C7169100EFCDC4D7D303DEC7BF817BE9
79E805EDC3476B3FA1F7B7331CFBAEA6CBEAF178D36D59842F2D24FE9BDD70E1
680DBC37BAC0BDB21D4E071BA0214EC147E6E15868169541F762DA187E879CAC
89CD2726A1B2A95611B91D6E9F5DE4D8FAF2C3106D728153C965D8C9EAB1DC27
19736D7CED977A25102BCAAF893D4824B24A621A9E395B189513EF995A0EEFD2
26B816376343E9658EFDF2D041F8786C806DCED710A49EC2228F042CF54A6263
6EB78ECEABF74F2F47444E35828B4EC3F370331C338EC3B3F01C9CF29B619B7D
9E636BB333E147E7C4CFB8848F3C12B1C4EB13E29F51F1E0E4956B483C7A09DE
E517C1DF5309E77D95F029BD80B5B23AAC4D3D0AC7AC46F00F9C87BFA71BAA32
F62148E4C1DD3B19AFB3599A629D500A935DA5B08AC881F8D059785056905C8D
F5293570CA6A003FA11AC2F4466845D542E2EBC5B16A5E7BC812AF4F593ECF50
DFBCEB8E28A30A41D56D58439F691422877B661D6CD24FC32482DE93D31BA015
528C57F403AF337687C49B2C16ED25CB44C9349FE464F642757DF52DC95819B8
1FBEB21A78167D059BB453D0F6CF80C38106686F2DC28C9562C6CE7D8D17465E
330E23338C43C92C5E08C7D3F2EC7B068E6E8B5D76D13B7A312C3F3D0675512A
5D43CA868CB06F98869137CCA84C87F426B519AF2F4E637DBCF8B7F79719CEB5
8DBCB1607530D6A59E847668095E3708B8A16259FCC352F1FFF24AE6C6C17ECF
9CA9EE18F0A669C8FD994612C5101B4A26E21F733F9FF7B88BFCAFF1DBDD1FB9
040707F70705058D598888F03094961415ABD687D9CC373A464219C64A241274
B4B7C3DFDF7FB83D6C6B108A0A0FAABE0308B3994FD5CE62AF767781B1818181
9065ECE7EABE7E7E5C4C90380005F9B9C33CB3998FD92C86FD6F83318C652A29
2AE4E21537FB10102086D85784FC5CF930CF6CE6636D03DFF7D3D81C8E61AC58
2C466D4D15AA2ACBD0DBDBC3D57DB67821479E39CC339BF9585B1F7D46654519
652AB93A53536303DAAFB4C16F68FC6A5E1EEEC892650CF3CC663ED6C6C6DFDD
D5C1318C656B505B5B4DD72F40F5B730D9BCD115B20369C33CB3994FB97C6A6C
FDBE3C719C634522518D72FFD454EBEBE6E28C845DF1B52A9ED9CC376AFBD418
43F95BD4FEFB6856D5CEFCA3CEC74431F3FFD7F3FF3F87AB23FC
}
end
end

73
src/mainunit.pas Normal file
View file

@ -0,0 +1,73 @@
unit mainunit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Menus, LazUTF8;
type
{ TMainForm }
TMainForm = class(TForm)
MakeListMenuItem: TMenuItem;
MakeSQLStringListMenuItem: TMenuItem;
Panel1: TPanel;
ToolsMenuItem: TMenuItem;
TrayMenuImageList: TImageList;
ExitMenuItem: TMenuItem;
N1: TMenuItem;
UpdateTrayIconTimer: TTimer;
TrayPopupMenu: TPopupMenu;
TrayIcon: TTrayIcon;
procedure ExitMenuItemClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure MakeListMenuItemClick(Sender: TObject);
procedure MakeSQLStringListMenuItemClick(Sender: TObject);
procedure TrayPopupMenuPopup(Sender: TObject);
procedure UpdateTrayIconTimerTimer(Sender: TObject);
end;
var
MainForm: TMainForm;
implementation
uses SystemLoad, ClipboardHistory;
{$R *.lfm}
{ TMainForm }
procedure TMainForm.UpdateTrayIconTimerTimer(Sender: TObject);
begin
UpdateTrayIcon(TrayIcon);
end;
procedure TMainForm.TrayPopupMenuPopup(Sender: TObject);
begin
end;
procedure TMainForm.ExitMenuItemClick(Sender: TObject);
begin
Application.Terminate;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
SystemLoad.SetDPI(Screen.PixelsPerInch);
end;
procedure TMainForm.MakeListMenuItemClick(Sender: TObject);
begin
ClipHistory.MakeList;
end;
procedure TMainForm.MakeSQLStringListMenuItemClick(Sender: TObject);
begin
ClipHistory.MakeSQLList;
end;
end.

1
src/make.bat Normal file
View file

@ -0,0 +1 @@
lazbuild project.lpi

BIN
src/project.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 5.3 KiB

112
src/project.lpi Normal file
View file

@ -0,0 +1,112 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<General>
<Flags>
<SaveClosedFiles Value="False"/>
<LRSInOutputDirectory Value="False"/>
<SaveJumpHistory Value="False"/>
<SaveFoldState Value="False"/>
<CompatibilityMode Value="True"/>
</Flags>
<SessionStorage Value="None"/>
<Title Value="project"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True"/>
</XPManifest>
<Icon Value="0"/>
</General>
<VersionInfo>
<UseVersionInfo Value="True"/>
<MinorVersionNr Value="1"/>
<Language Value="0419"/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="1">
<Mode0 Name="default"/>
</Modes>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="4">
<Unit0>
<Filename Value="project.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="mainunit.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit1>
<Unit2>
<Filename Value="systemload.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="SystemLoad"/>
</Unit2>
<Unit3>
<Filename Value="clipboardhistory.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ClipboardHistory"/>
</Unit3>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="..\bin\helper"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="..\lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
<DebugInfoType Value="dsDwarf3"/>
<StripSymbols Value="True"/>
</Debugging>
<LinkSmart Value="True"/>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

22
src/project.lpr Normal file
View file

@ -0,0 +1,22 @@
program project;
{$mode objfpc}{$H+}
uses {$IFDEF UNIX} {$IFDEF UseCThreads}
cthreads, {$ENDIF} {$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms,
mainunit;
{$R *.res}
begin
RequireDerivedFormResource := True;
Application.Scaled:=True;
Application.ShowMainForm := False;
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

179
src/systemload.pas Normal file
View file

@ -0,0 +1,179 @@
unit SystemLoad;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, ExtCtrls, Graphics, Forms, Dialogs;
var
FLastIdleTime: int64;
FLastKernelTime: int64;
FLastUserTime: int64;
image: TBitmap;
procedure UpdateTrayIcon(TrayIcon: TTrayIcon);
procedure SetDPI(dpi: integer);
implementation
uses jwaWinBase;
function GetCPULoadPercent: integer;
var
IdleTimeRec: TFileTime;
KernelTimeRec: TFileTime;
UserTimeRec: TFileTime;
IdleTime: int64 absolute IdleTimeRec;
KernelTime: int64 absolute KernelTimeRec;
UserTime: int64 absolute UserTimeRec;
IdleDiff: int64;
KernelDiff: int64;
UserDiff: int64;
SysTime: int64;
begin
if GetSystemTimes(@IdleTimeRec, @KernelTimeRec, @UserTimeRec) then
begin
IdleDiff := IdleTime - FLastIdleTime;
KernelDiff := KernelTime - FLastKernelTime;
UserDiff := UserTime - FLastUserTime;
FLastIdleTime := IdleTime;
FLastKernelTime := KernelTime;
FLastUserTime := UserTime;
SysTime := KernelDiff + UserDiff;
Result := 100 * (SysTime - IdleDiff) div SysTime;
end
else
Result := 0;
end;
function DarkColor(color: TColor): TColor;
var
r, g, b: byte;
begin
RedGreenBlue(color, r, g, b);
r := r div 4;
g := g div 4;
b := b div 4;
Result := RGBToColor(r, g, b);
end;
function FillColor(percent: integer): TColor;
begin
if percent < 50 then
Result := RGBToColor(trunc((50 - percent) / 50 * 255), 255,
trunc((50 - percent) / 50 * 255))
else if percent < 75 then
Result := RGBToColor(trunc((percent - 50) / 25 * 255), 255, 0)
else if percent < 100 then
Result := RGBToColor(255, trunc((100 - percent) / 25 * 255), 0)
else
Result := RGBToColor(255, 0, 0);
end;
function GetMemoryLoadPercent: integer;
var
m: TMemoryStatus;
usedMem: QWord;
begin
GlobalMemoryStatus(m);
Result := (m.dwTotalPageFile - m.dwAvailPageFile) * 100 div m.dwTotalPhys;
// Если вышли за RAM, то 200% будет пиком
usedMem := m.dwTotalPageFile - m.dwAvailPageFile;
if Result > 100 then
Result := 100 + (usedMem - m.dwTotalPhys) * 100 div (m.dwTotalPageFile-m.dwTotalPhys);
end;
function GetTimePercent: integer;
var
h, m, s, ms: word;
minSinceDayBegin: integer;
begin
DecodeTime(Time, h, m, s, ms);
minSinceDayBegin := h * 60 + m;
Result := (minSinceDayBegin - 510) * 100 div (1050 - 510);
end;
procedure DrawLine(const aColor: TColor; const aLineNum, aTotalLineNum, spaceSize, aValue: integer);
begin
image.Canvas.Brush.Color := DarkColor(aColor);
image.Canvas.FillRect(0, image.Canvas.Height * (aLineNum-1) div aTotalLineNum,
aValue * image.Canvas.Width div 100, image.Canvas.Height div aTotalLineNum * aLineNum - spaceSize);
image.Canvas.Brush.Color := aColor;
image.Canvas.FillRect(aValue * image.Canvas.Width div 100-1, image.Canvas.Height * (aLineNum-1) div aTotalLineNum,
aValue * image.Canvas.Width div 100, image.Canvas.Height div aTotalLineNum * aLineNum - spaceSize);
end;
procedure DrawLine2(const aColor: TColor; const aLineNum, aTotalLineNum, spaceSize, aValue: integer);
begin
if aValue <= 100 then begin
DrawLine(aColor, aLineNum, aTotalLineNum, spaceSize, aValue);
exit;
end;
image.Canvas.Brush.Color := DarkColor(aColor);
image.Canvas.FillRect(0, image.Canvas.Height * (aLineNum-1) div aTotalLineNum,
image.Canvas.Width, image.Canvas.Height div aTotalLineNum * aLineNum - spaceSize);
image.Canvas.Brush.Color := aColor;
image.Canvas.FillRect(0, image.Canvas.Height * (aLineNum-1) div aTotalLineNum,
aValue mod 100 * image.Canvas.Width div 100+1, image.Canvas.Height div aTotalLineNum * aLineNum - spaceSize);
end;
procedure DrawLine3(const aColor: TColor; const aLineNum, aTotalLineNum, spaceSize, aValue: integer);
var
i: integer;
begin
image.Canvas.Brush.Color := DarkColor(aColor);
for i := 0 to aValue * image.Canvas.Width div 100 do begin
if i mod 2 = 0 then
image.Canvas.FillRect(i, image.Canvas.Height * (aLineNum-1) div aTotalLineNum, i+1, image.Canvas.Height div aTotalLineNum * aLineNum - spaceSize);
end;
image.Canvas.Brush.Color := aColor;
for i := (aValue * image.Canvas.Width div 100)-2 to aValue * image.Canvas.Width div 100 do begin
if i mod 2 = 0 then
image.Canvas.FillRect(i, image.Canvas.Height * (aLineNum-1) div aTotalLineNum, i+1, image.Canvas.Height div aTotalLineNum * aLineNum - spaceSize);
end;
end;
procedure UpdateTrayIcon(TrayIcon: TTrayIcon);
const
lineCount: integer = 2;
space: integer = 1;
var
p, m{, t}: integer; // CPU usage, MEM usage, time percent
begin
p := GetCPULoadPercent;
m := GetMemoryLoadPercent;
// t := GetTimePercent;
//TrayIcon.Hint := format('CPU: %d%%'#10'MEM: %d%%'#10'TIM: %d%%', [p, m, t]);
TrayIcon.Hint := format('CPU: %d%%'#10'MEM: %d%%', [p, m]);
image.Canvas.Brush.Color := clBlack {RGBToColor(38, 37, 36)};
image.Canvas.Clear;
DrawLine2(FillColor(p), 1, lineCount, space, p);
DrawLine2(FillColor(m), 2, lineCount, space, m);
//DrawLine2(FillColor(t), 3, lineCount, space, t);
TrayIcon.Icon.Assign(image);
end;
procedure SetDPI(dpi: integer);
begin
image.Width := trunc(double(16) * double(dpi) / double(96));
image.Height := trunc(double(16) * double(dpi) / double(96));
end;
begin
image := TBitmap.Create;
image.Width := 16;
image.Height := 16;
end.