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

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

new RPC broker
File size: 34.1 KB
Line 
1//kt -- Modified with SourceScanner on 8/8/2007
2unit fOptions;
3
4interface
5
6uses
7 Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
8 Buttons, ComCtrls, ExtCtrls, ORCtrls, OrFn, Dialogs, ORDtTmRng, fBAOptionsDiagnoses,
9 uBAGlobals, TntStdCtrls, DKLang, jpeg, inifiles;
10
11//kt added 6/29/07 ------------------
12{Note: an additional tab was added to form: tsLanguage, with caption "Language"
13 It contained a combo box (TTntComboxBox to support unicode language display)
14 It has an on change event added below. There was a memo field describing
15 how adding languages works:
16
17 For a given language to be available, a *.lng (e.g. spanish.lng) must be in the
18 same directory as CPRSchart.exe. *.lng may be created by users by working
19 with the CPRSchart.dklng file with the free language editor found at:
20 http://www.dk-soft.org/products/dklang/
21
22 Note: Cancel for language change is not currently supported
23//kt 9/8/08 ----------------------------
24 Also, a tab was added to the form: Appearance, for selecting skins.
25 }
26
27type
28 TfrmOptions = class(TForm)
29 pnlMain: TPanel;
30 pnlBottom: TPanel;
31 pagOptions: TPageControl;
32 tsCoverSheet: TTabSheet;
33 tsNotifications: TTabSheet;
34 btnOK: TButton;
35 btnCancel: TButton;
36 btnApply: TButton;
37 tsOrderChecks: TTabSheet;
38 tsListsTeams: TTabSheet;
39 tsLanguage: TTabSheet; //kt added 6/29/07 (added in form editor)
40 lblCoverReminderDesc: TMemo;
41 lblCoverReminders: TStaticText;
42 lblCoverDaysDesc: TMemo;
43 lblCoverDays: TStaticText;
44 btnCoverDays: TButton;
45 bvlCoverDays: TBevel;
46 btnCoverReminders: TButton;
47 bvlCoverReminders: TBevel;
48 imgCoverDays: TImage;
49 imgCoverReminders: TImage;
50 lblPatientSelectionDesc: TMemo;
51 lblPatientSelection: TStaticText;
52 btnPatientSelection: TButton;
53 bvlPatientSelection: TBevel;
54 btnPersonalLists: TButton;
55 imgPatientSelection: TImage;
56 lblNotificationsOptions: TStaticText;
57 lblNotifications: TStaticText;
58 bvlNotifications: TBevel;
59 imgNotifications: TImage;
60 lblOrderChecksDesc: TLabel;
61 lblOrderChecks: TStaticText;
62 bvlOrderChecks: TBevel;
63 imgOrderChecks: TImage;
64 lblTeamsDesc: TMemo;
65 lblTeams: TStaticText;
66 btnTeams: TButton;
67 bvlTeams: TBevel;
68 lvwNotifications: TCaptionListView;
69 lblNotificationView: TLabel;
70 btnNotificationsRemove: TButton;
71 chkNotificationsFlagged: TCheckBox;
72 lvwOrderChecks: TCaptionListView;
73 lblOrderChecksView: TLabel;
74 btnSurrogate: TButton;
75 lblNotificationsSurrogate: TStaticText;
76 lblNotificationsSurrogateText: TStaticText;
77 btnCombinations: TButton;
78 bvlOtherParameters: TBevel;
79 lblOtherParameters: TStaticText;
80 imgOtherParameters: TImage;
81 lblOtherParametersDesc: TMemo;
82 btnOtherParameters: TButton;
83 tsNotes: TTabSheet;
84 lblNotesNotesDesc: TMemo;
85 lblNotesNotes: TStaticText;
86 bvlNotesNotes: TBevel;
87 btnNotesNotes: TButton;
88 lblNotesTitles: TStaticText;
89 bvlNotesTitles: TBevel;
90 lblNotesTitlesDesc: TMemo;
91 btnNotesTitles: TButton;
92 imgNotesNotes: TImage;
93 imgNotes: TImage;
94 imgTeams: TImage;
95 tsCprsReports: TTabSheet;
96 lblReports: TStaticText;
97 bvlReports: TBevel;
98 memReports: TMemo;
99 imgReports: TImage;
100 btnReports: TButton;
101 lblReport1: TStaticText;
102 memReport1: TMemo;
103 btnReport1: TButton;
104 bvlReport1: TBevel;
105 btnDiagnoses: TButton;
106 tsGraphs: TTabSheet;
107 lblGraphSettings: TStaticText;
108 bvlGraphSettings: TBevel;
109 imgGraphSettings: TImage;
110 btnGraphSettings: TButton;
111 bvlGraphViews: TBevel;
112 lblGraphViews: TStaticText;
113 imgGraphViews: TImage;
114 btnGraphViews: TButton;
115 memGraphSettings: TMemo;
116 memGraphViews: TMemo;
117 bvlReport2: TBevel;
118 lblReport2: TStaticText;
119 memReport2: TMemo;
120 imgReport1: TImage;
121 imgReport2: TImage;
122 rdoRDV: TRadioGroup;
123 cbLanguage: TTntComboBox;
124 Label1: TLabel;
125 Label2: TLabel;
126 DKLanguageController1: TDKLanguageController;
127 Image1: TImage;
128 Memo1: TMemo;
129 Button1: TButton;
130 tsAppearance: TTabSheet;
131 Label12: TLabel;
132 lbSkins: TListBox;
133 cbSkinAtStartup: TCheckBox;
134 btnMoreSkins: TButton;
135 btnDisableSkin: TButton;
136 btnApplySkin: TButton;
137 procedure FormCreate(Sender: TObject);
138 procedure FormDestroy(Sender: TObject);
139 procedure btnCoverDaysClick(Sender: TObject);
140 procedure btnCoverRemindersClick(Sender: TObject);
141 procedure btnOtherParametersClick(Sender: TObject);
142 procedure btnPatientSelectionClick(Sender: TObject);
143 procedure btnPersonalListsClick(Sender: TObject);
144 procedure btnTeamsClick(Sender: TObject);
145 procedure btnNotificationsRemoveClick(Sender: TObject);
146 procedure btnApplyClick(Sender: TObject);
147 procedure chkNotificationsFlaggedClick(Sender: TObject);
148 procedure lvwNotificationsChange(Sender: TObject; Item: TListItem;
149 Change: TItemChange);
150 procedure lvwNotificationsColumnClick(Sender: TObject;
151 Column: TListColumn);
152 procedure lvwNotificationsCompare(Sender: TObject; Item1,
153 Item2: TListItem; Data: Integer; var Compare: Integer);
154 procedure lvwNotificationsDblClick(Sender: TObject);
155 procedure btnSurrogateClick(Sender: TObject);
156 procedure btnCombinationsClick(Sender: TObject);
157 procedure btnNotesNotesClick(Sender: TObject);
158 procedure btnNotesTitlesClick(Sender: TObject);
159 procedure btnReportsClick(Sender: TObject);
160 procedure btnReport1Click(Sender: TObject);
161 procedure lvwNotificationsEnter(Sender: TObject);
162 procedure lvwNotificationsMouseDown(Sender: TObject;
163 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
164 procedure btnDiagnosesClick(Sender: TObject);
165 procedure btnGraphSettingsClick(Sender: TObject);
166 procedure btnGraphViewsClick(Sender: TObject);
167 procedure rdoRDVClick(Sender: TObject);
168 procedure cbLanguageChange(Sender: TObject);
169 procedure Button1Click(Sender: TObject);
170 procedure btnApplySkinClick(Sender: TObject);
171 procedure btnMoreSkinsClick(Sender: TObject);
172 procedure FormShow(Sender: TObject);
173 procedure lbSkinsKeyPress(Sender: TObject; var Key: Char);
174 procedure btnDisableSkinClick(Sender: TObject); //kt added 6/29/07
175 private
176 { Private declarations }
177 FdirtyNotifications: boolean; // used to determine edit changes to Notifications
178 FdirtyOrderChecks: boolean; // used to determine edit changes to Order Checks
179 FdirtyOtherStuff: boolean; // used to determine edit changes to misc settings
180 FuseCheckBoxes: boolean;
181 FsortCol: integer;
182 FsortAscending: boolean;
183 FLastClickedItem: TListItem;
184 procedure FillSkinList; //kt
185 procedure Offset(var topnum: integer; topoffset: integer; var leftnum: integer; leftoffset: integer);
186 procedure LoadNotifications;
187 procedure LoadOrderChecks;
188 procedure ApplyNotifications;
189 procedure ApplyOrderChecks;
190 procedure ApplyOtherStuff;
191 procedure CheckApply;
192 procedure LoadListView(aListView: TListView; aList: TStrings);
193 procedure ChangeOnOff(aListView: TListView; aListItem: TListItem);
194 public
195 { Public declarations }
196 end;
197
198var
199 frmOptions: TfrmOptions;
200
201procedure DialogOptions(var actiontype: Integer);
202
203implementation
204
205 uses fOptionsDays, fOptionsReminders, fOptionsSurrogate,
206 fOptionsPatientSelection, fOptionsLists, fOptionsTeams, fOptionsCombinations,
207 fOptionsOther, fOptionsNotes, fOptionsTitles, fOptionsReportsCustom, fOptionsReportsDefault,
208 fGraphs, fGraphSettings, fGraphProfiles, rGraphs, uGraphs,
209 rOptions, rCore, uCore, uOptions, UBACore, fFrame,
210 //fTestDialog;
211
212 //kt mod 6/29/07 -----
213 ShellAPI, //kt 9/8/08
214 ORNet, //allows access to RPCBrokerV
215 TntForms, TntSystem, TntSysUtils;
216 //kt end mod ---------
217
218
219{$R *.DFM}
220
221 type
222 TRule = class
223 public
224 IEN: string;
225 OriginalValue: string;
226 ItemText: string;
227 end;
228
229 procedure DialogOptions(var actiontype: Integer);
230 // create the form and make in modal, return an action
231 const
232 PixelGapBetweenButtons = 5;
233 var
234 frmOptions: TfrmOptions;
235 begin
236 frmOptions := TfrmOptions.Create(Application);
237 try
238 with frmOptions do
239 begin
240 cbSkinAtStartup.Checked := frmFrame.SkinAtStartup;
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.
280 begin
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;
293 end;
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;
311 end;
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;
319 end;
320 finally
321 frmFrame.SkinAtStartup := frmOptions.cbSkinAtStartup.Checked;
322 frmOptions.Release;
323 end;
324 end;
325
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;
336
337 if (Encounter.Provider = 0) and not IsCIDCProvider(User.DUZ) then
338 btnDiagnoses.Enabled := False;
339 if UseVistaWeb then rdoRDV.ItemIndex := 1;
340
341 //kt begin modification 6/29/07 ---------------
342
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
350 cbSkinAtStartup.Checked := frmFrame.SkinAtStartup; //kt 9/8/08
351
352 end;
353
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;
364
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;
374
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;
384
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;
394
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;
404
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;
414
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;
424
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;
440
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;
452
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;
466
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;
483
484 procedure TfrmOptions.LoadOrderChecks;
485 // load Order Check tab
486 begin
487 LoadListView(lvwOrderChecks, rpcGetOrderChecks);
488 lvwOrderChecks.Checkboxes := true;
489 end;
490
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;
519
520 procedure TfrmOptions.ApplyOrderChecks;
521 // save Order Check changes
522 var
523 i: integer;
524 newonoff: string;
525 aRule: TRule;
526 aList: TStringList;
527 begin
528 aList := TStringList.Create;
529 for i := 0 to lvwOrderChecks.Items.Count - 1 do
530 begin
531 aRule := TRule(lvwOrderChecks.Items.Item[i].SubItems.Objects[2]);
532 newonoff := Uppercase(lvwOrderChecks.Items.Item[i].SubItems[0]);
533 if aRule.OriginalValue <> newonoff then
534 begin
535 aList.Add(aRule.IEN + '^' + newonoff);
536 aRule.OriginalValue := lvwOrderChecks.Items.Item[i].SubItems[0];
537 end;
538 end;
539 rpcSetOrderChecks(aList);
540 aList.free;
541 FdirtyOrderChecks := false;
542 end;
543
544 procedure TfrmOptions.ApplyOtherStuff;
545 // save other changes
546 var
547 aString: string;
548 begin
549 aString := '';
550 if chkNotificationsFlagged.Checked then
551 aString := aString + '^1'
552 else
553 aString := aString + '^0';
554 rpcSetOtherStuff(aString);
555 FdirtyOtherStuff := false;
556 end;
557
558 procedure TfrmOptions.CheckApply;
559 // determine if Apply button is enabled
560 begin
561 btnApply.Enabled := FdirtyOrderChecks or FdirtyNotifications or FdirtyOtherStuff;
562 end;
563
564 procedure TfrmOptions.chkNotificationsFlaggedClick(Sender: TObject);
565 // set notification flagged status
566 begin
567 FdirtyOtherStuff := true;
568 CheckApply;
569 end;
570
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;
578 begin
579 FuseCheckBoxes := false;
580 aListView.Items.Clear;
581 aListView.SortType := stNone; // if Sorting during load then potential error
582 with aList do
583 begin
584 for i := 0 to aList.Count - 1 do
585 begin
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
607 end;
608 end;
609 aListView.SortType := stBoth;
610 FuseCheckBoxes := true;
611 end;
612
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;
639 end;
640
641 procedure TfrmOptions.lvwNotificationsColumnClick(Sender: TObject;
642 Column: TListColumn);
643 // toggle sort
644 begin
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
656 begin
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;
674 end;
675
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);
691
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
702 begin
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;
713 begin
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;
719 end;
720
721 procedure TfrmOptions.btnCombinationsClick(Sender: TObject);
722 // display Combination List Options
723 var
724 topsize, leftsize, value: integer;
725 begin
726 value := 0;
727 Offset(topsize, -60, leftsize, -60);
728 DialogOptionsCombinations(topsize, leftsize, Font.Size, value);
729 end;
730
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);
739 end;
740
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;
750
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;
759
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;
768
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;
776
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;
782
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;
795
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;
806
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);
816 end;
817
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;
864
865 end;
866
867 procedure TfrmOptions.cbLanguageChange(Sender: TObject); //kt added 6/29/07
868 var iIndex: Integer;
869 CPRSChartINI: TINIFile;
870 begin
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;
886 end;
887
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;
896
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;
905 btnApplyClick(btnOK);
906 {$ELSE}
907 MessageDlg('Use of skins has been disabled at compile time.',mtInformation,[mbOK],0);
908 {$ENDIF}
909 end;
910
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
924 begin
925 lbSkins.Items.Add (SRec.Name);
926 R := FindNext (SRec);
927 end;
928 lbSkins.Sorted := true;
929 lbSkins.ItemIndex := 0;
930 end;
931
932 procedure TfrmOptions.FormShow(Sender: TObject); //kt added
933 begin
934 FillSkinList;
935 end;
936
937 procedure TfrmOptions.lbSkinsKeyPress(Sender: TObject; var Key: Char); //kt added
938 begin
939 if Key = #13 then btnApplySkinClick (Self);
940 end;
941
942 procedure TfrmOptions.btnDisableSkinClick(Sender: TObject); //kt added
943 begin
944 frmFrame.InactivateSkin;
945 end;
946
947end.
948
Note: See TracBrowser for help on using the repository browser.