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

Last change on this file since 608 was 490, checked in by Kevin Toppenberg, 17 years ago

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