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
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,
[738]9 uBAGlobals, TntStdCtrls, DKLang, jpeg, inifiles, uConst, StrUtils;
[453]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;
[735]137 tsImages: TTabSheet;
138 cbEnableImages: TCheckBox;
139 cboTransMethod: TComboBox;
140 Label3: TLabel;
[738]141 editDropboxLocation: TEdit;
[735]142 Label4: TLabel;
143 BitBtn1: TBitBtn;
144 dlgPickDir: TOpenDialog;
145 cbEnableScanning: TCheckBox;
146 Label5: TLabel;
[738]147 editScannedLocation: TEdit;
[735]148 BitBtn2: TBitBtn;
149 Label6: TLabel;
150 edtPolFreq: TEdit;
151 Label7: TLabel;
[453]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);
[487]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);
[729]189 procedure btnDisableSkinClick(Sender: TObject);
[738]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
[453]199 private
200 { Private declarations }
201 FdirtyNotifications: boolean; // used to determine edit changes to Notifications
[738]202 FdirtyImageSettings: boolean; // used to determine edit changes to Image Settings
[453]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;
[487]209 procedure FillSkinList; //kt
[453]210 procedure Offset(var topnum: integer; topoffset: integer; var leftnum: integer; leftoffset: integer);
211 procedure LoadNotifications;
[738]212 procedure LoadImageSettings;
[453]213 procedure LoadOrderChecks;
214 procedure ApplyNotifications;
215 procedure ApplyOrderChecks;
216 procedure ApplyOtherStuff;
[738]217 procedure ApplyImageSettings;
[453]218 procedure CheckApply;
219 procedure LoadListView(aListView: TListView; aList: TStrings);
220 procedure ChangeOnOff(aListView: TListView; aListItem: TListItem);
[738]221 function BrowseDialog(const Title: string; const Flag: integer): string;
[453]222 public
223 { Public declarations }
224 end;
225
226var
227 frmOptions: TfrmOptions;
228
229procedure DialogOptions(var actiontype: Integer);
230
231implementation
232
[487]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;
[453]239 //kt mod 6/29/07 -----
[487]240 ShellAPI, //kt 9/8/08
[729]241 uTMGOptions, //kt 2/10/10
[738]242 UploadImages, fImages, //elh 04/15/10
243 ShlObj, //elh 04/15/10
[453]244 ORNet, //allows access to RPCBrokerV
245 TntForms, TntSystem, TntSysUtils;
246 //kt end mod ---------
247
248
249{$R *.DFM}
250
[487]251 type
252 TRule = class
253 public
254 IEN: string;
255 OriginalValue: string;
256 ItemText: string;
257 end;
[453]258
[487]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
[453]269 begin
[490]270 cbSkinAtStartup.Checked := frmFrame.SkinAtStartup;
[487]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.
[453]310 begin
[487]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;
[453]323 end;
[487]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;
[453]341 end;
[487]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;
[453]349 end;
[487]350 finally
[490]351 frmFrame.SkinAtStartup := frmOptions.cbSkinAtStartup.Checked;
[487]352 frmOptions.Release;
[453]353 end;
354 end;
355
[487]356 procedure TfrmOptions.FormCreate(Sender: TObject);
357 // initialize form
358 var i : integer; //kt added 6/29/07
359 begin
360 LoadNotifications;
361 LoadOrderChecks;
[738]362 LoadImageSettings;
363 FdirtyImageSettings := false;
[487]364 FdirtyNotifications := false;
365 FdirtyOrderChecks := false;
366 FdirtyOtherStuff := false;
367 CheckApply;
[453]368
[487]369 if (Encounter.Provider = 0) and not IsCIDCProvider(User.DUZ) then
370 btnDiagnoses.Enabled := False;
371 if UseVistaWeb then rdoRDV.ItemIndex := 1;
[453]372
[487]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;
[453]382
[487]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;
[453]393
[487]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;
[453]403
[487]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;
[453]413
[487]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;
[453]423
[487]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;
[453]433
[487]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;
[453]443
[487]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]453
[487]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;
[453]469
[487]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;
[453]481
[487]482 procedure TfrmOptions.btnApplyClick(Sender: TObject);
483 // save actions without exiting
484 begin
485 if FdirtyNotifications then
486 ApplyNotifications;
[738]487 if FdirtyImageSettings then
488 ApplyImageSettings;
[487]489 if FdirtyOrderChecks then
490 ApplyOrderChecks;
491 if FdirtyOtherStuff then
492 ApplyOtherStuff;
493 CheckApply;
494 if Sender = btnOK then
495 Close;
496 end;
[453]497
[487]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;
[453]514
[738]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
[487]528 procedure TfrmOptions.LoadOrderChecks;
529 // load Order Check tab
530 begin
531 LoadListView(lvwOrderChecks, rpcGetOrderChecks);
532 lvwOrderChecks.Checkboxes := true;
533 end;
[453]534
[487]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;
[453]563
[738]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
[487]590 procedure TfrmOptions.ApplyOrderChecks;
591 // save Order Check changes
592 var
593 i: integer;
594 newonoff: string;
595 aRule: TRule;
596 aList: TStringList;
[453]597 begin
[487]598 aList := TStringList.Create;
599 for i := 0 to lvwOrderChecks.Items.Count - 1 do
[453]600 begin
[487]601 aRule := TRule(lvwOrderChecks.Items.Item[i].SubItems.Objects[2]);
602 newonoff := Uppercase(lvwOrderChecks.Items.Item[i].SubItems[0]);
[453]603 if aRule.OriginalValue <> newonoff then
604 begin
605 aList.Add(aRule.IEN + '^' + newonoff);
[487]606 aRule.OriginalValue := lvwOrderChecks.Items.Item[i].SubItems[0];
[453]607 end;
608 end;
[487]609 rpcSetOrderChecks(aList);
610 aList.free;
611 FdirtyOrderChecks := false;
[453]612 end;
613
[487]614 procedure TfrmOptions.ApplyOtherStuff;
615 // save other changes
616 var
617 aString: string;
[453]618 begin
[487]619 aString := '';
620 if chkNotificationsFlagged.Checked then
621 aString := aString + '^1'
622 else
623 aString := aString + '^0';
624 rpcSetOtherStuff(aString);
625 FdirtyOtherStuff := false;
[453]626 end;
627
[487]628 procedure TfrmOptions.CheckApply;
629 // determine if Apply button is enabled
630 begin
[738]631 btnApply.Enabled := FdirtyImageSettings or FdirtyOrderChecks or FdirtyNotifications or FdirtyOtherStuff;
[487]632 end;
[453]633
[487]634 procedure TfrmOptions.chkNotificationsFlaggedClick(Sender: TObject);
635 // set notification flagged status
636 begin
637 FdirtyOtherStuff := true;
638 CheckApply;
639 end;
[453]640
[487]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;
[453]648 begin
[487]649 FuseCheckBoxes := false;
650 aListView.Items.Clear;
651 aListView.SortType := stNone; // if Sorting during load then potential error
652 with aList do
[453]653 begin
[487]654 for i := 0 to aList.Count - 1 do
[453]655 begin
[487]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
[453]677 end;
678 end;
[487]679 aListView.SortType := stBoth;
680 FuseCheckBoxes := true;
[453]681 end;
682
[487]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;
[453]709 end;
[487]710
711 procedure TfrmOptions.lvwNotificationsColumnClick(Sender: TObject;
712 Column: TListColumn);
713 // toggle sort
[453]714 begin
[487]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
[453]726 begin
[487]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;
[453]744 end;
745
[487]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);
[453]761
[487]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
[453]772 begin
[487]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;
[453]783 begin
[487]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;
[453]789 end;
790
[487]791 procedure TfrmOptions.btnCombinationsClick(Sender: TObject);
792 // display Combination List Options
793 var
794 topsize, leftsize, value: integer;
[453]795 begin
[487]796 value := 0;
797 Offset(topsize, -60, leftsize, -60);
798 DialogOptionsCombinations(topsize, leftsize, Font.Size, value);
799 end;
[453]800
[487]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);
[453]809 end;
810
[487]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;
[453]820
[487]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;
[453]829
[487]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;
[453]838
[487]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;
[453]846
[487]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;
[453]852
[487]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;
[453]865
[487]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;
[453]876
[487]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);
[453]886 end;
887
[487]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;
[453]934
[487]935 end;
936
937 procedure TfrmOptions.cbLanguageChange(Sender: TObject); //kt added 6/29/07
938 var iIndex: Integer;
[453]939 begin
[487]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
[729]952 uTMGOptions.WriteInteger('Language',LangManager.LanguageID);
[453]953 end;
954
[487]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;
[453]963
[487]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;
[489]972 btnApplyClick(btnOK);
[487]973 {$ELSE}
974 MessageDlg('Use of skins has been disabled at compile time.',mtInformation,[mbOK],0);
975 {$ENDIF}
976 end;
[453]977
[487]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
[453]991 begin
[487]992 lbSkins.Items.Add (SRec.Name);
993 R := FindNext (SRec);
[453]994 end;
[487]995 lbSkins.Sorted := true;
996 lbSkins.ItemIndex := 0;
997 end;
[453]998
[487]999 procedure TfrmOptions.FormShow(Sender: TObject); //kt added
1000 begin
1001 FillSkinList;
1002 end;
[453]1003
[487]1004 procedure TfrmOptions.lbSkinsKeyPress(Sender: TObject; var Key: Char); //kt added
1005 begin
1006 if Key = #13 then btnApplySkinClick (Self);
[453]1007 end;
1008
[487]1009 procedure TfrmOptions.btnDisableSkinClick(Sender: TObject); //kt added
1010 begin
1011 frmFrame.InactivateSkin;
1012 end;
[453]1013
[729]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
[738]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
[453]1118end.
1119
Note: See TracBrowser for help on using the repository browser.