source: cprs/branches/tmg-cprs/CPRS-Chart/Options/fOptions.pas@ 736

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

Template formulas will calculate even if responses have characters, bug fixes
File size: 34.6 KB
Line 
1//kt -- Modified with SourceScanner on 8/8/2007
2unit fOptions;
3
4interface
5
6uses
7 Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
8 Buttons, ComCtrls, ExtCtrls, ORCtrls, OrFn, Dialogs, ORDtTmRng, fBAOptionsDiagnoses,
9 uBAGlobals, TntStdCtrls, DKLang, jpeg, inifiles;
10
11//kt added 6/29/07 ------------------
12{Note: an additional tab was added to form: tsLanguage, with caption "Language"
13 It contained a combo box (TTntComboxBox to support unicode language display)
14 It has an on change event added below. There was a memo field describing
15 how adding languages works:
16
17 For a given language to be available, a *.lng (e.g. spanish.lng) must be in the
18 same directory as CPRSchart.exe. *.lng may be created by users by working
19 with the CPRSchart.dklng file with the free language editor found at:
20 http://www.dk-soft.org/products/dklang/
21
22 Note: Cancel for language change is not currently supported
23//kt 9/8/08 ----------------------------
24 Also, a tab was added to the form: Appearance, for selecting skins.
25 }
26
27type
28 TfrmOptions = class(TForm)
29 pnlMain: TPanel;
30 pnlBottom: TPanel;
31 pagOptions: TPageControl;
32 tsCoverSheet: TTabSheet;
33 tsNotifications: TTabSheet;
34 btnOK: TButton;
35 btnCancel: TButton;
36 btnApply: TButton;
37 tsOrderChecks: TTabSheet;
38 tsListsTeams: TTabSheet;
39 tsLanguage: TTabSheet; //kt added 6/29/07 (added in form editor)
40 lblCoverReminderDesc: TMemo;
41 lblCoverReminders: TStaticText;
42 lblCoverDaysDesc: TMemo;
43 lblCoverDays: TStaticText;
44 btnCoverDays: TButton;
45 bvlCoverDays: TBevel;
46 btnCoverReminders: TButton;
47 bvlCoverReminders: TBevel;
48 imgCoverDays: TImage;
49 imgCoverReminders: TImage;
50 lblPatientSelectionDesc: TMemo;
51 lblPatientSelection: TStaticText;
52 btnPatientSelection: TButton;
53 bvlPatientSelection: TBevel;
54 btnPersonalLists: TButton;
55 imgPatientSelection: TImage;
56 lblNotificationsOptions: TStaticText;
57 lblNotifications: TStaticText;
58 bvlNotifications: TBevel;
59 imgNotifications: TImage;
60 lblOrderChecksDesc: TLabel;
61 lblOrderChecks: TStaticText;
62 bvlOrderChecks: TBevel;
63 imgOrderChecks: TImage;
64 lblTeamsDesc: TMemo;
65 lblTeams: TStaticText;
66 btnTeams: TButton;
67 bvlTeams: TBevel;
68 lvwNotifications: TCaptionListView;
69 lblNotificationView: TLabel;
70 btnNotificationsRemove: TButton;
71 chkNotificationsFlagged: TCheckBox;
72 lvwOrderChecks: TCaptionListView;
73 lblOrderChecksView: TLabel;
74 btnSurrogate: TButton;
75 lblNotificationsSurrogate: TStaticText;
76 lblNotificationsSurrogateText: TStaticText;
77 btnCombinations: TButton;
78 bvlOtherParameters: TBevel;
79 lblOtherParameters: TStaticText;
80 imgOtherParameters: TImage;
81 lblOtherParametersDesc: TMemo;
82 btnOtherParameters: TButton;
83 tsNotes: TTabSheet;
84 lblNotesNotesDesc: TMemo;
85 lblNotesNotes: TStaticText;
86 bvlNotesNotes: TBevel;
87 btnNotesNotes: TButton;
88 lblNotesTitles: TStaticText;
89 bvlNotesTitles: TBevel;
90 lblNotesTitlesDesc: TMemo;
91 btnNotesTitles: TButton;
92 imgNotesNotes: TImage;
93 imgNotes: TImage;
94 imgTeams: TImage;
95 tsCprsReports: TTabSheet;
96 lblReports: TStaticText;
97 bvlReports: TBevel;
98 memReports: TMemo;
99 imgReports: TImage;
100 btnReports: TButton;
101 lblReport1: TStaticText;
102 memReport1: TMemo;
103 btnReport1: TButton;
104 bvlReport1: TBevel;
105 btnDiagnoses: TButton;
106 tsGraphs: TTabSheet;
107 lblGraphSettings: TStaticText;
108 bvlGraphSettings: TBevel;
109 imgGraphSettings: TImage;
110 btnGraphSettings: TButton;
111 bvlGraphViews: TBevel;
112 lblGraphViews: TStaticText;
113 imgGraphViews: TImage;
114 btnGraphViews: TButton;
115 memGraphSettings: TMemo;
116 memGraphViews: TMemo;
117 bvlReport2: TBevel;
118 lblReport2: TStaticText;
119 memReport2: TMemo;
120 imgReport1: TImage;
121 imgReport2: TImage;
122 rdoRDV: TRadioGroup;
123 cbLanguage: TTntComboBox;
124 Label1: TLabel;
125 Label2: TLabel;
126 DKLanguageController1: TDKLanguageController;
127 Image1: TImage;
128 Memo1: TMemo;
129 Button1: TButton;
130 tsAppearance: TTabSheet;
131 Label12: TLabel;
132 lbSkins: TListBox;
133 cbSkinAtStartup: TCheckBox;
134 btnMoreSkins: TButton;
135 btnDisableSkin: TButton;
136 btnApplySkin: TButton;
137 tsImages: TTabSheet;
138 cbEnableImages: TCheckBox;
139 cboTransMethod: TComboBox;
140 Label3: TLabel;
141 Edit1: TEdit;
142 Label4: TLabel;
143 BitBtn1: TBitBtn;
144 dlgPickDir: TOpenDialog;
145 cbEnableScanning: TCheckBox;
146 Label5: TLabel;
147 Edit2: TEdit;
148 BitBtn2: TBitBtn;
149 Label6: TLabel;
150 edtPolFreq: TEdit;
151 Label7: TLabel;
152 procedure FormCreate(Sender: TObject);
153 procedure FormDestroy(Sender: TObject);
154 procedure btnCoverDaysClick(Sender: TObject);
155 procedure btnCoverRemindersClick(Sender: TObject);
156 procedure btnOtherParametersClick(Sender: TObject);
157 procedure btnPatientSelectionClick(Sender: TObject);
158 procedure btnPersonalListsClick(Sender: TObject);
159 procedure btnTeamsClick(Sender: TObject);
160 procedure btnNotificationsRemoveClick(Sender: TObject);
161 procedure btnApplyClick(Sender: TObject);
162 procedure chkNotificationsFlaggedClick(Sender: TObject);
163 procedure lvwNotificationsChange(Sender: TObject; Item: TListItem;
164 Change: TItemChange);
165 procedure lvwNotificationsColumnClick(Sender: TObject;
166 Column: TListColumn);
167 procedure lvwNotificationsCompare(Sender: TObject; Item1,
168 Item2: TListItem; Data: Integer; var Compare: Integer);
169 procedure lvwNotificationsDblClick(Sender: TObject);
170 procedure btnSurrogateClick(Sender: TObject);
171 procedure btnCombinationsClick(Sender: TObject);
172 procedure btnNotesNotesClick(Sender: TObject);
173 procedure btnNotesTitlesClick(Sender: TObject);
174 procedure btnReportsClick(Sender: TObject);
175 procedure btnReport1Click(Sender: TObject);
176 procedure lvwNotificationsEnter(Sender: TObject);
177 procedure lvwNotificationsMouseDown(Sender: TObject;
178 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
179 procedure btnDiagnosesClick(Sender: TObject);
180 procedure btnGraphSettingsClick(Sender: TObject);
181 procedure btnGraphViewsClick(Sender: TObject);
182 procedure rdoRDVClick(Sender: TObject);
183 procedure cbLanguageChange(Sender: TObject);
184 procedure Button1Click(Sender: TObject);
185 procedure btnApplySkinClick(Sender: TObject);
186 procedure btnMoreSkinsClick(Sender: TObject);
187 procedure FormShow(Sender: TObject);
188 procedure lbSkinsKeyPress(Sender: TObject; var Key: Char);
189 procedure btnDisableSkinClick(Sender: TObject);
190 procedure cbSkinAtStartupClick(Sender: TObject); //kt added 6/29/07
191 private
192 { Private declarations }
193 FdirtyNotifications: boolean; // used to determine edit changes to Notifications
194 FdirtyOrderChecks: boolean; // used to determine edit changes to Order Checks
195 FdirtyOtherStuff: boolean; // used to determine edit changes to misc settings
196 FuseCheckBoxes: boolean;
197 FsortCol: integer;
198 FsortAscending: boolean;
199 FLastClickedItem: TListItem;
200 procedure FillSkinList; //kt
201 procedure Offset(var topnum: integer; topoffset: integer; var leftnum: integer; leftoffset: integer);
202 procedure LoadNotifications;
203 procedure LoadOrderChecks;
204 procedure ApplyNotifications;
205 procedure ApplyOrderChecks;
206 procedure ApplyOtherStuff;
207 procedure CheckApply;
208 procedure LoadListView(aListView: TListView; aList: TStrings);
209 procedure ChangeOnOff(aListView: TListView; aListItem: TListItem);
210 public
211 { Public declarations }
212 end;
213
214var
215 frmOptions: TfrmOptions;
216
217procedure DialogOptions(var actiontype: Integer);
218
219implementation
220
221 uses fOptionsDays, fOptionsReminders, fOptionsSurrogate,
222 fOptionsPatientSelection, fOptionsLists, fOptionsTeams, fOptionsCombinations,
223 fOptionsOther, fOptionsNotes, fOptionsTitles, fOptionsReportsCustom, fOptionsReportsDefault,
224 fGraphs, fGraphSettings, fGraphProfiles, rGraphs, uGraphs,
225 rOptions, rCore, uCore, uOptions, UBACore, fFrame,
226 //fTestDialog;
227 //kt mod 6/29/07 -----
228 ShellAPI, //kt 9/8/08
229 uTMGOptions, //kt 2/10/10
230 ORNet, //allows access to RPCBrokerV
231 TntForms, TntSystem, TntSysUtils;
232 //kt end mod ---------
233
234
235{$R *.DFM}
236
237 type
238 TRule = class
239 public
240 IEN: string;
241 OriginalValue: string;
242 ItemText: string;
243 end;
244
245 procedure DialogOptions(var actiontype: Integer);
246 // create the form and make in modal, return an action
247 const
248 PixelGapBetweenButtons = 5;
249 var
250 frmOptions: TfrmOptions;
251 begin
252 frmOptions := TfrmOptions.Create(Application);
253 try
254 with frmOptions do
255 begin
256 cbSkinAtStartup.Checked := frmFrame.SkinAtStartup;
257 with pagOptions do
258 begin
259 tsCoverSheet.TabVisible := false;
260 tsNotifications.TabVisible := false;
261 tsOrderChecks.TabVisible := false;
262 tsListsTeams.TabVisible := false;
263 case actiontype of
264 1: begin
265 tsCoverSheet.TabVisible := true;
266 end;
267 2: begin
268 tsNotifications.TabVisible := true;
269 end;
270 3: begin
271 tsOrderChecks.TabVisible := true;
272 end;
273 4: begin
274 tsListsTeams.TabVisible := true;
275 end;
276 else
277 begin
278 tsCoverSheet.TabVisible := true;
279 tsNotifications.TabVisible := true;
280 tsOrderChecks.TabVisible := true;
281 tsListsTeams.TabVisible := true;
282 ActivePage := tsCoverSheet;
283 // memReports.Text := 'Change the default date range and occurrence limits for all reports on ' + <-- original line. //kt 8/8/2007
284 memReports.Text := DKLangConstW('fOptions_Change_the_default_date_range_and_occurrence_limits_for_all_reports_on') + //kt added 8/8/2007
285 // 'the CPRS Reports tab (excluding health summary reports) .'; <-- original line. //kt 8/8/2007
286 DKLangConstW('fOptions_the_CPRS_Reports_tab_xexcluding_health_summary_reportsx_x'); //kt added 8/8/2007
287 // memReport1.Text := 'Change the individual date range and occurrence limits for each report on ' + <-- original line. //kt 8/8/2007
288 memReport1.Text := DKLangConstW('fOptions_Change_the_individual_date_range_and_occurrence_limits_for_each_report_on') + //kt added 8/8/2007
289 // 'the CPRS Reports tab (excluding health summary reports) .'; <-- original line. //kt 8/8/2007
290 DKLangConstW('fOptions_the_CPRS_Reports_tab_xexcluding_health_summary_reportsx_x'); //kt added 8/8/2007
291 // btnReports.caption := 'Set All Reports...'; <-- original line. //kt 8/8/2007
292 btnReports.caption := DKLangConstW('fOptions_Set_All_Reportsxxx'); //kt added 8/8/2007
293 // btnReport1.caption := 'Set Individual Reports...'; <-- original line. //kt 8/8/2007
294 btnReport1.caption := DKLangConstW('fOptions_Set_Individual_Reportsxxx'); //kt added 8/8/2007
295 if User.IsReportsOnly then // For "Reports Only" users.
296 begin
297 tsCoverSheet.TabVisible := false;
298 tsNotifications.TabVisible := false;
299 tsOrderChecks.TabVisible := false;
300 tsListsTeams.TabVisible := false;
301 tsNotes.TabVisible := false;
302 if (not User.ToolsRptEdit) then
303 begin
304 btnOK.visible := false;
305 btnApply.visible := false;
306 // btnCancel.caption := 'Close'; <-- original line. //kt 8/8/2007
307 btnCancel.caption := DKLangConstW('fOptions_Close'); //kt added 8/8/2007
308 end;
309 end;
310 if (not User.ToolsRptEdit) then // For users with Reports settings edit parameter not set.
311 begin
312 // memReports.Text := 'View the default date range and occurrence limits for all reports on ' + <-- original line. //kt 8/8/2007
313 memReports.Text := DKLangConstW('fOptions_View_the_default_date_range_and_occurrence_limits_for_all_reports_on') + //kt added 8/8/2007
314 // 'the CPRS Reports tab (excluding health summary reports) .'; <-- original line. //kt 8/8/2007
315 DKLangConstW('fOptions_the_CPRS_Reports_tab_xexcluding_health_summary_reportsx_x'); //kt added 8/8/2007
316 // memReport1.Text := 'View the individual date range and occurrence limits for each report on ' + <-- original line. //kt 8/8/2007
317 memReport1.Text := DKLangConstW('fOptions_View_the_individual_date_range_and_occurrence_limits_for_each_report_on') + //kt added 8/8/2007
318 // 'the CPRS Reports tab (excluding health summary reports) .'; <-- original line. //kt 8/8/2007
319 DKLangConstW('fOptions_the_CPRS_Reports_tab_xexcluding_health_summary_reportsx_x'); //kt added 8/8/2007
320 // btnReports.caption := 'View All Report Settings...'; <-- original line. //kt 8/8/2007
321 btnReports.caption := DKLangConstW('fOptions_View_All_Report_Settingsxxx'); //kt added 8/8/2007
322 // btnReport1.caption := 'View Individual Report Settings...'; <-- original line. //kt 8/8/2007
323 btnReport1.caption := DKLangConstW('fOptions_View_Individual_Report_Settingsxxx'); //kt added 8/8/2007
324 end;
325 end;
326 end;
327 end;
328 actiontype := 0;
329 ResizeAnchoredFormToFont(frmOptions);
330 btnApply.Left := pagOptions.Left + pagOptions.Width - btnApply.Width;
331 btnCancel.Left := btnApply.Left - btnCancel.Width - PixelGapBetweenButtons;
332 btnOK.Left := btnCancel.Left - btnOK.Width - PixelGapBetweenButtons;
333 ShowModal;
334 actiontype := btnOK.Tag;
335 end;
336 finally
337 frmFrame.SkinAtStartup := frmOptions.cbSkinAtStartup.Checked;
338 frmOptions.Release;
339 end;
340 end;
341
342 procedure TfrmOptions.FormCreate(Sender: TObject);
343 // initialize form
344 var i : integer; //kt added 6/29/07
345 begin
346 LoadNotifications;
347 LoadOrderChecks;
348 FdirtyNotifications := false;
349 FdirtyOrderChecks := false;
350 FdirtyOtherStuff := false;
351 CheckApply;
352
353 if (Encounter.Provider = 0) and not IsCIDCProvider(User.DUZ) then
354 btnDiagnoses.Enabled := False;
355 if UseVistaWeb then rdoRDV.ItemIndex := 1;
356
357 //kt begin modification 6/29/07 ---------------
358 // Fill cbLanguage with available languages
359 // Note: LangManager was populated at form creation of fFrame
360 for i := 0 to LangManager.LanguageCount-1 do cbLanguage.Items.Add(LangManager.LanguageNames[i]);
361 //Index=0 always means the default language
362 cbLanguage.ItemIndex := LangManager.LanguageIndex;
363 //kt end modification 6/29/07 ---------------
364 cbSkinAtStartup.Checked := frmFrame.SkinAtStartup; //kt 9/8/08
365 end;
366
367 procedure TfrmOptions.FormDestroy(Sender: TObject);
368 // cleanup creation of objects
369 var
370 i: integer;
371 begin
372 for i := 0 to lvwOrderChecks.Items.Count - 1 do
373 lvwOrderChecks.Items.Item[i].SubItems.Objects[2].free;
374 for i := 0 to lvwNotifications.Items.Count - 1 do
375 lvwNotifications.Items.Item[i].SubItems.Objects[2].free;
376 end;
377
378 procedure TfrmOptions.btnCoverDaysClick(Sender: TObject);
379 // display Date Range Defaults on Cover Sheet
380 var
381 topsize, leftsize, value: integer;
382 begin
383 value := 0;
384 Offset(topsize, -60, leftsize, -60);
385 DialogOptionsDays(topsize, leftsize, Font.Size, value);
386 end;
387
388 procedure TfrmOptions.btnCoverRemindersClick(Sender: TObject);
389 // display Clinical Reminder Options
390 var
391 topsize, leftsize, value: integer;
392 begin
393 value := 0;
394 Offset(topsize, -60, leftsize, -60);
395 DialogOptionsReminders(topsize, leftsize, Font.Size, value);
396 end;
397
398 procedure TfrmOptions.btnOtherParametersClick(Sender: TObject);
399 // display Other Parameters Options
400 var
401 topsize, leftsize, value: integer;
402 begin
403 value := 0;
404 Offset(topsize, 40, leftsize, 40);
405 DialogOptionsOther(topsize, leftsize, Font.Size, value);
406 end;
407
408 procedure TfrmOptions.btnPatientSelectionClick(Sender: TObject);
409 // display Patient Selection Options
410 var
411 topsize, leftsize, value: integer;
412 begin
413 value := 0;
414 Offset(topsize, -60, leftsize, -60);
415 DialogOptionsPatientSelection(topsize, leftsize, Font.Size, value);
416 end;
417
418 procedure TfrmOptions.btnPersonalListsClick(Sender: TObject);
419 // display Personal Lists Options
420 var
421 topsize, leftsize, value: integer;
422 begin
423 value := 0;
424 Offset(topsize, -60, leftsize, -60);
425 DialogOptionsLists(topsize, leftsize, Font.Size, value);
426 end;
427
428 procedure TfrmOptions.btnTeamsClick(Sender: TObject);
429 // display Team Options
430 var
431 topsize, leftsize, value: integer;
432 begin
433 value := 0;
434 Offset(topsize, -60, leftsize, -60);
435 DialogOptionsTeams(topsize, leftsize, Font.Size, value);
436 end;
437
438 procedure TfrmOptions.btnNotificationsRemoveClick(Sender: TObject);
439 // confirm before clearing notifications
440 begin
441 //if InfoBox('CAUTION: This will clear all the current notifications you have pending.' <-- original line. //kt 8/8/2007
442 if InfoBox(DKLangConstW('fOptions_CAUTIONx_This_will_clear_all_the_current_notifications_you_have_pendingx') //kt added 8/8/2007
443 // + #13 + 'If you say YES, these changes will take place immediately.' <-- original line. //kt 8/8/2007
444 + #13 + DKLangConstW('fOptions_If_you_say_YESx_these_changes_will_take_place_immediatelyx') //kt added 8/8/2007
445 // + #13 + 'Are you sure you want to erase all of your notifications?', <-- original line. //kt 8/8/2007
446 + #13 + DKLangConstW('fOptions_Are_you_sure_you_want_to_erase_all_of_your_notificationsx'), //kt added 8/8/2007
447 // 'Warning', MB_YESNO or MB_ICONWARNING) = IDYES then <-- original line. //kt 8/8/2007
448 DKLangConstW('fOptions_Warning'), MB_YESNO or MB_ICONWARNING) = IDYES then //kt added 8/8/2007
449 begin
450 rpcClearNotifications;
451 end;
452 end;
453
454 procedure TfrmOptions.Offset(var topnum: integer; topoffset: integer; var leftnum: integer; leftoffset: integer);
455 // get positions to display dialog
456 begin
457 // use these top and left values to display dialog
458 topnum := Top;
459 leftnum := Left;
460 topnum := topnum + topoffset;
461 if topnum < 0 then topnum := 0;
462 leftnum := leftnum + leftoffset;
463 if leftnum < 0 then leftnum := 0;
464 end;
465
466 procedure TfrmOptions.btnApplyClick(Sender: TObject);
467 // save actions without exiting
468 begin
469 if FdirtyNotifications then
470 ApplyNotifications;
471 if FdirtyOrderChecks then
472 ApplyOrderChecks;
473 if FdirtyOtherStuff then
474 ApplyOtherStuff;
475 CheckApply;
476 if Sender = btnOK then
477 Close;
478 end;
479
480 procedure TfrmOptions.LoadNotifications;
481 // load Notification tab
482 var
483 notifydefaults, surrogateinfo, flag, enableerase: string;
484 begin
485 LoadListView(lvwNotifications, rpcGetNotifications);
486 lvwNotificationsColumnClick(lvwNotifications, lvwNotifications.Column[0]); // make sure sorted
487 notifydefaults := rpcGetNotificationDefaults;
488 flag := Piece(notifydefaults, '^', 2);
489 enableerase := Piece(notifydefaults, '^', 3);
490 chkNotificationsFlagged.Checked := flag = '1';
491 btnNotificationsRemove.Enabled := enableerase = '1';
492 surrogateinfo := rpcGetSurrogateInfo;
493 btnSurrogate.Hint := surrogateinfo;
494 LabelSurrogate(surrogateinfo, lblNotificationsSurrogateText);
495 end;
496
497 procedure TfrmOptions.LoadOrderChecks;
498 // load Order Check tab
499 begin
500 LoadListView(lvwOrderChecks, rpcGetOrderChecks);
501 lvwOrderChecks.Checkboxes := true;
502 end;
503
504 procedure TfrmOptions.ApplyNotifications;
505 // save Notification changes
506 var
507 i: integer;
508 newonoff: string;
509 aRule: TRule;
510 aList: TStringList;
511 begin
512 aList := TStringList.Create;
513 for i := 0 to lvwNotifications.Items.Count - 1 do
514 begin
515 aRule := TRule(lvwNotifications.Items.Item[i].SubItems.Objects[2]);
516 // if lvwNotifications.Items.Item[i].SubItems[1] <> 'Mandatory' then <-- original line. //kt 8/8/2007
517 if lvwNotifications.Items.Item[i].SubItems[1] <> DKLangConstW('fOptions_Mandatory') then //kt added 8/8/2007
518 begin
519 newonoff := Uppercase(lvwNotifications.Items.Item[i].SubItems[0]);
520 if aRule.OriginalValue <> newonoff then
521 begin
522 //***showmessage(aRule.IEN + ' ' + aRule.OriginalValue + ' ' + newonoff);
523 aList.Add(aRule.IEN + '^' + newonoff);
524 aRule.OriginalValue := lvwNotifications.Items.Item[i].SubItems[0];
525 end;
526 end;
527 end;
528 rpcSetNotifications(aList);
529 aList.free;
530 FdirtyNotifications := false;
531 end;
532
533 procedure TfrmOptions.ApplyOrderChecks;
534 // save Order Check changes
535 var
536 i: integer;
537 newonoff: string;
538 aRule: TRule;
539 aList: TStringList;
540 begin
541 aList := TStringList.Create;
542 for i := 0 to lvwOrderChecks.Items.Count - 1 do
543 begin
544 aRule := TRule(lvwOrderChecks.Items.Item[i].SubItems.Objects[2]);
545 newonoff := Uppercase(lvwOrderChecks.Items.Item[i].SubItems[0]);
546 if aRule.OriginalValue <> newonoff then
547 begin
548 aList.Add(aRule.IEN + '^' + newonoff);
549 aRule.OriginalValue := lvwOrderChecks.Items.Item[i].SubItems[0];
550 end;
551 end;
552 rpcSetOrderChecks(aList);
553 aList.free;
554 FdirtyOrderChecks := false;
555 end;
556
557 procedure TfrmOptions.ApplyOtherStuff;
558 // save other changes
559 var
560 aString: string;
561 begin
562 aString := '';
563 if chkNotificationsFlagged.Checked then
564 aString := aString + '^1'
565 else
566 aString := aString + '^0';
567 rpcSetOtherStuff(aString);
568 FdirtyOtherStuff := false;
569 end;
570
571 procedure TfrmOptions.CheckApply;
572 // determine if Apply button is enabled
573 begin
574 btnApply.Enabled := FdirtyOrderChecks or FdirtyNotifications or FdirtyOtherStuff;
575 end;
576
577 procedure TfrmOptions.chkNotificationsFlaggedClick(Sender: TObject);
578 // set notification flagged status
579 begin
580 FdirtyOtherStuff := true;
581 CheckApply;
582 end;
583
584 procedure TfrmOptions.LoadListView(aListView: TListView; aList: TStrings);
585 // load a list view with: name, on/off, comment
586 var
587 i: integer;
588 aListItem: TListItem;
589 aRule: TRule;
590 rulenum, ruletext, ruleonoff, rulecomment: string;
591 begin
592 FuseCheckBoxes := false;
593 aListView.Items.Clear;
594 aListView.SortType := stNone; // if Sorting during load then potential error
595 with aList do
596 begin
597 for i := 0 to aList.Count - 1 do
598 begin
599 rulenum := Piece(aList[i], '^', 1);
600 ruletext := Piece(aList[i], '^', 2);
601 ruleonoff := Piece(aList[i], '^', 3);
602 rulecomment := Piece(aList[i], '^', 4);
603 aListItem := aListView.Items.Add;
604 with aListItem do
605 begin
606 Caption := ruletext;
607 SubItems.Add(ruleonoff);
608 if ruleonoff = 'On' then Checked := true;
609 SubItems.Add(rulecomment);
610 end;
611 aRule := TRule.Create;
612 with aRule do
613 begin
614 IEN := rulenum;
615 OriginalValue := ruleonoff;
616 ItemText := ruletext;
617 end;
618 // aListItem.SubItems.AddObject('rule object', aRule); <-- original line. //kt 8/8/2007
619 aListItem.SubItems.AddObject(DKLangConstW('fOptions_rule_object'), aRule); //kt added 8/8/2007
620 end;
621 end;
622 aListView.SortType := stBoth;
623 FuseCheckBoxes := true;
624 end;
625
626 procedure TfrmOptions.lvwNotificationsChange(Sender: TObject;
627 Item: TListItem; Change: TItemChange);
628 // change on/off on checkmark
629 begin
630 if (Sender as TListView).ItemIndex = -1 then exit;
631 if not FuseCheckBoxes then exit;
632 if (Sender as TListView).Checkboxes = false then exit;
633 //if (Item.SubItems[1] = 'Mandatory') and not Item.Checked then begin <-- original line. //kt 8/8/2007
634 if (Item.SubItems[1] = DKLangConstW('fOptions_Mandatory')) and not Item.Checked then begin //kt added 8/8/2007
635 Item.Checked := True;
636 exit;
637 end;
638 if Item.Checked then
639 begin
640 if Item.SubItems[0] <> 'On' then
641 ChangeOnOff(Sender as TListView, Item);
642 Item.SubItems[0] := 'On';
643 end
644 else
645 begin
646 // if Item.SubItems[0] <> 'Off' then <-- original line. //kt 8/8/2007
647 if Item.SubItems[0] <> DKLangConstW('fOptions_Off') then //kt added 8/8/2007
648 ChangeOnOff(Sender as TListView, Item);
649 // Item.SubItems[0] := 'Off'; <-- original line. //kt 8/8/2007
650 Item.SubItems[0] := DKLangConstW('fOptions_Off'); //kt added 8/8/2007
651 end;
652 end;
653
654 procedure TfrmOptions.lvwNotificationsColumnClick(Sender: TObject;
655 Column: TListColumn);
656 // toggle sort
657 begin
658 if FsortCol = Column.Index then
659 FsortAscending := not FsortAscending
660 else
661 FsortAscending := true;
662 FsortCol := Column.Index;
663 (Sender as TListView).AlphaSort;
664 end;
665
666 procedure TfrmOptions.lvwNotificationsCompare(Sender: TObject; Item1,
667 Item2: TListItem; Data: Integer; var Compare: Integer);
668 // sort columns
669 begin
670 if not(Sender is TListView) then exit;
671 if FsortAscending then
672 begin
673 if FsortCol = 0 then
674 Compare := CompareStr(Item1.Caption, Item2.Caption)
675 else
676 Compare := CompareStr(Item1.SubItems[FsortCol - 1],
677 Item2.SubItems[FsortCol - 1]);
678 end
679 else
680 begin
681 if FsortCol = 0 then
682 Compare := CompareStr(Item2.Caption, Item1.Caption)
683 else
684 Compare := CompareStr(Item2.SubItems[FsortCol - 1],
685 Item1.SubItems[FsortCol - 1]);
686 end;
687 end;
688
689 procedure TfrmOptions.lvwNotificationsDblClick(Sender: TObject);
690 // toggle check marks with double click
691 var
692 aListItem: TListItem;
693 begin
694 with (Sender as TListView) do
695 begin
696 if Checkboxes = false then exit;
697 if Selected = nil then exit;
698 // if Selected.SubItems[1] = 'Mandatory' then exit; <-- original line. //kt 8/8/2007
699 if Selected.SubItems[1] = DKLangConstW('fOptions_Mandatory') then exit; //kt added 8/8/2007
700 if Selected <> FLastClickedItem then exit;
701 aListItem := Selected;
702 aListItem.Checked := not aListItem.Checked;
703 ChangeOnOff(Sender as TListView, aListItem);
704
705 if aListItem.Checked then
706 aListItem.SubItems[0] := 'On'
707 else
708 // aListItem.SubItems[0] := 'Off'; <-- original line. //kt 8/8/2007
709 aListItem.SubItems[0] := DKLangConstW('fOptions_Off'); //kt added 8/8/2007
710 end;
711 end;
712
713 procedure TfrmOptions.ChangeOnOff(aListView: TListView; aListItem: TListItem);
714 // check if list items were edited
715 begin
716 if aListView = lvwNotifications then FdirtyNotifications := true;
717 if aListView = lvwOrderChecks then FdirtyOrderChecks := true;
718 CheckApply;
719 end;
720
721 procedure TfrmOptions.btnSurrogateClick(Sender: TObject);
722 // display Surrogate Options
723 var
724 topsize, leftsize: integer;
725 surrogateinfo: string;
726 begin
727 surrogateinfo := btnSurrogate.Hint;
728 Offset(topsize, -30, leftsize, -30);
729 DialogOptionsSurrogate(topsize, leftsize, Font.Size, surrogateinfo);
730 LabelSurrogate(surrogateinfo, lblNotificationsSurrogateText);
731 btnSurrogate.Hint := surrogateinfo;
732 end;
733
734 procedure TfrmOptions.btnCombinationsClick(Sender: TObject);
735 // display Combination List Options
736 var
737 topsize, leftsize, value: integer;
738 begin
739 value := 0;
740 Offset(topsize, -60, leftsize, -60);
741 DialogOptionsCombinations(topsize, leftsize, Font.Size, value);
742 end;
743
744 procedure TfrmOptions.btnNotesNotesClick(Sender: TObject);
745 // display Notes Options
746 var
747 topsize, leftsize, value: integer;
748 begin
749 value := 0;
750 Offset(topsize, -60, leftsize, -60);
751 DialogOptionsNotes(topsize, leftsize, Font.Size, value);
752 end;
753
754 procedure TfrmOptions.btnNotesTitlesClick(Sender: TObject);
755 // display Titles Options
756 var
757 topsize, leftsize, value: integer;
758 begin
759 value := 0;
760 Offset(topsize, -60, leftsize, -60);
761 DialogOptionsTitles(topsize, leftsize, Font.Size, value);
762 end;
763
764 procedure TfrmOptions.btnReportsClick(Sender: TObject);
765 var
766 topsize, leftsize, value: integer;
767 begin
768 value := 0;
769 Offset(topsize, 90, leftsize, 23);
770 DialogOptionsHSDefault(topsize, leftsize, Font.Size, value);
771 end;
772
773 procedure TfrmOptions.btnReport1Click(Sender: TObject);
774 var
775 topsize, leftsize, value: integer;
776 begin
777 value := 0;
778 Offset(topsize, -18, leftsize, -15);
779 DialogOptionsHSCustom(topsize, leftsize, Font.Size, value);
780 end;
781
782 procedure TfrmOptions.lvwNotificationsEnter(Sender: TObject);
783 begin
784 with Sender as TListView do begin
785 if (Selected = nil) and (Items.Count > 0) then
786 Selected := Items[0];
787 end;
788 end;
789
790 procedure TfrmOptions.lvwNotificationsMouseDown(Sender: TObject;
791 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
792 begin
793 FLastClickedItem := (Sender as TListView).GetItemAt(X,Y);
794 end;
795
796 procedure TfrmOptions.btnDiagnosesClick(Sender: TObject);
797 // display Personal Diagnoses List
798 var
799 topsize, leftsize, value: integer;
800 begin
801 if IsCIDCProvider(User.DUZ) then //(hds7564)
802 begin
803 value := 0;
804 Offset(topsize, -60, leftsize, -60);
805 DialogOptionsDiagnoses(topsize, leftsize, Font.Size, value);
806 end;
807 end;
808
809 procedure TfrmOptions.btnGraphSettingsClick(Sender: TObject);
810 // display GraphSettings
811 var
812 actiontype: boolean;
813 topsize, leftsize: integer;
814 begin
815 actiontype := false;
816 Offset(topsize, -60, leftsize, -60);
817 DialogOptionsGraphSettings(topsize, leftsize, Font.Size, actiontype);
818 end;
819
820 procedure TfrmOptions.btnGraphViewsClick(Sender: TObject);
821 // display Graph Views
822 var
823 actiontype: boolean;
824 topsize, leftsize: integer;
825 begin
826 actiontype := false;
827 Offset(topsize, -60, leftsize, -60);
828 DialogOptionsGraphProfiles(topsize, leftsize, Font.Size, actiontype);
829 end;
830
831 procedure TfrmOptions.rdoRDVClick(Sender: TObject);
832 var
833 iIndex: integer;
834 begin
835 iIndex := rdoRDV.ItemIndex;
836 with frmFrame do
837 if iIndex = 0 then
838 begin
839 ChangeVistaWebParam('0');
840 lblCIRN.Caption := ' Remote';
841 lblCIRNData.Caption := 'Data';
842 lblCIRNAvail.Caption := '';
843 lblCIRN.Width := 43;
844 lblCIRNData.Width := 43;
845 lblCIRNData.Alignment := taCenter;
846 lblCIRN.Alignment := taCenter;
847 lstCIRNLocations.Clear;
848 SetUpCIRN;
849 end
850 else
851 begin
852 ChangeVistaWebParam('1');
853 lblCIRN.Caption := 'Remote';
854 lblCIRNData.Caption := 'Data*'; //VistaWeb On
855 lblCIRN.Width := 43;
856 lblCIRNData.Width := 43;
857 lblCIRNData.Alignment := taCenter;
858 lblCIRN.Alignment := taCenter;
859 lblCIRN.Enabled := True;
860 lblCIRNData.Enabled := True;
861 pnlCIRN.TabStop := True;
862 if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then
863 begin
864 lblCIRN.Font.Color := clBlue;
865 lblCIRNData.Font.Color := clBlue;
866 lblCIRNAvail.Font.Color := clBlue;
867 lstCIRNLocations.Font.Color := clBlue;
868 end
869 else
870 begin
871 lblCIRN.Font.Color := clWindowText;
872 lblCIRNData.Font.Color := clWindowText;
873 lblCIRNAvail.Font.Color := clWindowText;
874 lstCIRNLocations.Font.Color := clWindowText;
875 end;
876 end;
877
878 end;
879
880 procedure TfrmOptions.cbLanguageChange(Sender: TObject); //kt added 6/29/07
881 var iIndex: Integer;
882 begin
883 iIndex := cbLanguage.ItemIndex;
884 if iIndex<0 then iIndex := 0; // When there's no valid selection in cbLanguage we use the default language (Index=0)
885 try
886 LangManager.LanguageID := LangManager.LanguageIDs[iIndex];
887 except
888 on EReadError do begin
889 //do nothing. Ignore error.
890 end
891 end;
892 frmFrame.Caption := TX_IN_USE + MixedCase(User.Name) + ' (' + RPCBrokerV.Server + ')'; //kt added
893 frmFrame.RenameTabs; //Resets names of tabs to correct translation //kt
894 frmFrame.mnuFileRefreshClick(self); //elh 6/23/08
895 uTMGOptions.WriteInteger('Language',LangManager.LanguageID);
896 end;
897
898 procedure TfrmOptions.Button1Click(Sender: TObject);
899 begin
900 MessageDlg('For a given language to be available, a *.lng (e.g. spanish.lng) '+
901 'must be in the same directory as CPRSchart.exe. This *.lng file '+
902 'may be created at any time by users by working with the CPRSchart.dklng '+
903 'file with the free language editor found at: '+
904 'http://www.dk-soft.org/products/dklang/',mtInformation,[mbOK],0);
905 end;
906
907 procedure TfrmOptions.btnApplySkinClick(Sender: TObject); //kt added
908 var fileS : String;
909 begin
910 {$IFDEF USE_SKINS}
911 fileS := '';
912 if lbSkins.ItemIndex > -1 then fileS := lbSkins.Items [lbSkins.ItemIndex];
913 frmFrame.CurrentSkinFile := 'TMG_Extra\Skins\' +fileS;
914 frmFrame.ActivateCurrentSkin;
915 btnApplyClick(btnOK);
916 {$ELSE}
917 MessageDlg('Use of skins has been disabled at compile time.',mtInformation,[mbOK],0);
918 {$ENDIF}
919 end;
920
921 procedure TfrmOptions.btnMoreSkinsClick(Sender: TObject); //kt added
922 begin
923 ShellExecute (Handle, 'open', 'http://www2.wincustomize.com/Skins.aspx?LibID=12&view=1&sortby=9&sortdir=DESC&p=1&advanced=0&mode=1&u=0', nil, nil, SW_SHOWNORMAL);
924 end;
925
926 procedure TfrmOptions.FillSkinList; //kt added
927 var
928 SRec : TSearchRec;
929 R : Integer;
930 begin
931 lbSkins.Items.Clear;
932 R := FindFirst (ExtractFilePath (Application.ExeName) + 'TMG_Extra\Skins\*.ipz', faAnyFile, SRec);
933 while R = 0 do
934 begin
935 lbSkins.Items.Add (SRec.Name);
936 R := FindNext (SRec);
937 end;
938 lbSkins.Sorted := true;
939 lbSkins.ItemIndex := 0;
940 end;
941
942 procedure TfrmOptions.FormShow(Sender: TObject); //kt added
943 begin
944 FillSkinList;
945 end;
946
947 procedure TfrmOptions.lbSkinsKeyPress(Sender: TObject; var Key: Char); //kt added
948 begin
949 if Key = #13 then btnApplySkinClick (Self);
950 end;
951
952 procedure TfrmOptions.btnDisableSkinClick(Sender: TObject); //kt added
953 begin
954 frmFrame.InactivateSkin;
955 end;
956
957 procedure TfrmOptions.cbSkinAtStartupClick(Sender: TObject);
958 begin
959 frmFrame.SkinAtStartup := cbSkinAtStartup.Checked;
960 uTMGOptions.WriteBool('Load Skin At Startup',frmFrame.SkinAtStartup); //kt 9/11/08
961 end;
962
963end.
964
Note: See TracBrowser for help on using the repository browser.