1 | unit ORDtTmRng;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
7 | StdCtrls, ORFn, ORDtTm;
|
---|
8 |
|
---|
9 | type
|
---|
10 | TORfrmDateRange = class(TForm)
|
---|
11 | lblStart: TLabel;
|
---|
12 | lblStop: TLabel;
|
---|
13 | cmdOK: TButton;
|
---|
14 | cmdCancel: TButton;
|
---|
15 | lblInstruct: TLabel;
|
---|
16 | procedure cmdOKClick(Sender: TObject);
|
---|
17 | procedure cmdCancelClick(Sender: TObject);
|
---|
18 | procedure FormCreate(Sender: TObject);
|
---|
19 | procedure FormDestroy(Sender: TObject);
|
---|
20 | private
|
---|
21 | FCalStart: TORDateBox;
|
---|
22 | FCalStop: TORDateBox;
|
---|
23 | end;
|
---|
24 |
|
---|
25 | TORDateRangeDlg = class(TComponent)
|
---|
26 | private
|
---|
27 | FTextOfStart: string;
|
---|
28 | FTextOfStop: string;
|
---|
29 | FFMDateStart: TFMDateTime;
|
---|
30 | FFMDateStop: TFMDateTime;
|
---|
31 | FRelativeStart: string;
|
---|
32 | FRelativeStop: string;
|
---|
33 | FDateOnly: Boolean;
|
---|
34 | FRequireTime: Boolean;
|
---|
35 | FInstruction: string;
|
---|
36 | FLabelStart: string;
|
---|
37 | FLabelStop: string;
|
---|
38 | FFormat: string;
|
---|
39 | procedure SetDateOnly(Value: Boolean);
|
---|
40 | procedure SetFMDateStart(Value: TFMDateTime);
|
---|
41 | procedure SetFMDateStop(Value: TFMDateTime);
|
---|
42 | procedure SetTextOfStart(const Value: string);
|
---|
43 | procedure SetTextOfStop(const Value: string);
|
---|
44 | procedure SetRequireTime(Value: Boolean);
|
---|
45 | public
|
---|
46 | constructor Create(AOwner: TComponent); override;
|
---|
47 | function Execute: Boolean;
|
---|
48 | property RelativeStart: string read FRelativeStart;
|
---|
49 | property RelativeStop: string read FRelativeStop;
|
---|
50 | published
|
---|
51 | property DateOnly: Boolean read FDateOnly write SetDateOnly;
|
---|
52 | property FMDateStart: TFMDateTime read FFMDateStart write SetFMDateStart;
|
---|
53 | property FMDateStop: TFMDateTime read FFMDateStop write SetFMDateStop;
|
---|
54 | property Instruction: string read FInstruction write FInstruction;
|
---|
55 | property LabelStart: string read FLabelStart write FLabelStart;
|
---|
56 | property LabelStop: string read FLabelStop write FLabelStop;
|
---|
57 | property RequireTime: Boolean read FRequireTime write SetRequireTime;
|
---|
58 | property Format: string read FFormat write FFormat;
|
---|
59 | property TextOfStart: string read FTextOfStart write SetTextOfStart;
|
---|
60 | property TextOfStop: string read FTextOfStop write SetTextOfStop;
|
---|
61 | end;
|
---|
62 |
|
---|
63 | procedure Register;
|
---|
64 |
|
---|
65 | implementation
|
---|
66 |
|
---|
67 | {$R *.DFM}
|
---|
68 |
|
---|
69 | const
|
---|
70 | FMT_DATETIME = 'mmm d,yy@hh:nn';
|
---|
71 | FMT_DATEONLY = 'mmm d,yy';
|
---|
72 |
|
---|
73 | { TORDateRangeDlg --------------------------------------------------------------------------- }
|
---|
74 |
|
---|
75 | constructor TORDateRangeDlg.Create(AOwner: TComponent);
|
---|
76 | begin
|
---|
77 | inherited Create(AOwner);
|
---|
78 | FInstruction := 'Enter a date range -';
|
---|
79 | FLabelStart := 'Begin Date';
|
---|
80 | FLabelStop := 'End Date';
|
---|
81 | FFormat := FMT_DATETIME;
|
---|
82 | end;
|
---|
83 |
|
---|
84 | function TORDateRangeDlg.Execute: Boolean;
|
---|
85 | var
|
---|
86 | frmDateRange: TORfrmDateRange;
|
---|
87 | begin
|
---|
88 | frmDateRange := TORfrmDateRange.Create(Application);
|
---|
89 | try
|
---|
90 | with frmDateRange do
|
---|
91 | begin
|
---|
92 | FCalStart.Text := FTextOfStart;
|
---|
93 | FCalStop.Text := FTextOfStop;
|
---|
94 | if FFMDateStart > 0 then
|
---|
95 | begin
|
---|
96 | FCalStart.FMDateTime := FFMDateStart;
|
---|
97 | FCalStart.Text := FormatFMDateTime(FFormat, FFMDateStart);
|
---|
98 | end;
|
---|
99 | if FFMDateStop > 0 then
|
---|
100 | begin
|
---|
101 | FCalStop.FMDateTime := FFMDateStop;
|
---|
102 | FCalStop.Text := FormatFMDateTime(FFormat, FFMDateStop);
|
---|
103 | end;
|
---|
104 | FCalStart.DateOnly := FDateOnly;
|
---|
105 | FCalStop.DateOnly := FDateOnly;
|
---|
106 | FCalStart.RequireTime := FRequireTime;
|
---|
107 | FCalStop.RequireTime := FRequireTime;
|
---|
108 | lblInstruct.Caption := FInstruction;
|
---|
109 | lblStart.Caption := FLabelStart;
|
---|
110 | lblStop.Caption := FLabelStop;
|
---|
111 |
|
---|
112 | Result := (ShowModal = IDOK);
|
---|
113 | if Result then
|
---|
114 | begin
|
---|
115 | FTextOfStart := FCalStart.Text;
|
---|
116 | FTextOfStop := FCalStop.Text;
|
---|
117 | FFMDateStart := FCalStart.FMDateTime;
|
---|
118 | FFMDateStop := FCalStop.FMDateTime;
|
---|
119 | FRelativeStart := FCalStart.RelativeTime;
|
---|
120 | FRelativeStop := FCalStop.RelativeTime;
|
---|
121 | end;
|
---|
122 | end;
|
---|
123 | finally
|
---|
124 | frmDateRange.Free;
|
---|
125 | end;
|
---|
126 | end;
|
---|
127 |
|
---|
128 | procedure TORDateRangeDlg.SetDateOnly(Value: Boolean);
|
---|
129 | begin
|
---|
130 | FDateOnly := Value;
|
---|
131 | if FDateOnly then
|
---|
132 | begin
|
---|
133 | FRequireTime := False;
|
---|
134 | FMDateStart := Int(FFMDateStart);
|
---|
135 | FMDateStop := Int(FFMDateStop);
|
---|
136 | if FFormat = FMT_DATETIME then FFormat := FMT_DATEONLY;
|
---|
137 | end;
|
---|
138 | end;
|
---|
139 |
|
---|
140 | procedure TORDateRangeDlg.SetRequireTime(Value: Boolean);
|
---|
141 | begin
|
---|
142 | FRequireTime := Value;
|
---|
143 | if FRequireTime then
|
---|
144 | begin
|
---|
145 | if FFormat = FMT_DATEONLY then FFormat := FMT_DATETIME;
|
---|
146 | SetDateOnly(False);
|
---|
147 | end;
|
---|
148 | end;
|
---|
149 |
|
---|
150 | procedure TORDateRangeDlg.SetFMDateStart(Value: TFMDateTime);
|
---|
151 | begin
|
---|
152 | FFMDateStart := Value;
|
---|
153 | FTextOfStart := FormatFMDateTime(FFormat, FFMDateStart);
|
---|
154 | end;
|
---|
155 |
|
---|
156 | procedure TORDateRangeDlg.SetFMDateStop(Value: TFMDateTime);
|
---|
157 | begin
|
---|
158 | FFMDateStop := Value;
|
---|
159 | FTextOfStop := FormatFMDateTime(FFormat, FFMDateStop);
|
---|
160 | end;
|
---|
161 |
|
---|
162 | procedure TORDateRangeDlg.SetTextOfStart(const Value: string);
|
---|
163 | begin
|
---|
164 | FTextOfStart := Value;
|
---|
165 | FFMDateStart := 0;
|
---|
166 | end;
|
---|
167 |
|
---|
168 | procedure TORDateRangeDlg.SetTextOfStop(const Value: string);
|
---|
169 | begin
|
---|
170 | FTextOfStop := Value;
|
---|
171 | FFMDateStop := 0;
|
---|
172 | end;
|
---|
173 |
|
---|
174 |
|
---|
175 | { TORfrmDateRange --------------------------------------------------------------------------- }
|
---|
176 |
|
---|
177 | procedure TORfrmDateRange.cmdOKClick(Sender: TObject);
|
---|
178 | var
|
---|
179 | ErrMsg: string;
|
---|
180 | begin
|
---|
181 | FCalStart.Validate(ErrMsg);
|
---|
182 | if ErrMsg <> '' then
|
---|
183 | begin
|
---|
184 | Application.MessageBox(PChar(ErrMsg), 'Start Date Error', MB_OK);
|
---|
185 | Exit;
|
---|
186 | end;
|
---|
187 | FCalStop.Validate(ErrMsg);
|
---|
188 | if ErrMsg <> '' then
|
---|
189 | begin
|
---|
190 | Application.MessageBox(PChar(ErrMsg), 'Stop Date Error', MB_OK);
|
---|
191 | Exit;
|
---|
192 | end;
|
---|
193 | ModalResult := mrOK;
|
---|
194 | end;
|
---|
195 |
|
---|
196 | procedure TORfrmDateRange.cmdCancelClick(Sender: TObject);
|
---|
197 | begin
|
---|
198 | ModalResult := mrCancel;
|
---|
199 | end;
|
---|
200 |
|
---|
201 | procedure Register;
|
---|
202 | { used by Delphi to put components on the Palette }
|
---|
203 | begin
|
---|
204 | RegisterComponents('CPRS', [TORDateRangeDlg]);
|
---|
205 | end;
|
---|
206 |
|
---|
207 | procedure TORfrmDateRange.FormCreate(Sender: TObject);
|
---|
208 | { Create date boxes here to avoid problem where TORDateBox is not already on component palette. }
|
---|
209 | begin
|
---|
210 | FCalStart := TORDateBox.Create(Self);
|
---|
211 | FCalStart.Parent := Self;
|
---|
212 | FCalStart.SetBounds(8, 58, 121, 21);
|
---|
213 | FCalStart.TabOrder := 0;
|
---|
214 | FCalStop := TORDateBox.Create(Self);
|
---|
215 | FCalStop.Parent := Self;
|
---|
216 | FCalStop.SetBounds(145, 58, 121, 21);
|
---|
217 | FCalStop.TabOrder := 1;
|
---|
218 | ResizeAnchoredFormToFont(self);
|
---|
219 | end;
|
---|
220 |
|
---|
221 | procedure TORfrmDateRange.FormDestroy(Sender: TObject);
|
---|
222 | begin
|
---|
223 | FCalStart.Free;
|
---|
224 | FCalStop.Free;
|
---|
225 | end;
|
---|
226 |
|
---|
227 | end.
|
---|