source: cprs/branches/GUI-config/CPRS-Lib/ORDtTmRng.pas@ 755

Last change on this file since 755 was 476, checked in by Kevin Toppenberg, 16 years ago

New WorldVistA Config Utility

File size: 6.3 KB
Line 
1unit ORDtTmRng;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ORFn, ORDtTm;
8
9type
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
65implementation
66
67{$R *.DFM}
68
69const
70 FMT_DATETIME = 'mmm d,yy@hh:nn';
71 FMT_DATEONLY = 'mmm d,yy';
72
73{ TORDateRangeDlg --------------------------------------------------------------------------- }
74
75constructor TORDateRangeDlg.Create(AOwner: TComponent);
76begin
77 inherited Create(AOwner);
78 FInstruction := 'Enter a date range -';
79 FLabelStart := 'Begin Date';
80 FLabelStop := 'End Date';
81 FFormat := FMT_DATETIME;
82end;
83
84function TORDateRangeDlg.Execute: Boolean;
85var
86 frmDateRange: TORfrmDateRange;
87begin
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;
126end;
127
128procedure TORDateRangeDlg.SetDateOnly(Value: Boolean);
129begin
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;
138end;
139
140procedure TORDateRangeDlg.SetRequireTime(Value: Boolean);
141begin
142 FRequireTime := Value;
143 if FRequireTime then
144 begin
145 if FFormat = FMT_DATEONLY then FFormat := FMT_DATETIME;
146 SetDateOnly(False);
147 end;
148end;
149
150procedure TORDateRangeDlg.SetFMDateStart(Value: TFMDateTime);
151begin
152 FFMDateStart := Value;
153 FTextOfStart := FormatFMDateTime(FFormat, FFMDateStart);
154end;
155
156procedure TORDateRangeDlg.SetFMDateStop(Value: TFMDateTime);
157begin
158 FFMDateStop := Value;
159 FTextOfStop := FormatFMDateTime(FFormat, FFMDateStop);
160end;
161
162procedure TORDateRangeDlg.SetTextOfStart(const Value: string);
163begin
164 FTextOfStart := Value;
165 FFMDateStart := 0;
166end;
167
168procedure TORDateRangeDlg.SetTextOfStop(const Value: string);
169begin
170 FTextOfStop := Value;
171 FFMDateStop := 0;
172end;
173
174
175{ TORfrmDateRange --------------------------------------------------------------------------- }
176
177procedure TORfrmDateRange.cmdOKClick(Sender: TObject);
178var
179 ErrMsg: string;
180begin
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;
194end;
195
196procedure TORfrmDateRange.cmdCancelClick(Sender: TObject);
197begin
198 ModalResult := mrCancel;
199end;
200
201procedure Register;
202{ used by Delphi to put components on the Palette }
203begin
204 RegisterComponents('CPRS', [TORDateRangeDlg]);
205end;
206
207procedure TORfrmDateRange.FormCreate(Sender: TObject);
208{ Create date boxes here to avoid problem where TORDateBox is not already on component palette. }
209begin
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);
219end;
220
221procedure TORfrmDateRange.FormDestroy(Sender: TObject);
222begin
223 FCalStart.Free;
224 FCalStop.Free;
225end;
226
227end.
Note: See TracBrowser for help on using the repository browser.