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

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

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