From 3b8aa4abe923eb011e0706aeecc448c01be900aa Mon Sep 17 00:00:00 2001 From: nxshock Date: Sat, 5 Apr 2025 15:43:40 +0500 Subject: [PATCH] Code upload --- README.md | 6 ++ src/clipboardhistory.pas | 117 +++++++++++++++++++++++++ src/mainunit.lfm | 158 ++++++++++++++++++++++++++++++++++ src/mainunit.pas | 73 ++++++++++++++++ src/make.bat | 1 + src/project.ico | Bin 0 -> 5430 bytes src/project.lpi | 112 ++++++++++++++++++++++++ src/project.lpr | 22 +++++ src/systemload.pas | 179 +++++++++++++++++++++++++++++++++++++++ 9 files changed, 668 insertions(+) create mode 100644 src/clipboardhistory.pas create mode 100644 src/mainunit.lfm create mode 100644 src/mainunit.pas create mode 100644 src/make.bat create mode 100644 src/project.ico create mode 100644 src/project.lpi create mode 100644 src/project.lpr create mode 100644 src/systemload.pas diff --git a/README.md b/README.md index e2f2381..5ac3c22 100644 --- a/README.md +++ b/README.md @@ -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 diff --git a/src/clipboardhistory.pas b/src/clipboardhistory.pas new file mode 100644 index 0000000..e2b6959 --- /dev/null +++ b/src/clipboardhistory.pas @@ -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. diff --git a/src/mainunit.lfm b/src/mainunit.lfm new file mode 100644 index 0000000..2fbecb6 --- /dev/null +++ b/src/mainunit.lfm @@ -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 diff --git a/src/mainunit.pas b/src/mainunit.pas new file mode 100644 index 0000000..3dd94bf --- /dev/null +++ b/src/mainunit.pas @@ -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. diff --git a/src/make.bat b/src/make.bat new file mode 100644 index 0000000..be6cf67 --- /dev/null +++ b/src/make.bat @@ -0,0 +1 @@ +lazbuild project.lpi diff --git a/src/project.ico b/src/project.ico new file mode 100644 index 0000000000000000000000000000000000000000..10b0c17f3acc01e7ca1d1070a08fddbca6000705 GIT binary patch literal 5430 zcmZQzU}RuoP*4ET3Jfa*7#P$T7#IWuAp8s#28MG23=A3!3=9ek3=9qo5OD?u28IR! z5J?ecVPIh3Wnf?sVPIeogJKXHBnFZr$8bgl1_llW1_mLhxjYOE49r*zVr5`p5NBXu zFkoO{uxDUkaE4+K8zcsj1F6BH6|WFTk2C`VgE<2OgB=3{gEj*L13x&}5ZXX~1DS8m zz>s}}fua0A14A7YgV-Q3uzrvlkXnRJ!Ym$RW8+vaFYo`Jo}T|59UZqaFfgbxFfec; zX$6I^0RuzHTPdkk|1B-={kOM&^WV|&4VVoQ1IanHyU0v;e9v&V?X!-)B1u+JOvj5J`FaDdEJ^XKC za{s@H$vr5(4;FKFe)%5~FW_`Ztlc1WBGuK^|Ns2{{r}11NB^Hcd;0&`(4n>pFvhuR$|hm$^Son{P6$QjqCq!-@5t#-ksb3 zpFMr_|Hh4z{}~u2{11=#@?Tl`@_$v;EC1EhAQ;33iN(Zzr^tQ=1_t)v;NWYZNVswJ z>i-+puY%oi|Nia&pFckQ&%n_8KPvj$e+7jL|CN<5{Z~%WA=ng22} z=l;veLNJI863fc|4=aDvp=AK9e#S^*Sy)k*sH6kd~H~IC0{{|C`q?{l9Y)WPktvl=OdKGqDlrnIQY~|NsC0`TyCo zr~bFMxBqu>arx@u;W5+7$_mt`LouHS4tqyO$F*NSzyH5|^8`5jGqSMR3=xB*zmosK z!LI+ky**aBySszhbD*{*5msSU!f0Y*;_&|cTWI++;eSa5$d9}JGcfFcSo$Bt-|?S; zVb}l4S`Zu579_d-fz@)TAm`%63&9b|!aV7JeIv+@-TxUFb|cvj;_vz2(gu<%1LZ$Z zeuru&ngWFrI|Bm)D4sy=M^IZFWR8TLolU;Kztewio|*q!+d+1K{J#h6XOO=k>2KHn z&K{5)S@l1teFrLwlo%Kow4mjJAp-*gsGNY69UiQ#lc9F({Ljd^=RXtEUN8o+85nl{ z@0kF%AJiWq+T&0^Yw7Ch#?;r>fAjP63#_lN|6fy6^S`R9>VHj5_5ZfEs{afOh5s8{ zKz4xqz7xs+JO6WX9{k_l1(E}YKPdc2v0o%NH+M70zPdV4pMpWJxVZT6u_KT&=FRKp z|G$2D`QOcL)_+s8egBKf{{LrZJMf=@VH+5;vmf|hR{8(Gi|dj93=AckaFprz+#?EV z|2}{A&Dgpyu9`Q_4K#?Z)p1e zf9lNt|EJCR|G&BQ|9@*6P?{)vj?`bkXCJy8yzO`N=;8mfX3YZQz5Dk3fAsMF|NHlD z|9^1*_WxHeAA{4pwstMZpU}P+D7-*vu6!LC{)V}OrL3%M^QKLkz~S|)4-D-8KQJ&beqdl=_`$%y2*Q6D z82JA%FxdZNVEq4&f&Kq~s9KO2AhQ@4`2RC7$p2?xu>aq{{{R00{{R0$;}oD_3D8&t zBY4Dufx!V=s|3!XJDB2pMhcee+Gu)dV~&CR#sNl|1Y0D{$I9q@qZf|^L9vDpZnj?@b-UO z+ZSLOVg{-{7!Onj|M>P5+_r6PY5XrMEAGO;F#Er~{nP)(#`pd^J3ocG1EvF&c6N4N z`Q!Wd|F>^l|9|K9wg0)fvEM-UIXgf8ucdYCzpLvby!ySpz2!h{8c^T%_RVYmpFO?& zpMhcWe^=N0|5a43{daSF01X3_@Pvh{7RWUrAt4uj{rdg?%BA!FUpxb~NhkjIaKHCo zUjE{LFOU0R`=?HA{@>o-^1r2}<$q^q=l{8L=l*YMYPt;4@9F7fc=FV#|F>^m{r~8} zx&I6d6aRa8-T5yjcJ9BoH>iz2`TwHuY(e@#I5|1_ z$^ZX<|KGm@YLiX;@8NOtKP&5r|DK+=!2SVg1eGJDrKR7ToSa-idXTY)hey=4YnT5& zc?4)cmKOTa)6*>iSr0n9wYBLR$R1Fe7(~M`BrTz<#^if>xrZD$ zu<<_w!<7Gyj#t3iZEY`s?I%#Sfa+yUP?}Fl4Eha<|D>c_|AmE*{7*}}4b?vnl$|gw zWneHiGBT>^?diUL + + + + + + + + + + + + + + <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> diff --git a/src/project.lpr b/src/project.lpr new file mode 100644 index 0000000..a897f21 --- /dev/null +++ b/src/project.lpr @@ -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. + + diff --git a/src/systemload.pas b/src/systemload.pas new file mode 100644 index 0000000..76420a3 --- /dev/null +++ b/src/systemload.pas @@ -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. +