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
|
# 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