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

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

Fixed Text Object Parameters

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