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

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

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