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

Last change on this file since 711 was 667, checked in by Kevin Toppenberg, 15 years ago

Added button to turn Colored Tabs off
File size: 11.6 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 lblTabColors: TLabel;
44 pnlShowColor: TPanel;
45 ColorDialog: TColorDialog;
46 lblEditTabColor: TLabel;
47 cboTabColors: TComboBox;
48 cbEnableTabColors: TCheckBox;
49 procedure FormShow(Sender: TObject);
50 procedure btnOKClick(Sender: TObject);
51 procedure FormCreate(Sender: TObject);
52 procedure dtStartExit(Sender: TObject);
53 procedure dtStopExit(Sender: TObject);
54 procedure dtStartChange(Sender: TObject);
55 procedure txtEncStartChange(Sender: TObject);
56 procedure txtEncStopChange(Sender: TObject);
57 procedure txtEncStartExit(Sender: TObject);
58 procedure txtEncStopExit(Sender: TObject);
59 procedure btnEncDefaultsClick(Sender: TObject);
60 procedure TabPositionComboBoxChange(Sender: TObject);
61 procedure cboTabColorsChange(Sender: TObject);
62 procedure pnlShowColorClick(Sender: TObject);
63 procedure cbEnableTabColorsClick(Sender: TObject);
64 private
65 { Private declarations }
66 FstartDt: TFMDateTime;
67 FstopDt: TFMDateTime;
68 FEncStartDays, FEncStopDays, FEncDefStartDays, FEncDefStopDays: integer;
69 //FDefaultEvent: string;
70 public
71 { Public declarations }
72 end;
73
74var
75 frmOptionsOther: TfrmOptionsOther;
76
77const
78 ENC_MAX_LIMIT = 999;
79
80
81procedure DialogOptionsOther(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
82procedure SetTabPosition(Position : TTabPosition);
83
84implementation
85
86{$R *.DFM}
87
88uses
89 rOptions, uOptions, rCore, rSurgery, uConst, fMeds, fFrame;
90
91procedure DialogOptionsOther(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
92// create the form and make it modal, return an action
93var
94 frmOptionsOther: TfrmOptionsOther;
95begin
96 frmOptionsOther := TfrmOptionsOther.Create(Application);
97 actiontype := 0;
98 try
99 with frmOptionsOther do
100 begin
101 if (topvalue < 0) or (leftvalue < 0) then
102 Position := poScreenCenter
103 else
104 begin
105 Position := poDesigned;
106 Top := topvalue;
107 Left := leftvalue;
108 end;
109 ResizeAnchoredFormToFont(frmOptionsOther);
110 ShowModal;
111 actiontype := btnOK.Tag;
112 end;
113 finally
114 frmOptionsOther.Release;
115 end;
116end;
117
118procedure TfrmOptionsOther.FormShow(Sender: TObject);
119// displays defaults
120// opening tab^use last tab^autosave seconds^verify note title
121var
122 last: integer;
123 values, tab: string;
124begin
125 cboTabColors.Items.Assign(frmFrame.tabPage.Tabs); //kt 8/09
126 //cboTabColors.Items.Assign(uTabColorsList); //kt added8808
127 cboTabColors.ItemIndex := 0; //kt
128 cboTab.Items.Assign(rpcGetOtherTabs); //kt
129 cboTabColorsChange(nil); //kt
130 cbEnableTabColors.Checked := uTabColorsEnabled; //kt 8/09
131//if (cboTab.Items.IndexOf('Surgery') > -1) and (not ShowSurgeryTab) then <-- original line. //kt 8/8/2007
132 if (cboTab.Items.IndexOf(DKLangConstW('fOptionsOther_Surgery')) > -1) and (not ShowSurgeryTab) then //kt added 8/8/2007
133// cboTab.Items.Delete(cboTab.Items.IndexOf('Surgery')); <-- original line. //kt 8/8/2007
134 cboTab.Items.Delete(cboTab.Items.IndexOf(DKLangConstW('fOptionsOther_Surgery'))); //kt added 8/8/2007
135 values := rpcGetOther;
136 tab := Piece(values, '^', 1);
137 last := strtointdef(Piece(values, '^', 2), 0);
138 cboTab.SelectByID(tab);
139 cboTab.Tag := strtointdef(tab, -1);
140 chkLastTab.Checked := last = 1;
141 chkLastTab.Tag := last;
142 cboTab.SetFocus;
143 rpcGetRangeForMeds(FstartDt, FstopDt);
144 if FstartDt > 1 then
145 dtStart.Text := FormatFMDateTime('mmm d, yyyy',FstartDt);
146 if FstopDt > 1 then
147 dtStop.Text := FormatFMDateTime('mmm d, yyyy', FstopDt);
148 rpcGetRangeForEncs(FEncDefStartDays, FEncDefStopDays, True); // True gets params settings above User/Service level.
149 if FEncDefStartDays < 1 then
150 FEncDefStartDays := 0;
151 if FEncDefStopDays < 1 then
152 FEncDefStopDays := 0;
153 rpcGetRangeForEncs(FEncStartDays, FEncStopDays, False); // False gets User/Service params.
154 if ((FEncStartDays < 0) and (FEncStartDays <> 0)) then
155 FEncStartDays := FEncDefStartDays;
156 txtEncStart.Text := IntToStr(FEncStartDays);
157 if ((FEncStopDays < 0) and (FEncStopDays <> 0)) then
158 FEncStopDays := FEncDefStopDays;
159 txtEncStop.Text := IntToStr(FEncStopDays);
160end;
161
162procedure TfrmOptionsOther.btnOKClick(Sender: TObject);
163// opening tab^use last tab^autosave seconds^verify note title
164var
165 values, theVal: string;
166begin
167 values := '';
168 if cboTab.ItemIEN <> cboTab.Tag then
169 values := values + cboTab.ItemID;
170 values := values + '^';
171 if chkLastTab.Checked then
172 if chkLastTab.Tag <> 1 then
173 values := values + '1';
174 if not chkLastTab.Checked then
175 if chkLastTab.Tag <> 0 then
176 values := values + '0';
177 values := values + '^^';
178 rpcSetOther(values);
179 if (dtStop.FMDateTime > 0) and (dtStart.FMDateTime > 0) then
180 begin
181 if dtStop.FMDateTime < dtStart.FMDateTime then
182 begin
183// ShowMessage('The stop time can not prior to the start time.'); <-- original line. //kt 8/8/2007
184 ShowMessage(DKLangConstW('fOptionsOther_The_stop_time_can_not_prior_to_the_start_timex')); //kt added 8/8/2007
185 dtStop.FMDateTime := FMToday;
186 dtStop.SetFocus;
187 Exit;
188 end;
189 theVal := dtStart.RelativeTime + ';' + dtStop.RelativeTime;
190 rpcPutRangeForMeds(theVal);
191 end;
192 if (dtStart.Text = '') and (dtStop.Text = '') then
193 rpcPutRangeForMeds('');
194 rpcPutRangeForEncs(txtEncStart.Text, txtEncStop.Text);
195 if frmMeds <> nil then
196 frmMeds.RefreshMedLists;
197end;
198
199procedure TfrmOptionsOther.FormCreate(Sender: TObject);
200begin
201 cbEnableTabColors.checked := uTabColorsEnabled;
202 FStartDT := 0;
203 FStopDT := 0;
204end;
205
206procedure TfrmOptionsOther.dtStartExit(Sender: TObject);
207begin
208 if dtStart.FMDateTime > FMToday then
209 begin
210// ShowMessage('Start time can not greater than today.'); <-- original line. //kt 8/8/2007
211 ShowMessage(DKLangConstW('fOptionsOther_Start_time_can_not_greater_than_todayx')); //kt added 8/8/2007
212 dtStart.FMDateTime := FMToday;
213 dtStart.SetFocus;
214 Exit;
215 end;
216end;
217
218procedure TfrmOptionsOther.dtStopExit(Sender: TObject);
219begin
220 if (dtStop.FMDateTime > 0) and (dtStart.FMDateTime > 0) then
221 if (dtStop.FMDateTime < dtStart.FMDateTime) then
222 begin
223// ShowMessage('Stop time can not prior to start time'); <-- original line. //kt 8/8/2007
224 ShowMessage(DKLangConstW('fOptionsOther_Stop_time_can_not_prior_to_start_time')); //kt added 8/8/2007
225 dtStop.FMDateTime := FMToday;
226 dtStop.SetFocus;
227 Exit;
228 end;
229end;
230
231procedure TfrmOptionsOther.dtStartChange(Sender: TObject);
232begin
233 if (dtStart.FMDateTime > FMToday) then
234 begin
235// ShowMessage('Start time can not greater than today.'); <-- original line. //kt 8/8/2007
236 ShowMessage(DKLangConstW('fOptionsOther_Start_time_can_not_greater_than_todayx')); //kt added 8/8/2007
237 dtStart.FMDateTime := FMToday;
238 dtStart.SetFocus;
239 Exit;
240 end;
241end;
242
243procedure TfrmOptionsOther.txtEncStartChange(Sender: TObject);
244begin
245with txtEncStart do
246 begin
247 if Text = '' then
248 Exit;
249 if Text = ' ' then
250 Text := '0';
251 if StrToInt(Text) < 0 then
252 Text := '0';
253 if StrToIntDef(Text, ENC_MAX_LIMIT) > ENC_MAX_LIMIT then
254 begin
255 Text := IntToStr(ENC_MAX_LIMIT);
256 Beep;
257// InfoBox('Number must be < ' + IntToStr(ENC_MAX_LIMIT), 'Warning', MB_OK or MB_ICONWARNING); <-- original line. //kt 8/8/2007
258 InfoBox(DKLangConstW('fOptionsOther_Number_must_be_x')+' ' + IntToStr(ENC_MAX_LIMIT), DKLangConstW('fOptionsOther_Warning'), MB_OK or MB_ICONWARNING); //kt added 8/8/2007
259 end;
260 end;
261end;
262
263procedure TfrmOptionsOther.txtEncStopChange(Sender: TObject);
264begin
265with txtEncStop do
266 begin
267 if Text = '' then
268 Exit;
269 if Text = ' ' then
270 Text := '0';
271 if StrToInt(Text) < 0 then
272 Text := '0';
273 if StrToIntDef(Text, ENC_MAX_LIMIT) > ENC_MAX_LIMIT then
274 begin
275 Text := IntToStr(ENC_MAX_LIMIT);
276 Beep;
277// InfoBox('Number must be < ' + IntToStr(ENC_MAX_LIMIT), 'Warning', MB_OK or MB_ICONWARNING); <-- original line. //kt 8/8/2007
278 InfoBox(DKLangConstW('fOptionsOther_Number_must_be_x') + IntToStr(ENC_MAX_LIMIT), DKLangConstW('fOptionsOther_Warning'), MB_OK or MB_ICONWARNING); //kt added 8/8/2007
279 end;
280 end;
281end;
282
283procedure TfrmOptionsOther.txtEncStartExit(Sender: TObject);
284begin
285with txtEncStart do
286 if Text = '' then
287 Text := '0';
288end;
289
290procedure TfrmOptionsOther.txtEncStopExit(Sender: TObject);
291begin
292with txtEncStart do
293 if Text = '' then
294 Text := '0';
295end;
296
297procedure TfrmOptionsOther.btnEncDefaultsClick(Sender: TObject);
298begin
299txtEncStart.Text := IntToStr(FEncDefStartDays);
300txtEncStop.Text := IntToStr(FEncDefStopDays);
301end;
302
303procedure TfrmOptionsOther.TabPositionComboBoxChange(Sender: TObject);
304//kt added 8/8/08
305begin
306 Case TabPositionComboBox.ItemIndex of
307 0 : SetTabPosition(tpBottom);
308 1 : SetTabPosition(tpTop);
309 2 : SetTabPosition(tpLeft);
310 3 : SetTabPosition(tpRight);
311 end; {case}
312end;
313
314procedure SetTabPosition(Position : TTabPosition);
315//kt added 8/8/08
316begin
317 frmFrame.tabPage.TabPosition := Position;
318 Case Position of
319 tpBottom : frmFrame.tabPage.Align := alBottom;
320 tpTop: frmFrame.tabPage.Align := alTop;
321 tpLeft: frmFrame.tabPage.Align := alLeft;
322 tpRight : frmFrame.tabPage.Align := alRight;
323 end; {case}
324end;
325
326
327procedure TfrmOptionsOther.cboTabColorsChange(Sender: TObject);
328var color : TColor;
329 selIndex : integer;
330begin
331 selIndex := cboTabColors.ItemIndex;
332 if selIndex < 0 then exit;
333 color := TColor(cboTabColors.Items.Objects[selIndex]);
334 pnlShowColor.Color := color;
335end;
336
337procedure TfrmOptionsOther.pnlShowColorClick(Sender: TObject);
338//kt added 8/8/08
339var s : string;
340 selIndex : integer;
341begin
342 if ColorDialog.Execute then begin
343 pnlShowColor.Color := ColorDialog.Color;
344 selIndex := cboTabColors.ItemIndex;
345 if selIndex < 0 then exit;
346 cboTabColors.Items.Objects[selIndex] := pointer(ColorDialog.Color);
347 uTabColorsList.Objects[selIndex] := pointer(ColorDialog.Color);
348 end;
349end;
350
351procedure TfrmOptionsOther.cbEnableTabColorsClick(Sender: TObject);
352//kt added
353begin
354 uTabColorsEnabled := cbEnableTabColors.Checked; //elh 01/12/10
355 frmFrame.tabPage.OwnerDraw := cbEnableTabColors.Checked; //elh 01/12/10
356 //cboTabColors.Enabled := uTabColorsEnabled;
357 //lblEditTabColor.Enabled := uTabColorsEnabled;
358 //lblTabColors.Enabled := uTabColorsEnabled;
359 //pnlShowColor.Enabled := uTabColorsEnabled;
360end;
361
362end.
Note: See TracBrowser for help on using the repository browser.