source: cprs/branches/HealthSevak-CPRS/CPRS-Lib/ORDtTmRng.pas@ 1714

Last change on this file since 1714 was 829, checked in by Kevin Toppenberg, 14 years ago

Upgrade to version 27

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