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

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

Added functions to Templates, and Images tab
File size: 34.3 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);
175 procedure cbSkinAtStartupClick(Sender: TObject); //kt added 6/29/07
176 private
177 { Private declarations }
178 FdirtyNotifications: boolean; // used to determine edit changes to Notifications
179 FdirtyOrderChecks: boolean; // used to determine edit changes to Order Checks
180 FdirtyOtherStuff: boolean; // used to determine edit changes to misc settings
181 FuseCheckBoxes: boolean;
182 FsortCol: integer;
183 FsortAscending: boolean;
184 FLastClickedItem: TListItem;
185 procedure FillSkinList; //kt
186 procedure Offset(var topnum: integer; topoffset: integer; var leftnum: integer; leftoffset: integer);
187 procedure LoadNotifications;
188 procedure LoadOrderChecks;
189 procedure ApplyNotifications;
190 procedure ApplyOrderChecks;
191 procedure ApplyOtherStuff;
192 procedure CheckApply;
193 procedure LoadListView(aListView: TListView; aList: TStrings);
194 procedure ChangeOnOff(aListView: TListView; aListItem: TListItem);
195 public
196 { Public declarations }
197 end;
198
199var
200 frmOptions: TfrmOptions;
201
202procedure DialogOptions(var actiontype: Integer);
203
204implementation
205
206 uses fOptionsDays, fOptionsReminders, fOptionsSurrogate,
207 fOptionsPatientSelection, fOptionsLists, fOptionsTeams, fOptionsCombinations,
208 fOptionsOther, fOptionsNotes, fOptionsTitles, fOptionsReportsCustom, fOptionsReportsDefault,
209 fGraphs, fGraphSettings, fGraphProfiles, rGraphs, uGraphs,
210 rOptions, rCore, uCore, uOptions, UBACore, fFrame,
211 //fTestDialog;
212 //kt mod 6/29/07 -----
213 ShellAPI, //kt 9/8/08
214 uTMGOptions, //kt 2/10/10
215 ORNet, //allows access to RPCBrokerV
216 TntForms, TntSystem, TntSysUtils;
217 //kt end mod ---------
218
219
220{$R *.DFM}
221
222 type
223 TRule = class
224 public
225 IEN: string;
226 OriginalValue: string;
227 ItemText: string;
228 end;
229
230 procedure DialogOptions(var actiontype: Integer);
231 // create the form and make in modal, return an action
232 const
233 PixelGapBetweenButtons = 5;
234 var
235 frmOptions: TfrmOptions;
236 begin
237 frmOptions := TfrmOptions.Create(Application);
238 try
239 with frmOptions do
240 begin
241 cbSkinAtStartup.Checked := frmFrame.SkinAtStartup;
242 with pagOptions do
243 begin
244 tsCoverSheet.TabVisible := false;
245 tsNotifications.TabVisible := false;
246 tsOrderChecks.TabVisible := false;
247 tsListsTeams.TabVisible := false;
248 case actiontype of
249 1: begin
250 tsCoverSheet.TabVisible := true;
251 end;
252 2: begin
253 tsNotifications.TabVisible := true;
254 end;
255 3: begin
256 tsOrderChecks.TabVisible := true;
257 end;
258 4: begin
259 tsListsTeams.TabVisible := true;
260 end;
261 else
262 begin
263 tsCoverSheet.TabVisible := true;
264 tsNotifications.TabVisible := true;
265 tsOrderChecks.TabVisible := true;
266 tsListsTeams.TabVisible := true;
267 ActivePage := tsCoverSheet;
268 // memReports.Text := 'Change the default date range and occurrence limits for all reports on ' + <-- original line. //kt 8/8/2007
269 memReports.Text := DKLangConstW('fOptions_Change_the_default_date_range_and_occurrence_limits_for_all_reports_on') + //kt added 8/8/2007
270 // 'the CPRS Reports tab (excluding health summary reports) .'; <-- original line. //kt 8/8/2007
271 DKLangConstW('fOptions_the_CPRS_Reports_tab_xexcluding_health_summary_reportsx_x'); //kt added 8/8/2007
272 // memReport1.Text := 'Change the individual date range and occurrence limits for each report on ' + <-- original line. //kt 8/8/2007
273 memReport1.Text := DKLangConstW('fOptions_Change_the_individual_date_range_and_occurrence_limits_for_each_report_on') + //kt added 8/8/2007
274 // 'the CPRS Reports tab (excluding health summary reports) .'; <-- original line. //kt 8/8/2007
275 DKLangConstW('fOptions_the_CPRS_Reports_tab_xexcluding_health_summary_reportsx_x'); //kt added 8/8/2007
276 // btnReports.caption := 'Set All Reports...'; <-- original line. //kt 8/8/2007
277 btnReports.caption := DKLangConstW('fOptions_Set_All_Reportsxxx'); //kt added 8/8/2007
278 // btnReport1.caption := 'Set Individual Reports...'; <-- original line. //kt 8/8/2007
279 btnReport1.caption := DKLangConstW('fOptions_Set_Individual_Reportsxxx'); //kt added 8/8/2007
280 if User.IsReportsOnly then // For "Reports Only" users.
281 begin
282 tsCoverSheet.TabVisible := false;
283 tsNotifications.TabVisible := false;
284 tsOrderChecks.TabVisible := false;
285 tsListsTeams.TabVisible := false;
286 tsNotes.TabVisible := false;
287 if (not User.ToolsRptEdit) then
288 begin
289 btnOK.visible := false;
290 btnApply.visible := false;
291 // btnCancel.caption := 'Close'; <-- original line. //kt 8/8/2007
292 btnCancel.caption := DKLangConstW('fOptions_Close'); //kt added 8/8/2007
293 end;
294 end;
295 if (not User.ToolsRptEdit) then // For users with Reports settings edit parameter not set.
296 begin
297 // memReports.Text := 'View the default date range and occurrence limits for all reports on ' + <-- original line. //kt 8/8/2007
298 memReports.Text := DKLangConstW('fOptions_View_the_default_date_range_and_occurrence_limits_for_all_reports_on') + //kt added 8/8/2007
299 // 'the CPRS Reports tab (excluding health summary reports) .'; <-- original line. //kt 8/8/2007
300 DKLangConstW('fOptions_the_CPRS_Reports_tab_xexcluding_health_summary_reportsx_x'); //kt added 8/8/2007
301 // memReport1.Text := 'View the individual date range and occurrence limits for each report on ' + <-- original line. //kt 8/8/2007
302 memReport1.Text := DKLangConstW('fOptions_View_the_individual_date_range_and_occurrence_limits_for_each_report_on') + //kt added 8/8/2007
303 // 'the CPRS Reports tab (excluding health summary reports) .'; <-- original line. //kt 8/8/2007
304 DKLangConstW('fOptions_the_CPRS_Reports_tab_xexcluding_health_summary_reportsx_x'); //kt added 8/8/2007
305 // btnReports.caption := 'View All Report Settings...'; <-- original line. //kt 8/8/2007
306 btnReports.caption := DKLangConstW('fOptions_View_All_Report_Settingsxxx'); //kt added 8/8/2007
307 // btnReport1.caption := 'View Individual Report Settings...'; <-- original line. //kt 8/8/2007
308 btnReport1.caption := DKLangConstW('fOptions_View_Individual_Report_Settingsxxx'); //kt added 8/8/2007
309 end;
310 end;
311 end;
312 end;
313 actiontype := 0;
314 ResizeAnchoredFormToFont(frmOptions);
315 btnApply.Left := pagOptions.Left + pagOptions.Width - btnApply.Width;
316 btnCancel.Left := btnApply.Left - btnCancel.Width - PixelGapBetweenButtons;
317 btnOK.Left := btnCancel.Left - btnOK.Width - PixelGapBetweenButtons;
318 ShowModal;
319 actiontype := btnOK.Tag;
320 end;
321 finally
322 frmFrame.SkinAtStartup := frmOptions.cbSkinAtStartup.Checked;
323 frmOptions.Release;
324 end;
325 end;
326
327 procedure TfrmOptions.FormCreate(Sender: TObject);
328 // initialize form
329 var i : integer; //kt added 6/29/07
330 begin
331 LoadNotifications;
332 LoadOrderChecks;
333 FdirtyNotifications := false;
334 FdirtyOrderChecks := false;
335 FdirtyOtherStuff := false;
336 CheckApply;
337
338 if (Encounter.Provider = 0) and not IsCIDCProvider(User.DUZ) then
339 btnDiagnoses.Enabled := False;
340 if UseVistaWeb then rdoRDV.ItemIndex := 1;
341
342 //kt begin modification 6/29/07 ---------------
343 // Fill cbLanguage with available languages
344 // Note: LangManager was populated at form creation of fFrame
345 for i := 0 to LangManager.LanguageCount-1 do cbLanguage.Items.Add(LangManager.LanguageNames[i]);
346 //Index=0 always means the default language
347 cbLanguage.ItemIndex := LangManager.LanguageIndex;
348 //kt end modification 6/29/07 ---------------
349 cbSkinAtStartup.Checked := frmFrame.SkinAtStartup; //kt 9/8/08
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 begin
868 iIndex := cbLanguage.ItemIndex;
869 if iIndex<0 then iIndex := 0; // When there's no valid selection in cbLanguage we use the default language (Index=0)
870 try
871 LangManager.LanguageID := LangManager.LanguageIDs[iIndex];
872 except
873 on EReadError do begin
874 //do nothing. Ignore error.
875 end
876 end;
877 frmFrame.Caption := TX_IN_USE + MixedCase(User.Name) + ' (' + RPCBrokerV.Server + ')'; //kt added
878 frmFrame.RenameTabs; //Resets names of tabs to correct translation //kt
879 frmFrame.mnuFileRefreshClick(self); //elh 6/23/08
880 uTMGOptions.WriteInteger('Language',LangManager.LanguageID);
881 end;
882
883 procedure TfrmOptions.Button1Click(Sender: TObject);
884 begin
885 MessageDlg('For a given language to be available, a *.lng (e.g. spanish.lng) '+
886 'must be in the same directory as CPRSchart.exe. This *.lng file '+
887 'may be created at any time by users by working with the CPRSchart.dklng '+
888 'file with the free language editor found at: '+
889 'http://www.dk-soft.org/products/dklang/',mtInformation,[mbOK],0);
890 end;
891
892 procedure TfrmOptions.btnApplySkinClick(Sender: TObject); //kt added
893 var fileS : String;
894 begin
895 {$IFDEF USE_SKINS}
896 fileS := '';
897 if lbSkins.ItemIndex > -1 then fileS := lbSkins.Items [lbSkins.ItemIndex];
898 frmFrame.CurrentSkinFile := 'TMG_Extra\Skins\' +fileS;
899 frmFrame.ActivateCurrentSkin;
900 btnApplyClick(btnOK);
901 {$ELSE}
902 MessageDlg('Use of skins has been disabled at compile time.',mtInformation,[mbOK],0);
903 {$ENDIF}
904 end;
905
906 procedure TfrmOptions.btnMoreSkinsClick(Sender: TObject); //kt added
907 begin
908 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);
909 end;
910
911 procedure TfrmOptions.FillSkinList; //kt added
912 var
913 SRec : TSearchRec;
914 R : Integer;
915 begin
916 lbSkins.Items.Clear;
917 R := FindFirst (ExtractFilePath (Application.ExeName) + 'TMG_Extra\Skins\*.ipz', faAnyFile, SRec);
918 while R = 0 do
919 begin
920 lbSkins.Items.Add (SRec.Name);
921 R := FindNext (SRec);
922 end;
923 lbSkins.Sorted := true;
924 lbSkins.ItemIndex := 0;
925 end;
926
927 procedure TfrmOptions.FormShow(Sender: TObject); //kt added
928 begin
929 FillSkinList;
930 end;
931
932 procedure TfrmOptions.lbSkinsKeyPress(Sender: TObject; var Key: Char); //kt added
933 begin
934 if Key = #13 then btnApplySkinClick (Self);
935 end;
936
937 procedure TfrmOptions.btnDisableSkinClick(Sender: TObject); //kt added
938 begin
939 frmFrame.InactivateSkin;
940 end;
941
942 procedure TfrmOptions.cbSkinAtStartupClick(Sender: TObject);
943 begin
944 frmFrame.SkinAtStartup := cbSkinAtStartup.Checked;
945 uTMGOptions.WriteBool('Load Skin At Startup',frmFrame.SkinAtStartup); //kt 9/11/08
946 end;
947
948end.
949
Note: See TracBrowser for help on using the repository browser.