Skip to content

Commit a5d4b8d

Browse files
pashagolubpashagolub
committed
[+] implement pop-up editor for chain Cron values, closes #30 
1 parent 2fc1ed1 commit a5d4b8d

File tree

10 files changed

+255
-18
lines changed

10 files changed

+255
-18
lines changed

‎forms/fmmain.lfm‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,7 @@ object fmMain: TfmMain
2020
Images = imglTabs
2121
TabIndex = 0
2222
TabOrder = 0
23+
OnChange = pcEditorsChange
2324
object tsOverview: TTabSheet
2425
Caption = 'Overview'
2526
ClientHeight = 986
@@ -82,6 +83,7 @@ object fmMain: TfmMain
8283
FieldName = 'live'
8384
end
8485
item
86+
ButtonStyle = cbsEllipsis
8587
PickList.Strings = (
8688
'* * * * *'
8789
'@every <interval>'
@@ -137,6 +139,7 @@ object fmMain: TfmMain
137139
TabAdvance = aaRight
138140
TabOrder = 0
139141
TitleImageList = imglGrids
142+
OnEditButtonClick = gridChainsEditButtonClick
140143
OnEditingDone = gridChainsEditingDone
141144
OnTitleClick = gridChainsTitleClick
142145
end

‎forms/fmmain.pas‎

Lines changed: 28 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@ interface
77
uses
88
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, Menus,
99
StdCtrls, DBGrids, DBCtrls, ExtCtrls, uObjects, DB, Grids, ActnList, Buttons,
10-
frameTaskCommandEditor;
10+
frameTaskCommandEditor, frameCronEditor;
1111

1212
type
1313

@@ -93,6 +93,7 @@ TfmMain = class(TForm)
9393
procedure acTaskToolbarUpdate(Sender: TObject);
9494
procedure acConnectClick(Sender: TObject);
9595
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
96+
procedure gridChainsEditButtonClick(Sender: TObject);
9697
procedure gridChainsEditingDone(Sender: TObject);
9798
procedure gridChainsTitleClick(Column: TColumn);
9899
procedure gridTasksDrawColumnCell(Sender: TObject; const Rect: TRect;
@@ -102,9 +103,11 @@ TfmMain = class(TForm)
102103
var Editor: TWinControl);
103104
procedure miCloseClick(Sender: TObject);
104105
procedure miLogClick(Sender: TObject);
106+
procedure pcEditorsChange(Sender: TObject);
105107
private
106108
FLastColumn: TColumn; //last sorted grid column
107109
FTaskCmd: TfrmTaskCommandEditor;
110+
FCronEdit: TfrmCronEditor;
108111
public
109112
procedure UpdateSortIndication(ACol: TColumn);
110113
end;
@@ -114,7 +117,7 @@ TfmMain = class(TForm)
114117

115118
implementation
116119

117-
uses uDataModule, SQLDB, LCLType, RegExpr;
120+
uses uDataModule, SQLDB, LCLType;
118121

119122
{$R *.lfm}
120123

@@ -126,6 +129,19 @@ procedure TfmMain.FormCloseQuery(Sender: TObject; var CanClose: boolean);
126129
CanClose := True;
127130
end;
128131

132+
procedure TfmMain.gridChainsEditButtonClick(Sender: TObject);
133+
var
134+
P: TPoint;
135+
begin
136+
if not Assigned(FCronEdit) then
137+
begin
138+
FCronEdit := TfrmCronEditor.Create(Self);
139+
FCronEdit.Parent := Self;
140+
end;
141+
P := gridChains.ClientToParent(gridChains.SelectedFieldRect.TopLeft, Self);
142+
FCronEdit.ShowEditor(gridChains.SelectedField, P);
143+
end;
144+
129145
procedure TfmMain.gridChainsEditingDone(Sender: TObject);
130146
var
131147
S: string;
@@ -212,13 +228,16 @@ procedure TfmMain.gridTasksDrawColumnCell(Sender: TObject; const Rect: TRect;
212228
end;
213229

214230
procedure TfmMain.gridTasksEditButtonClick(Sender: TObject);
231+
var
232+
P: TPoint;
215233
begin
216234
if not Assigned(FTaskCmd) then
217235
begin
218236
FTaskCmd := TfrmTaskCommandEditor.Create(Self);
219-
FTaskCmd.Parent := gridTasks;
237+
FTaskCmd.Parent := Self;
220238
end;
221-
FTaskCmd.ShowEditor(gridTasks.SelectedField, gridTasks.SelectedFieldRect.TopLeft);
239+
P := gridTasks.ClientToParent(gridTasks.SelectedFieldRect.TopLeft, Self);
240+
FTaskCmd.ShowEditor(gridTasks.SelectedField, P);
222241
end;
223242

224243
procedure TfmMain.gridTasksSelectEditor(Sender: TObject; Column: TColumn;
@@ -245,6 +264,11 @@ procedure TfmMain.miLogClick(Sender: TObject);
245264
if tsLog.TabVisible then tsLog.Show();
246265
end;
247266

267+
procedure TfmMain.pcEditorsChange(Sender: TObject);
268+
begin
269+
pcEditors.SetFocus();
270+
end;
271+
248272
procedure TfmMain.UpdateSortIndication(ACol: TColumn);
249273
begin
250274
// Remove the sort arrow from the previous column we sorted

‎forms/framebase.lfm‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,7 @@ object BaseFrame: TBaseFrame
66
ClientHeight = 360
77
ClientWidth = 480
88
DesignTimePPI = 144
9+
LCLVersion = '2.2.4.0'
910
OnExit = FrameExit
1011
ParentFont = False
1112
TabOrder = 0

‎forms/framebase.pas‎

Lines changed: 0 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,6 @@ TBaseFrame = class(TFrame)
2626
procedure ShowEditor(AField: TField; ATopLeft: TPoint);
2727
procedure HideEditor();
2828
procedure ApplyChanges();
29-
procedure CreateParams(var Params: TCreateParams); override;
3029
end;
3130

3231
implementation
@@ -68,11 +67,5 @@ procedure TBaseFrame.ApplyChanges;
6867
HideEditor();
6968
end;
7069

71-
procedure TBaseFrame.CreateParams(var Params: TCreateParams);
72-
begin
73-
inherited CreateParams(Params);
74-
Params.Style := Params.Style or WS_SIZEBOX;
75-
end;
76-
7770
end.
7871

‎forms/framecroneditor.lfm‎

Lines changed: 105 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,105 @@
1+
inherited frmCronEditor: TfrmCronEditor
2+
Width = 472
3+
ClientWidth = 472
4+
object pnlEditor: TPanel[0]
5+
Left = 0
6+
Height = 304
7+
Top = 0
8+
Width = 472
9+
Align = alClient
10+
ClientHeight = 304
11+
ClientWidth = 472
12+
TabOrder = 1
13+
object edCron: TEdit
14+
Left = 48
15+
Height = 35
16+
Top = 41
17+
Width = 375
18+
Alignment = taCenter
19+
Font.Height = -24
20+
Font.Name = 'Courier New'
21+
Font.Pitch = fpFixed
22+
OnChange = edCronChange
23+
ParentFont = False
24+
TabOrder = 0
25+
Text = '* * * * *'
26+
end
27+
object mmRuns: TMemo
28+
Left = 48
29+
Height = 180
30+
Top = 112
31+
Width = 375
32+
Color = clInfoBk
33+
Lines.Strings = (
34+
'mmRuns'
35+
)
36+
TabOrder = 1
37+
end
38+
object lblNextRuns: TLabel
39+
Left = 26
40+
Height = 25
41+
Top = 80
42+
Width = 79
43+
Caption = 'Next runs:'
44+
ParentColor = False
45+
end
46+
object lblDayMonth: TLabel
47+
Left = 198
48+
Height = 25
49+
Top = 16
50+
Width = 75
51+
Alignment = taCenter
52+
AutoSize = False
53+
Caption = 'Day'
54+
ParentColor = False
55+
end
56+
object lblMonth: TLabel
57+
Left = 273
58+
Height = 25
59+
Top = 16
60+
Width = 75
61+
Alignment = taCenter
62+
AutoSize = False
63+
Caption = 'Month'
64+
ParentColor = False
65+
end
66+
object lblWeekday: TLabel
67+
Left = 348
68+
Height = 25
69+
Top = 16
70+
Width = 75
71+
Alignment = taCenter
72+
AutoSize = False
73+
Caption = 'Week'
74+
ParentColor = False
75+
end
76+
object lblHour: TLabel
77+
Left = 123
78+
Height = 25
79+
Top = 16
80+
Width = 75
81+
Alignment = taCenter
82+
AutoSize = False
83+
Caption = 'Hour'
84+
ParentColor = False
85+
end
86+
object lblMinute: TLabel
87+
Left = 48
88+
Height = 25
89+
Top = 17
90+
Width = 75
91+
Alignment = taCenter
92+
AutoSize = False
93+
Caption = 'Minute'
94+
ParentColor = False
95+
end
96+
end
97+
inherited pnlButtons: TPanel[1]
98+
Width = 472
99+
ClientWidth = 472
100+
inherited btnCancel: TButton
101+
OnClick = FrameExit
102+
OnExit = nil
103+
end
104+
end
105+
end

‎forms/framecroneditor.pas‎

Lines changed: 92 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,92 @@
1+
unit frameCronEditor;
2+
3+
{$mode ObjFPC}{$H+}
4+
5+
interface
6+
7+
uses
8+
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
9+
framebase;
10+
11+
type
12+
13+
{ TfrmCronEditor }
14+
15+
TfrmCronEditor = class(TBaseFrame)
16+
edCron: TEdit;
17+
lblNextRuns: TLabel;
18+
lblDayMonth: TLabel;
19+
lblHour: TLabel;
20+
lblMinute: TLabel;
21+
lblWeekday: TLabel;
22+
lblMonth: TLabel;
23+
mmRuns: TMemo;
24+
pnlEditor: TPanel;
25+
procedure edCronChange(Sender: TObject);
26+
private
27+
28+
public
29+
function GetEditorValue(): string; override;
30+
procedure SetEditorValue(AText: string); override;
31+
procedure SetFocus; override;
32+
end;
33+
34+
implementation
35+
36+
uses RegExpr, uDataModule;
37+
38+
{$R *.lfm}
39+
40+
{ TfrmCronEditor }
41+
42+
procedure TfrmCronEditor.edCronChange(Sender: TObject);
43+
var
44+
ValidCron: boolean;
45+
S: string;
46+
const
47+
cronRE = '^(((\d+,)+\d+|(\d+(\/|-)\d+)|(\*(\/|-)\d+)|\d+|\*) +){4}'+
48+
'(((\d+,)+\d+|(\d+(\/|-)\d+)|(\*(\/|-)\d+)|\d+|\*) ?)$';
49+
sqlCronRuns = 'SELECT to_char(r.r, ''FMDay, FMDD FMMon YYYY at HH24:MI:SS'') FROM '+
50+
'generate_series(now(), now() + 10 * :cron :: interval, :cron :: interval) AS r(r) LIMIT 10';
51+
sqlIntervalRuns = 'SELECT to_char(r.r, ''FMDay, FMDD FMMon YYYY at HH24:MI:SS'') FROM '+
52+
'timetable.cron_runs(now(), $1) AS r(r) LIMIT 10';
53+
minIntervalLen = length('@every '); // @ modifier and at least one space char
54+
begin
55+
S := edCron.Text;
56+
ValidCron := S.Trim() = '@reboot';
57+
if not ValidCron then
58+
if S.StartsWith('@every ') or S.StartsWith('@after ') then //special values
59+
begin
60+
ValidCron := (S.Length > minIntervalLen) and dmPgEngine.IsCronValueValid(S);
61+
if ValidCron then
62+
mmRuns.Text := dmPgEngine.SelectSQL(sqlCronRuns, [S.Substring(minIntervalLen)]);
63+
end
64+
else
65+
with TRegExpr.Create(cronRE) do
66+
try
67+
ValidCron := Exec(S);
68+
if ValidCron then
69+
mmRuns.Text := dmPgEngine.SelectSQL(sqlIntervalRuns, [S]);
70+
finally
71+
Free();
72+
end;
73+
if ValidCron then edCron.Color := clDefault else edCron.Color := clRed;
74+
end;
75+
76+
function TfrmCronEditor.GetEditorValue: string;
77+
begin
78+
Exit(edCron.Text);
79+
end;
80+
81+
procedure TfrmCronEditor.SetEditorValue(AText: string);
82+
begin
83+
edCron.Text := AText;
84+
end;
85+
86+
procedure TfrmCronEditor.SetFocus;
87+
begin
88+
edCron.SetFocus();
89+
end;
90+
91+
end.
92+

‎forms/frametaskcommandeditor.pas‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,7 @@ TfrmTaskCommandEditor = class(TBaseFrame)
2121
function GetEditorValue(): string; override;
2222
procedure SetEditorValue(AText: string); override;
2323
procedure SetFocus; override;
24+
procedure CreateParams(var Params: TCreateParams); override;
2425
end;
2526

2627
implementation
@@ -53,5 +54,11 @@ procedure TfrmTaskCommandEditor.SetFocus;
5354
edCommand.SetFocus();
5455
end;
5556

57+
procedure TfrmTaskCommandEditor.CreateParams(var Params: TCreateParams);
58+
begin
59+
inherited CreateParams(Params);
60+
Params.Style := Params.Style or WS_SIZEBOX;
61+
end;
62+
5663
end.
5764

‎pg_timetable_gui.lpi‎

Lines changed: 9 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -118,7 +118,7 @@
118118
<PackageName Value="LCL"/>
119119
</Item4>
120120
</RequiredPackages>
121-
<Units Count="10">
121+
<Units Count="11">
122122
<Unit0>
123123
<Filename Value="pg_timetable_gui.lpr"/>
124124
<IsPartOfProject Value="True"/>
@@ -179,6 +179,14 @@
179179
<ResourceBaseClass Value="Frame"/>
180180
<UnitName Value="frameTaskCommandEditor"/>
181181
</Unit9>
182+
<Unit10>
183+
<Filename Value="forms\framecroneditor.pas"/>
184+
<IsPartOfProject Value="True"/>
185+
<ComponentName Value="frmCronEditor"/>
186+
<HasResources Value="True"/>
187+
<ResourceBaseClass Value="Frame"/>
188+
<UnitName Value="frameCronEditor"/>
189+
</Unit10>
182190
</Units>
183191
</ProjectOptions>
184192
<CompilerOptions>

‎pg_timetable_gui.lpr‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@
88
lazcontrols,
99
fmMain, fmConnect,
1010
uDataModule,
11-
uObjects, frameTaskCommandEditor;
11+
uObjects, frameTaskCommandEditor, frameCronEditor;
1212

1313
{$R *.res}
1414

0 commit comments

Comments
 (0)