Code upload
This commit is contained in:
parent
119e7d1d38
commit
3b8aa4abe9
9 changed files with 668 additions and 0 deletions
|
|
@ -1,2 +1,8 @@
|
|||
# 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
117
src/clipboardhistory.pas
Normal 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
158
src/mainunit.lfm
Normal 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
73
src/mainunit.pas
Normal 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
1
src/make.bat
Normal file
|
|
@ -0,0 +1 @@
|
|||
lazbuild project.lpi
|
||||
BIN
src/project.ico
Normal file
BIN
src/project.ico
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 5.3 KiB |
112
src/project.lpi
Normal file
112
src/project.lpi
Normal 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
22
src/project.lpr
Normal 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
179
src/systemload.pas
Normal 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.
|
||||
|
||||
Loading…
Add table
Add a link
Reference in a new issue