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
RevLine 
[453]1//kt -- Modified with SourceScanner on 8/8/2007
2unit fOptions;
3
4interface
5
[487]6uses
7 Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
[453]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
[487]23//kt 9/8/08 ----------------------------
24 Also, a tab was added to the form: Appearance, for selecting skins.
[453]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;
[487]130 tsAppearance: TTabSheet;
131 Label12: TLabel;
132 lbSkins: TListBox;
133 cbSkinAtStartup: TCheckBox;
134 btnMoreSkins: TButton;
135 btnDisableSkin: TButton;
136 btnApplySkin: TButton;
[453]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);
[487]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);
[729]174 procedure btnDisableSkinClick(Sender: TObject);
175 procedure cbSkinAtStartupClick(Sender: TObject); //kt added 6/29/07
[453]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;
[487]185 procedure FillSkinList; //kt
[453]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
[487]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;
[453]212 //kt mod 6/29/07 -----
[487]213 ShellAPI, //kt 9/8/08
[729]214 uTMGOptions, //kt 2/10/10
[453]215 ORNet, //allows access to RPCBrokerV
216 TntForms, TntSystem, TntSysUtils;
217 //kt end mod ---------
218
219
220{$R *.DFM}
221
[487]222 type
223 TRule = class
224 public
225 IEN: string;
226 OriginalValue: string;
227 ItemText: string;
228 end;
[453]229
[487]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
[453]240 begin
[490]241 cbSkinAtStartup.Checked := frmFrame.SkinAtStartup;
[487]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.
[453]281 begin
[487]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;
[453]294 end;
[487]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;
[453]312 end;
[487]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;
[453]320 end;
[487]321 finally
[490]322 frmFrame.SkinAtStartup := frmOptions.cbSkinAtStartup.Checked;
[487]323 frmOptions.Release;
[453]324 end;
325 end;
326
[487]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;
[453]337
[487]338 if (Encounter.Provider = 0) and not IsCIDCProvider(User.DUZ) then
339 btnDiagnoses.Enabled := False;
340 if UseVistaWeb then rdoRDV.ItemIndex := 1;
[453]341
[487]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;
[453]351
[487]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;
[453]362
[487]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;
[453]372
[487]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;
[453]382
[487]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;
[453]392
[487]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;
[453]402
[487]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;
[453]412
[487]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;
[453]422
[487]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;
[453]438
[487]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;
[453]450
[487]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;
[453]464
[487]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;
[453]481
[487]482 procedure TfrmOptions.LoadOrderChecks;
483 // load Order Check tab
484 begin
485 LoadListView(lvwOrderChecks, rpcGetOrderChecks);
486 lvwOrderChecks.Checkboxes := true;
487 end;
[453]488
[487]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;
[453]517
[487]518 procedure TfrmOptions.ApplyOrderChecks;
519 // save Order Check changes
520 var
521 i: integer;
522 newonoff: string;
523 aRule: TRule;
524 aList: TStringList;
[453]525 begin
[487]526 aList := TStringList.Create;
527 for i := 0 to lvwOrderChecks.Items.Count - 1 do
[453]528 begin
[487]529 aRule := TRule(lvwOrderChecks.Items.Item[i].SubItems.Objects[2]);
530 newonoff := Uppercase(lvwOrderChecks.Items.Item[i].SubItems[0]);
[453]531 if aRule.OriginalValue <> newonoff then
532 begin
533 aList.Add(aRule.IEN + '^' + newonoff);
[487]534 aRule.OriginalValue := lvwOrderChecks.Items.Item[i].SubItems[0];
[453]535 end;
536 end;
[487]537 rpcSetOrderChecks(aList);
538 aList.free;
539 FdirtyOrderChecks := false;
[453]540 end;
541
[487]542 procedure TfrmOptions.ApplyOtherStuff;
543 // save other changes
544 var
545 aString: string;
[453]546 begin
[487]547 aString := '';
548 if chkNotificationsFlagged.Checked then
549 aString := aString + '^1'
550 else
551 aString := aString + '^0';
552 rpcSetOtherStuff(aString);
553 FdirtyOtherStuff := false;
[453]554 end;
555
[487]556 procedure TfrmOptions.CheckApply;
557 // determine if Apply button is enabled
558 begin
559 btnApply.Enabled := FdirtyOrderChecks or FdirtyNotifications or FdirtyOtherStuff;
560 end;
[453]561
[487]562 procedure TfrmOptions.chkNotificationsFlaggedClick(Sender: TObject);
563 // set notification flagged status
564 begin
565 FdirtyOtherStuff := true;
566 CheckApply;
567 end;
[453]568
[487]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;
[453]576 begin
[487]577 FuseCheckBoxes := false;
578 aListView.Items.Clear;
579 aListView.SortType := stNone; // if Sorting during load then potential error
580 with aList do
[453]581 begin
[487]582 for i := 0 to aList.Count - 1 do
[453]583 begin
[487]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
[453]605 end;
606 end;
[487]607 aListView.SortType := stBoth;
608 FuseCheckBoxes := true;
[453]609 end;
610
[487]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;
[453]637 end;
[487]638
639 procedure TfrmOptions.lvwNotificationsColumnClick(Sender: TObject;
640 Column: TListColumn);
641 // toggle sort
[453]642 begin
[487]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
[453]654 begin
[487]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;
[453]672 end;
673
[487]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);
[453]689
[487]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
[453]700 begin
[487]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;
[453]711 begin
[487]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;
[453]717 end;
718
[487]719 procedure TfrmOptions.btnCombinationsClick(Sender: TObject);
720 // display Combination List Options
721 var
722 topsize, leftsize, value: integer;
[453]723 begin
[487]724 value := 0;
725 Offset(topsize, -60, leftsize, -60);
726 DialogOptionsCombinations(topsize, leftsize, Font.Size, value);
727 end;
[453]728
[487]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);
[453]737 end;
738
[487]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;
[453]748
[487]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;
[453]757
[487]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;
[453]766
[487]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;
[453]774
[487]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;
[453]780
[487]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;
[453]793
[487]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;
[453]804
[487]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);
[453]814 end;
815
[487]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;
[453]862
[487]863 end;
864
865 procedure TfrmOptions.cbLanguageChange(Sender: TObject); //kt added 6/29/07
866 var iIndex: Integer;
[453]867 begin
[487]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
[729]880 uTMGOptions.WriteInteger('Language',LangManager.LanguageID);
[453]881 end;
882
[487]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;
[453]891
[487]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;
[489]900 btnApplyClick(btnOK);
[487]901 {$ELSE}
902 MessageDlg('Use of skins has been disabled at compile time.',mtInformation,[mbOK],0);
903 {$ENDIF}
904 end;
[453]905
[487]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
[453]919 begin
[487]920 lbSkins.Items.Add (SRec.Name);
921 R := FindNext (SRec);
[453]922 end;
[487]923 lbSkins.Sorted := true;
924 lbSkins.ItemIndex := 0;
925 end;
[453]926
[487]927 procedure TfrmOptions.FormShow(Sender: TObject); //kt added
928 begin
929 FillSkinList;
930 end;
[453]931
[487]932 procedure TfrmOptions.lbSkinsKeyPress(Sender: TObject; var Key: Char); //kt added
933 begin
934 if Key = #13 then btnApplySkinClick (Self);
[453]935 end;
936
[487]937 procedure TfrmOptions.btnDisableSkinClick(Sender: TObject); //kt added
938 begin
939 frmFrame.InactivateSkin;
940 end;
[453]941
[729]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
[453]948end.
949
Note: See TracBrowser for help on using the repository browser.