source: cprs/branches/tmg-cprs/CPRS-Chart/Options/fOptionsOther.pas@ 473

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

Added Colorful Tabs, Changable Tab positions, Demographics translation enabled
File size: 10.9 KB
Line 
1//kt -- Modified with SourceScanner on 8/8/2007
2unit fOptionsOther;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 StdCtrls, ExtCtrls, ComCtrls, ORCtrls, ORFn, rOrders, uCore, ORDtTm,
9 DKLang;
10
11type
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
72var
73 frmOptionsOther: TfrmOptionsOther;
74
75const
76 ENC_MAX_LIMIT = 999;
77
78
79procedure DialogOptionsOther(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
80procedure SetTabPosition(Position : TTabPosition);
81
82implementation
83
84{$R *.DFM}
85
86uses
87 rOptions, uOptions, rCore, rSurgery, uConst, fMeds, fFrame;
88
89procedure DialogOptionsOther(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
90// create the form and make it modal, return an action
91var
92 frmOptionsOther: TfrmOptionsOther;
93begin
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;
114end;
115
116procedure TfrmOptionsOther.FormShow(Sender: TObject);
117// displays defaults
118// opening tab^use last tab^autosave seconds^verify note title
119var
120 last: integer;
121 values, tab: string;
122begin
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);
156end;
157
158procedure TfrmOptionsOther.btnOKClick(Sender: TObject);
159// opening tab^use last tab^autosave seconds^verify note title
160var
161 values, theVal: string;
162begin
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;
193end;
194
195procedure TfrmOptionsOther.FormCreate(Sender: TObject);
196begin
197 FStartDT := 0;
198 FStopDT := 0;
199end;
200
201procedure TfrmOptionsOther.dtStartExit(Sender: TObject);
202begin
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;
211end;
212
213procedure TfrmOptionsOther.dtStopExit(Sender: TObject);
214begin
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;
224end;
225
226procedure TfrmOptionsOther.dtStartChange(Sender: TObject);
227begin
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;
236end;
237
238procedure TfrmOptionsOther.txtEncStartChange(Sender: TObject);
239begin
240with 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;
256end;
257
258procedure TfrmOptionsOther.txtEncStopChange(Sender: TObject);
259begin
260with 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;
276end;
277
278procedure TfrmOptionsOther.txtEncStartExit(Sender: TObject);
279begin
280with txtEncStart do
281 if Text = '' then
282 Text := '0';
283end;
284
285procedure TfrmOptionsOther.txtEncStopExit(Sender: TObject);
286begin
287with txtEncStart do
288 if Text = '' then
289 Text := '0';
290end;
291
292procedure TfrmOptionsOther.btnEncDefaultsClick(Sender: TObject);
293begin
294txtEncStart.Text := IntToStr(FEncDefStartDays);
295txtEncStop.Text := IntToStr(FEncDefStopDays);
296end;
297
298procedure TfrmOptionsOther.TabPositionComboBoxChange(Sender: TObject);
299//kt added 8/8/08
300begin
301 Case TabPositionComboBox.ItemIndex of
302 0 : SetTabPosition(tpBottom);
303 1 : SetTabPosition(tpTop);
304 2 : SetTabPosition(tpLeft);
305 3 : SetTabPosition(tpRight);
306 end; {case}
307end;
308
309procedure SetTabPosition(Position : TTabPosition);
310//kt added 8/8/08
311begin
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}
319end;
320
321
322procedure TfrmOptionsOther.cboTabColorsChange(Sender: TObject);
323var color : TColor;
324 selIndex : integer;
325begin
326 selIndex := cboTabColors.ItemIndex;
327 if selIndex < 0 then exit;
328 color := TColor(cboTabColors.Items.Objects[selIndex]);
329 pnlShowColor.Color := color;
330end;
331
332procedure TfrmOptionsOther.pnlShowColorClick(Sender: TObject);
333//kt added 8/8/08
334var s : string;
335 selIndex : integer;
336begin
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;
344end;
345
346end.
Note: See TracBrowser for help on using the repository browser.