1 | //kt -- Modified with SourceScanner on 8/8/2007
|
---|
2 | unit fOptionsOther;
|
---|
3 |
|
---|
4 | interface
|
---|
5 |
|
---|
6 | uses
|
---|
7 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
8 | StdCtrls, ExtCtrls, ComCtrls, ORCtrls, ORFn, rOrders, uCore, ORDtTm,
|
---|
9 | DKLang;
|
---|
10 |
|
---|
11 | type
|
---|
12 | TfrmOptionsOther = class(TForm)
|
---|
13 | pnlBottom: TPanel;
|
---|
14 | btnOK: TButton;
|
---|
15 | btnCancel: TButton;
|
---|
16 | bvlBottom: TBevel;
|
---|
17 | stStart: TStaticText;
|
---|
18 | stStop: TStaticText;
|
---|
19 | dtStart: TORDateBox;
|
---|
20 | dtStop: TORDateBox;
|
---|
21 | lblMedsTab: TLabel;
|
---|
22 | lblTabDefault: TStaticText;
|
---|
23 | lblTab: TLabel;
|
---|
24 | cboTab: TORComboBox;
|
---|
25 | chkLastTab: TCheckBox;
|
---|
26 | Bevel1: TBevel;
|
---|
27 | lblEncAppts: TLabel;
|
---|
28 | stStartEncAppts: TStaticText;
|
---|
29 | txtTodayMinus: TStaticText;
|
---|
30 | txtEncStart: TCaptionEdit;
|
---|
31 | txtDaysMinus: TStaticText;
|
---|
32 | spnEncStart: TUpDown;
|
---|
33 | txtDaysPlus: TStaticText;
|
---|
34 | spnEncStop: TUpDown;
|
---|
35 | txtEncStop: TCaptionEdit;
|
---|
36 | txtTodayPlus: TStaticText;
|
---|
37 | stStopEncAppts: TStaticText;
|
---|
38 | Bevel2: TBevel;
|
---|
39 | btnEncDefaults: TButton;
|
---|
40 | DKLanguageController1: TDKLanguageController;
|
---|
41 | TabPositionComboBox: TComboBox;
|
---|
42 | Label1: TLabel;
|
---|
43 | Label2: TLabel;
|
---|
44 | pnlShowColor: TPanel;
|
---|
45 | ColorDialog: TColorDialog;
|
---|
46 | Label3: TLabel;
|
---|
47 | cboTabColors: TComboBox;
|
---|
48 | procedure FormShow(Sender: TObject);
|
---|
49 | procedure btnOKClick(Sender: TObject);
|
---|
50 | procedure FormCreate(Sender: TObject);
|
---|
51 | procedure dtStartExit(Sender: TObject);
|
---|
52 | procedure dtStopExit(Sender: TObject);
|
---|
53 | procedure dtStartChange(Sender: TObject);
|
---|
54 | procedure txtEncStartChange(Sender: TObject);
|
---|
55 | procedure txtEncStopChange(Sender: TObject);
|
---|
56 | procedure txtEncStartExit(Sender: TObject);
|
---|
57 | procedure txtEncStopExit(Sender: TObject);
|
---|
58 | procedure btnEncDefaultsClick(Sender: TObject);
|
---|
59 | procedure TabPositionComboBoxChange(Sender: TObject);
|
---|
60 | procedure cboTabColorsChange(Sender: TObject);
|
---|
61 | procedure pnlShowColorClick(Sender: TObject);
|
---|
62 | private
|
---|
63 | { Private declarations }
|
---|
64 | FstartDt: TFMDateTime;
|
---|
65 | FstopDt: TFMDateTime;
|
---|
66 | FEncStartDays, FEncStopDays, FEncDefStartDays, FEncDefStopDays: integer;
|
---|
67 | //FDefaultEvent: string;
|
---|
68 | public
|
---|
69 | { Public declarations }
|
---|
70 | end;
|
---|
71 |
|
---|
72 | var
|
---|
73 | frmOptionsOther: TfrmOptionsOther;
|
---|
74 |
|
---|
75 | const
|
---|
76 | ENC_MAX_LIMIT = 999;
|
---|
77 |
|
---|
78 |
|
---|
79 | procedure DialogOptionsOther(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
|
---|
80 | procedure SetTabPosition(Position : TTabPosition);
|
---|
81 |
|
---|
82 | implementation
|
---|
83 |
|
---|
84 | {$R *.DFM}
|
---|
85 |
|
---|
86 | uses
|
---|
87 | rOptions, uOptions, rCore, rSurgery, uConst, fMeds, fFrame;
|
---|
88 |
|
---|
89 | procedure DialogOptionsOther(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
|
---|
90 | // create the form and make it modal, return an action
|
---|
91 | var
|
---|
92 | frmOptionsOther: TfrmOptionsOther;
|
---|
93 | begin
|
---|
94 | frmOptionsOther := TfrmOptionsOther.Create(Application);
|
---|
95 | actiontype := 0;
|
---|
96 | try
|
---|
97 | with frmOptionsOther do
|
---|
98 | begin
|
---|
99 | if (topvalue < 0) or (leftvalue < 0) then
|
---|
100 | Position := poScreenCenter
|
---|
101 | else
|
---|
102 | begin
|
---|
103 | Position := poDesigned;
|
---|
104 | Top := topvalue;
|
---|
105 | Left := leftvalue;
|
---|
106 | end;
|
---|
107 | ResizeAnchoredFormToFont(frmOptionsOther);
|
---|
108 | ShowModal;
|
---|
109 | actiontype := btnOK.Tag;
|
---|
110 | end;
|
---|
111 | finally
|
---|
112 | frmOptionsOther.Release;
|
---|
113 | end;
|
---|
114 | end;
|
---|
115 |
|
---|
116 | procedure TfrmOptionsOther.FormShow(Sender: TObject);
|
---|
117 | // displays defaults
|
---|
118 | // opening tab^use last tab^autosave seconds^verify note title
|
---|
119 | var
|
---|
120 | last: integer;
|
---|
121 | values, tab: string;
|
---|
122 | begin
|
---|
123 | cboTabColors.Items.Assign(uTabColorsList); //kt added8808
|
---|
124 | cboTabColors.ItemIndex := 0; //kt
|
---|
125 | cboTab.Items.Assign(rpcGetOtherTabs); //kt
|
---|
126 | cboTabColorsChange(nil); //kt
|
---|
127 | //if (cboTab.Items.IndexOf('Surgery') > -1) and (not ShowSurgeryTab) then <-- original line. //kt 8/8/2007
|
---|
128 | if (cboTab.Items.IndexOf(DKLangConstW('fOptionsOther_Surgery')) > -1) and (not ShowSurgeryTab) then //kt added 8/8/2007
|
---|
129 | // cboTab.Items.Delete(cboTab.Items.IndexOf('Surgery')); <-- original line. //kt 8/8/2007
|
---|
130 | cboTab.Items.Delete(cboTab.Items.IndexOf(DKLangConstW('fOptionsOther_Surgery'))); //kt added 8/8/2007
|
---|
131 | values := rpcGetOther;
|
---|
132 | tab := Piece(values, '^', 1);
|
---|
133 | last := strtointdef(Piece(values, '^', 2), 0);
|
---|
134 | cboTab.SelectByID(tab);
|
---|
135 | cboTab.Tag := strtointdef(tab, -1);
|
---|
136 | chkLastTab.Checked := last = 1;
|
---|
137 | chkLastTab.Tag := last;
|
---|
138 | cboTab.SetFocus;
|
---|
139 | rpcGetRangeForMeds(FstartDt, FstopDt);
|
---|
140 | if FstartDt > 1 then
|
---|
141 | dtStart.Text := FormatFMDateTime('mmm d, yyyy',FstartDt);
|
---|
142 | if FstopDt > 1 then
|
---|
143 | dtStop.Text := FormatFMDateTime('mmm d, yyyy', FstopDt);
|
---|
144 | rpcGetRangeForEncs(FEncDefStartDays, FEncDefStopDays, True); // True gets params settings above User/Service level.
|
---|
145 | if FEncDefStartDays < 1 then
|
---|
146 | FEncDefStartDays := 0;
|
---|
147 | if FEncDefStopDays < 1 then
|
---|
148 | FEncDefStopDays := 0;
|
---|
149 | rpcGetRangeForEncs(FEncStartDays, FEncStopDays, False); // False gets User/Service params.
|
---|
150 | if ((FEncStartDays < 0) and (FEncStartDays <> 0)) then
|
---|
151 | FEncStartDays := FEncDefStartDays;
|
---|
152 | txtEncStart.Text := IntToStr(FEncStartDays);
|
---|
153 | if ((FEncStopDays < 0) and (FEncStopDays <> 0)) then
|
---|
154 | FEncStopDays := FEncDefStopDays;
|
---|
155 | txtEncStop.Text := IntToStr(FEncStopDays);
|
---|
156 | end;
|
---|
157 |
|
---|
158 | procedure TfrmOptionsOther.btnOKClick(Sender: TObject);
|
---|
159 | // opening tab^use last tab^autosave seconds^verify note title
|
---|
160 | var
|
---|
161 | values, theVal: string;
|
---|
162 | begin
|
---|
163 | values := '';
|
---|
164 | if cboTab.ItemIEN <> cboTab.Tag then
|
---|
165 | values := values + cboTab.ItemID;
|
---|
166 | values := values + '^';
|
---|
167 | if chkLastTab.Checked then
|
---|
168 | if chkLastTab.Tag <> 1 then
|
---|
169 | values := values + '1';
|
---|
170 | if not chkLastTab.Checked then
|
---|
171 | if chkLastTab.Tag <> 0 then
|
---|
172 | values := values + '0';
|
---|
173 | values := values + '^^';
|
---|
174 | rpcSetOther(values);
|
---|
175 | if (dtStop.FMDateTime > 0) and (dtStart.FMDateTime > 0) then
|
---|
176 | begin
|
---|
177 | if dtStop.FMDateTime < dtStart.FMDateTime then
|
---|
178 | begin
|
---|
179 | // ShowMessage('The stop time can not prior to the start time.'); <-- original line. //kt 8/8/2007
|
---|
180 | ShowMessage(DKLangConstW('fOptionsOther_The_stop_time_can_not_prior_to_the_start_timex')); //kt added 8/8/2007
|
---|
181 | dtStop.FMDateTime := FMToday;
|
---|
182 | dtStop.SetFocus;
|
---|
183 | Exit;
|
---|
184 | end;
|
---|
185 | theVal := dtStart.RelativeTime + ';' + dtStop.RelativeTime;
|
---|
186 | rpcPutRangeForMeds(theVal);
|
---|
187 | end;
|
---|
188 | if (dtStart.Text = '') and (dtStop.Text = '') then
|
---|
189 | rpcPutRangeForMeds('');
|
---|
190 | rpcPutRangeForEncs(txtEncStart.Text, txtEncStop.Text);
|
---|
191 | if frmMeds <> nil then
|
---|
192 | frmMeds.RefreshMedLists;
|
---|
193 | end;
|
---|
194 |
|
---|
195 | procedure TfrmOptionsOther.FormCreate(Sender: TObject);
|
---|
196 | begin
|
---|
197 | FStartDT := 0;
|
---|
198 | FStopDT := 0;
|
---|
199 | end;
|
---|
200 |
|
---|
201 | procedure TfrmOptionsOther.dtStartExit(Sender: TObject);
|
---|
202 | begin
|
---|
203 | if dtStart.FMDateTime > FMToday then
|
---|
204 | begin
|
---|
205 | // ShowMessage('Start time can not greater than today.'); <-- original line. //kt 8/8/2007
|
---|
206 | ShowMessage(DKLangConstW('fOptionsOther_Start_time_can_not_greater_than_todayx')); //kt added 8/8/2007
|
---|
207 | dtStart.FMDateTime := FMToday;
|
---|
208 | dtStart.SetFocus;
|
---|
209 | Exit;
|
---|
210 | end;
|
---|
211 | end;
|
---|
212 |
|
---|
213 | procedure TfrmOptionsOther.dtStopExit(Sender: TObject);
|
---|
214 | begin
|
---|
215 | if (dtStop.FMDateTime > 0) and (dtStart.FMDateTime > 0) then
|
---|
216 | if (dtStop.FMDateTime < dtStart.FMDateTime) then
|
---|
217 | begin
|
---|
218 | // ShowMessage('Stop time can not prior to start time'); <-- original line. //kt 8/8/2007
|
---|
219 | ShowMessage(DKLangConstW('fOptionsOther_Stop_time_can_not_prior_to_start_time')); //kt added 8/8/2007
|
---|
220 | dtStop.FMDateTime := FMToday;
|
---|
221 | dtStop.SetFocus;
|
---|
222 | Exit;
|
---|
223 | end;
|
---|
224 | end;
|
---|
225 |
|
---|
226 | procedure TfrmOptionsOther.dtStartChange(Sender: TObject);
|
---|
227 | begin
|
---|
228 | if (dtStart.FMDateTime > FMToday) then
|
---|
229 | begin
|
---|
230 | // ShowMessage('Start time can not greater than today.'); <-- original line. //kt 8/8/2007
|
---|
231 | ShowMessage(DKLangConstW('fOptionsOther_Start_time_can_not_greater_than_todayx')); //kt added 8/8/2007
|
---|
232 | dtStart.FMDateTime := FMToday;
|
---|
233 | dtStart.SetFocus;
|
---|
234 | Exit;
|
---|
235 | end;
|
---|
236 | end;
|
---|
237 |
|
---|
238 | procedure TfrmOptionsOther.txtEncStartChange(Sender: TObject);
|
---|
239 | begin
|
---|
240 | with txtEncStart do
|
---|
241 | begin
|
---|
242 | if Text = '' then
|
---|
243 | Exit;
|
---|
244 | if Text = ' ' then
|
---|
245 | Text := '0';
|
---|
246 | if StrToInt(Text) < 0 then
|
---|
247 | Text := '0';
|
---|
248 | if StrToIntDef(Text, ENC_MAX_LIMIT) > ENC_MAX_LIMIT then
|
---|
249 | begin
|
---|
250 | Text := IntToStr(ENC_MAX_LIMIT);
|
---|
251 | Beep;
|
---|
252 | // InfoBox('Number must be < ' + IntToStr(ENC_MAX_LIMIT), 'Warning', MB_OK or MB_ICONWARNING); <-- original line. //kt 8/8/2007
|
---|
253 | InfoBox(DKLangConstW('fOptionsOther_Number_must_be_x')+' ' + IntToStr(ENC_MAX_LIMIT), DKLangConstW('fOptionsOther_Warning'), MB_OK or MB_ICONWARNING); //kt added 8/8/2007
|
---|
254 | end;
|
---|
255 | end;
|
---|
256 | end;
|
---|
257 |
|
---|
258 | procedure TfrmOptionsOther.txtEncStopChange(Sender: TObject);
|
---|
259 | begin
|
---|
260 | with txtEncStop do
|
---|
261 | begin
|
---|
262 | if Text = '' then
|
---|
263 | Exit;
|
---|
264 | if Text = ' ' then
|
---|
265 | Text := '0';
|
---|
266 | if StrToInt(Text) < 0 then
|
---|
267 | Text := '0';
|
---|
268 | if StrToIntDef(Text, ENC_MAX_LIMIT) > ENC_MAX_LIMIT then
|
---|
269 | begin
|
---|
270 | Text := IntToStr(ENC_MAX_LIMIT);
|
---|
271 | Beep;
|
---|
272 | // InfoBox('Number must be < ' + IntToStr(ENC_MAX_LIMIT), 'Warning', MB_OK or MB_ICONWARNING); <-- original line. //kt 8/8/2007
|
---|
273 | InfoBox(DKLangConstW('fOptionsOther_Number_must_be_x') + IntToStr(ENC_MAX_LIMIT), DKLangConstW('fOptionsOther_Warning'), MB_OK or MB_ICONWARNING); //kt added 8/8/2007
|
---|
274 | end;
|
---|
275 | end;
|
---|
276 | end;
|
---|
277 |
|
---|
278 | procedure TfrmOptionsOther.txtEncStartExit(Sender: TObject);
|
---|
279 | begin
|
---|
280 | with txtEncStart do
|
---|
281 | if Text = '' then
|
---|
282 | Text := '0';
|
---|
283 | end;
|
---|
284 |
|
---|
285 | procedure TfrmOptionsOther.txtEncStopExit(Sender: TObject);
|
---|
286 | begin
|
---|
287 | with txtEncStart do
|
---|
288 | if Text = '' then
|
---|
289 | Text := '0';
|
---|
290 | end;
|
---|
291 |
|
---|
292 | procedure TfrmOptionsOther.btnEncDefaultsClick(Sender: TObject);
|
---|
293 | begin
|
---|
294 | txtEncStart.Text := IntToStr(FEncDefStartDays);
|
---|
295 | txtEncStop.Text := IntToStr(FEncDefStopDays);
|
---|
296 | end;
|
---|
297 |
|
---|
298 | procedure TfrmOptionsOther.TabPositionComboBoxChange(Sender: TObject);
|
---|
299 | //kt added 8/8/08
|
---|
300 | begin
|
---|
301 | Case TabPositionComboBox.ItemIndex of
|
---|
302 | 0 : SetTabPosition(tpBottom);
|
---|
303 | 1 : SetTabPosition(tpTop);
|
---|
304 | 2 : SetTabPosition(tpLeft);
|
---|
305 | 3 : SetTabPosition(tpRight);
|
---|
306 | end; {case}
|
---|
307 | end;
|
---|
308 |
|
---|
309 | procedure SetTabPosition(Position : TTabPosition);
|
---|
310 | //kt added 8/8/08
|
---|
311 | begin
|
---|
312 | frmFrame.tabPage.TabPosition := Position;
|
---|
313 | Case Position of
|
---|
314 | tpBottom : frmFrame.tabPage.Align := alBottom;
|
---|
315 | tpTop: frmFrame.tabPage.Align := alTop;
|
---|
316 | tpLeft: frmFrame.tabPage.Align := alLeft;
|
---|
317 | tpRight : frmFrame.tabPage.Align := alRight;
|
---|
318 | end; {case}
|
---|
319 | end;
|
---|
320 |
|
---|
321 |
|
---|
322 | procedure TfrmOptionsOther.cboTabColorsChange(Sender: TObject);
|
---|
323 | var color : TColor;
|
---|
324 | selIndex : integer;
|
---|
325 | begin
|
---|
326 | selIndex := cboTabColors.ItemIndex;
|
---|
327 | if selIndex < 0 then exit;
|
---|
328 | color := TColor(cboTabColors.Items.Objects[selIndex]);
|
---|
329 | pnlShowColor.Color := color;
|
---|
330 | end;
|
---|
331 |
|
---|
332 | procedure TfrmOptionsOther.pnlShowColorClick(Sender: TObject);
|
---|
333 | //kt added 8/8/08
|
---|
334 | var s : string;
|
---|
335 | selIndex : integer;
|
---|
336 | begin
|
---|
337 | if ColorDialog.Execute then begin
|
---|
338 | pnlShowColor.Color := ColorDialog.Color;
|
---|
339 | selIndex := cboTabColors.ItemIndex;
|
---|
340 | if selIndex < 0 then exit;
|
---|
341 | cboTabColors.Items.Objects[selIndex] := pointer(ColorDialog.Color);
|
---|
342 | uTabColorsList.Objects[selIndex] := pointer(ColorDialog.Color);
|
---|
343 | end;
|
---|
344 | end;
|
---|
345 |
|
---|
346 | end.
|
---|