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

Last change on this file since 1099 was 801, checked in by Kevin Toppenberg, 15 years ago

Bug fixes. Improved Adding Image

File size: 40.7 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 lblDropBox: TLabel;
143 btnBrowseDropBox: TBitBtn;
144 dlgPickDir: TOpenDialog;
145 cbEnableScanning: TCheckBox;
146 lblPollingInterval: TLabel;
147 editScannedLocation: TEdit;
148 btnBrowseScannedImages: TBitBtn;
149 lblScannedImagesFolder: TLabel;
150 edtPolFreq: TEdit;
151 lblSeconds: 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 btnBrowseDropBoxClick(Sender: TObject);
198 procedure btnBrowseScannedImagesClick(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 j : TImgTransferMethod;
360 begin
361 //kt start mod
362 cboTransMethod.Items.Clear;
363 for j := itmDropbox to itmRPC do cboTransMethod.Items.Add(IMAGE_TRANSFER_METHODS[j]);
364 //kt end mod
365 LoadNotifications;
366 LoadOrderChecks;
367 LoadImageSettings; //kt
368 FdirtyImageSettings := false; //kt
369 FdirtyNotifications := false;
370 FdirtyOrderChecks := false;
371 FdirtyOtherStuff := false;
372 CheckApply;
373
374 if (Encounter.Provider = 0) and not IsCIDCProvider(User.DUZ) then
375 btnDiagnoses.Enabled := False;
376 if UseVistaWeb then rdoRDV.ItemIndex := 1;
377
378 //kt begin modification 6/29/07 ---------------
379 // Fill cbLanguage with available languages
380 // Note: LangManager was populated at form creation of fFrame
381 for i := 0 to LangManager.LanguageCount-1 do cbLanguage.Items.Add(LangManager.LanguageNames[i]);
382 //Index=0 always means the default language
383 cbLanguage.ItemIndex := LangManager.LanguageIndex;
384 //kt end modification 6/29/07 ---------------
385 cbSkinAtStartup.Checked := frmFrame.SkinAtStartup; //kt 9/8/08
386 end;
387
388 procedure TfrmOptions.FormDestroy(Sender: TObject);
389 // cleanup creation of objects
390 var
391 i: integer;
392 begin
393 for i := 0 to lvwOrderChecks.Items.Count - 1 do
394 lvwOrderChecks.Items.Item[i].SubItems.Objects[2].free;
395 for i := 0 to lvwNotifications.Items.Count - 1 do
396 lvwNotifications.Items.Item[i].SubItems.Objects[2].free;
397 end;
398
399 procedure TfrmOptions.btnCoverDaysClick(Sender: TObject);
400 // display Date Range Defaults on Cover Sheet
401 var
402 topsize, leftsize, value: integer;
403 begin
404 value := 0;
405 Offset(topsize, -60, leftsize, -60);
406 DialogOptionsDays(topsize, leftsize, Font.Size, value);
407 end;
408
409 procedure TfrmOptions.btnCoverRemindersClick(Sender: TObject);
410 // display Clinical Reminder Options
411 var
412 topsize, leftsize, value: integer;
413 begin
414 value := 0;
415 Offset(topsize, -60, leftsize, -60);
416 DialogOptionsReminders(topsize, leftsize, Font.Size, value);
417 end;
418
419 procedure TfrmOptions.btnOtherParametersClick(Sender: TObject);
420 // display Other Parameters Options
421 var
422 topsize, leftsize, value: integer;
423 begin
424 value := 0;
425 Offset(topsize, 40, leftsize, 40);
426 DialogOptionsOther(topsize, leftsize, Font.Size, value);
427 end;
428
429 procedure TfrmOptions.btnPatientSelectionClick(Sender: TObject);
430 // display Patient Selection Options
431 var
432 topsize, leftsize, value: integer;
433 begin
434 value := 0;
435 Offset(topsize, -60, leftsize, -60);
436 DialogOptionsPatientSelection(topsize, leftsize, Font.Size, value);
437 end;
438
439 procedure TfrmOptions.btnPersonalListsClick(Sender: TObject);
440 // display Personal Lists Options
441 var
442 topsize, leftsize, value: integer;
443 begin
444 value := 0;
445 Offset(topsize, -60, leftsize, -60);
446 DialogOptionsLists(topsize, leftsize, Font.Size, value);
447 end;
448
449 procedure TfrmOptions.btnTeamsClick(Sender: TObject);
450 // display Team Options
451 var
452 topsize, leftsize, value: integer;
453 begin
454 value := 0;
455 Offset(topsize, -60, leftsize, -60);
456 DialogOptionsTeams(topsize, leftsize, Font.Size, value);
457 end;
458
459 procedure TfrmOptions.btnNotificationsRemoveClick(Sender: TObject);
460 // confirm before clearing notifications
461 begin
462 //if InfoBox('CAUTION: This will clear all the current notifications you have pending.' <-- original line. //kt 8/8/2007
463 if InfoBox(DKLangConstW('fOptions_CAUTIONx_This_will_clear_all_the_current_notifications_you_have_pendingx') //kt added 8/8/2007
464 // + #13 + 'If you say YES, these changes will take place immediately.' <-- original line. //kt 8/8/2007
465 + #13 + DKLangConstW('fOptions_If_you_say_YESx_these_changes_will_take_place_immediatelyx') //kt added 8/8/2007
466 // + #13 + 'Are you sure you want to erase all of your notifications?', <-- original line. //kt 8/8/2007
467 + #13 + DKLangConstW('fOptions_Are_you_sure_you_want_to_erase_all_of_your_notificationsx'), //kt added 8/8/2007
468 // 'Warning', MB_YESNO or MB_ICONWARNING) = IDYES then <-- original line. //kt 8/8/2007
469 DKLangConstW('fOptions_Warning'), MB_YESNO or MB_ICONWARNING) = IDYES then //kt added 8/8/2007
470 begin
471 rpcClearNotifications;
472 end;
473 end;
474
475 procedure TfrmOptions.Offset(var topnum: integer; topoffset: integer; var leftnum: integer; leftoffset: integer);
476 // get positions to display dialog
477 begin
478 // use these top and left values to display dialog
479 topnum := Top;
480 leftnum := Left;
481 topnum := topnum + topoffset;
482 if topnum < 0 then topnum := 0;
483 leftnum := leftnum + leftoffset;
484 if leftnum < 0 then leftnum := 0;
485 end;
486
487 procedure TfrmOptions.btnApplyClick(Sender: TObject);
488 // save actions without exiting
489 begin
490 if FdirtyNotifications then
491 ApplyNotifications;
492 if FdirtyImageSettings then
493 ApplyImageSettings;
494 if FdirtyOrderChecks then
495 ApplyOrderChecks;
496 if FdirtyOtherStuff then
497 ApplyOtherStuff;
498 CheckApply;
499 if Sender = btnOK then
500 Close;
501 end;
502
503 procedure TfrmOptions.LoadNotifications;
504 // load Notification tab
505 var
506 notifydefaults, surrogateinfo, flag, enableerase: string;
507 begin
508 LoadListView(lvwNotifications, rpcGetNotifications);
509 lvwNotificationsColumnClick(lvwNotifications, lvwNotifications.Column[0]); // make sure sorted
510 notifydefaults := rpcGetNotificationDefaults;
511 flag := Piece(notifydefaults, '^', 2);
512 enableerase := Piece(notifydefaults, '^', 3);
513 chkNotificationsFlagged.Checked := flag = '1';
514 btnNotificationsRemove.Enabled := enableerase = '1';
515 surrogateinfo := rpcGetSurrogateInfo;
516 btnSurrogate.Hint := surrogateinfo;
517 LabelSurrogate(surrogateinfo, lblNotificationsSurrogateText);
518 end;
519
520 procedure TfrmOptions.LoadImageSettings;
521 begin
522 cbEnableImages.Checked := uTMGOptions.ReadBool('EnableImages',true);
523 cboTransMethod.ItemIndex := uTMGOptions.ReadInteger('ImageTransferMethod',2);
524 editDropboxLocation.text := uTMGOptions.ReadString('Dropbox directory','');
525 cbEnableScanning.Checked := uTMGOptions.ReadBool('Scan Enabled',false);
526 editScannedLocation.text := uTMGOptions.ReadString('Pol Directory','');
527 edtPolFreq.text := IntToStr(uTMGOptions.ReadInteger('Pol Interval (milliseconds)',0));
528 cbEnableScanningClick(self);
529 cboTransMethodChange(self);
530 end;
531
532 procedure TfrmOptions.LoadOrderChecks;
533 // load Order Check tab
534 begin
535 LoadListView(lvwOrderChecks, rpcGetOrderChecks);
536 lvwOrderChecks.Checkboxes := true;
537 end;
538
539 procedure TfrmOptions.ApplyNotifications;
540 // save Notification changes
541 var
542 i: integer;
543 newonoff: string;
544 aRule: TRule;
545 aList: TStringList;
546 begin
547 aList := TStringList.Create;
548 for i := 0 to lvwNotifications.Items.Count - 1 do
549 begin
550 aRule := TRule(lvwNotifications.Items.Item[i].SubItems.Objects[2]);
551 // if lvwNotifications.Items.Item[i].SubItems[1] <> 'Mandatory' then <-- original line. //kt 8/8/2007
552 if lvwNotifications.Items.Item[i].SubItems[1] <> DKLangConstW('fOptions_Mandatory') then //kt added 8/8/2007
553 begin
554 newonoff := Uppercase(lvwNotifications.Items.Item[i].SubItems[0]);
555 if aRule.OriginalValue <> newonoff then
556 begin
557 //***showmessage(aRule.IEN + ' ' + aRule.OriginalValue + ' ' + newonoff);
558 aList.Add(aRule.IEN + '^' + newonoff);
559 aRule.OriginalValue := lvwNotifications.Items.Item[i].SubItems[0];
560 end;
561 end;
562 end;
563 rpcSetNotifications(aList);
564 aList.free;
565 FdirtyNotifications := false;
566 end;
567
568 procedure TfrmOptions.ApplyImageSettings;
569 begin
570 uTMGOptions.WriteBool('EnableImages',cbEnableImages.Checked);
571 frmFrame.SetATabVisibility(CT_IMAGES, cbEnableImages.Checked, 'Images');
572
573 uTMGOptions.WriteInteger('ImageTransferMethod',cboTransMethod.itemindex);
574 frmImages.TransferMethod := TImgTransferMethod(cboTransMethod.itemindex);
575 {
576 if cboTransMethod.text = 'Dropbox Transfer' then begin
577 frmImages.UseDropBox := True;
578 end else begin
579 frmImages.UseDropBox := False;
580 end;
581 }
582 uTMGOptions.WriteString('Dropbox directory',editDropboxLocation.text);
583 frmImages.DropBoxDir := editDropboxLocation.text;
584
585 uTMGOptions.WriteBool('Scan Enabled',cbEnableScanning.Checked);
586
587 uTMGOptions.WriteString('Pol Directory',editScannedLocation.text);
588 UploadForm.FScanDir := editScannedLocation.text;
589
590 uTMGOptions.WriteInteger('Pol Interval (milliseconds)',StrToInt(edtPolFreq.text));
591 UploadForm.PolInterval := StrToInt(edtPolFreq.text);
592
593 FdirtyImageSettings := false;
594 end;
595
596 procedure TfrmOptions.ApplyOrderChecks;
597 // save Order Check changes
598 var
599 i: integer;
600 newonoff: string;
601 aRule: TRule;
602 aList: TStringList;
603 begin
604 aList := TStringList.Create;
605 for i := 0 to lvwOrderChecks.Items.Count - 1 do
606 begin
607 aRule := TRule(lvwOrderChecks.Items.Item[i].SubItems.Objects[2]);
608 newonoff := Uppercase(lvwOrderChecks.Items.Item[i].SubItems[0]);
609 if aRule.OriginalValue <> newonoff then
610 begin
611 aList.Add(aRule.IEN + '^' + newonoff);
612 aRule.OriginalValue := lvwOrderChecks.Items.Item[i].SubItems[0];
613 end;
614 end;
615 rpcSetOrderChecks(aList);
616 aList.free;
617 FdirtyOrderChecks := false;
618 end;
619
620 procedure TfrmOptions.ApplyOtherStuff;
621 // save other changes
622 var
623 aString: string;
624 begin
625 aString := '';
626 if chkNotificationsFlagged.Checked then
627 aString := aString + '^1'
628 else
629 aString := aString + '^0';
630 rpcSetOtherStuff(aString);
631 FdirtyOtherStuff := false;
632 end;
633
634 procedure TfrmOptions.CheckApply;
635 // determine if Apply button is enabled
636 begin
637 btnApply.Enabled := FdirtyImageSettings or FdirtyOrderChecks or FdirtyNotifications or FdirtyOtherStuff;
638 end;
639
640 procedure TfrmOptions.chkNotificationsFlaggedClick(Sender: TObject);
641 // set notification flagged status
642 begin
643 FdirtyOtherStuff := true;
644 CheckApply;
645 end;
646
647 procedure TfrmOptions.LoadListView(aListView: TListView; aList: TStrings);
648 // load a list view with: name, on/off, comment
649 var
650 i: integer;
651 aListItem: TListItem;
652 aRule: TRule;
653 rulenum, ruletext, ruleonoff, rulecomment: string;
654 begin
655 FuseCheckBoxes := false;
656 aListView.Items.Clear;
657 aListView.SortType := stNone; // if Sorting during load then potential error
658 with aList do
659 begin
660 for i := 0 to aList.Count - 1 do
661 begin
662 rulenum := Piece(aList[i], '^', 1);
663 ruletext := Piece(aList[i], '^', 2);
664 ruleonoff := Piece(aList[i], '^', 3);
665 rulecomment := Piece(aList[i], '^', 4);
666 aListItem := aListView.Items.Add;
667 with aListItem do
668 begin
669 Caption := ruletext;
670 SubItems.Add(ruleonoff);
671 if ruleonoff = 'On' then Checked := true;
672 SubItems.Add(rulecomment);
673 end;
674 aRule := TRule.Create;
675 with aRule do
676 begin
677 IEN := rulenum;
678 OriginalValue := ruleonoff;
679 ItemText := ruletext;
680 end;
681 // aListItem.SubItems.AddObject('rule object', aRule); <-- original line. //kt 8/8/2007
682 aListItem.SubItems.AddObject(DKLangConstW('fOptions_rule_object'), aRule); //kt added 8/8/2007
683 end;
684 end;
685 aListView.SortType := stBoth;
686 FuseCheckBoxes := true;
687 end;
688
689 procedure TfrmOptions.lvwNotificationsChange(Sender: TObject;
690 Item: TListItem; Change: TItemChange);
691 // change on/off on checkmark
692 begin
693 if (Sender as TListView).ItemIndex = -1 then exit;
694 if not FuseCheckBoxes then exit;
695 if (Sender as TListView).Checkboxes = false then exit;
696 //if (Item.SubItems[1] = 'Mandatory') and not Item.Checked then begin <-- original line. //kt 8/8/2007
697 if (Item.SubItems[1] = DKLangConstW('fOptions_Mandatory')) and not Item.Checked then begin //kt added 8/8/2007
698 Item.Checked := True;
699 exit;
700 end;
701 if Item.Checked then
702 begin
703 if Item.SubItems[0] <> 'On' then
704 ChangeOnOff(Sender as TListView, Item);
705 Item.SubItems[0] := 'On';
706 end
707 else
708 begin
709 // if Item.SubItems[0] <> 'Off' then <-- original line. //kt 8/8/2007
710 if Item.SubItems[0] <> DKLangConstW('fOptions_Off') then //kt added 8/8/2007
711 ChangeOnOff(Sender as TListView, Item);
712 // Item.SubItems[0] := 'Off'; <-- original line. //kt 8/8/2007
713 Item.SubItems[0] := DKLangConstW('fOptions_Off'); //kt added 8/8/2007
714 end;
715 end;
716
717 procedure TfrmOptions.lvwNotificationsColumnClick(Sender: TObject;
718 Column: TListColumn);
719 // toggle sort
720 begin
721 if FsortCol = Column.Index then
722 FsortAscending := not FsortAscending
723 else
724 FsortAscending := true;
725 FsortCol := Column.Index;
726 (Sender as TListView).AlphaSort;
727 end;
728
729 procedure TfrmOptions.lvwNotificationsCompare(Sender: TObject; Item1,
730 Item2: TListItem; Data: Integer; var Compare: Integer);
731 // sort columns
732 begin
733 if not(Sender is TListView) then exit;
734 if FsortAscending then
735 begin
736 if FsortCol = 0 then
737 Compare := CompareStr(Item1.Caption, Item2.Caption)
738 else
739 Compare := CompareStr(Item1.SubItems[FsortCol - 1],
740 Item2.SubItems[FsortCol - 1]);
741 end
742 else
743 begin
744 if FsortCol = 0 then
745 Compare := CompareStr(Item2.Caption, Item1.Caption)
746 else
747 Compare := CompareStr(Item2.SubItems[FsortCol - 1],
748 Item1.SubItems[FsortCol - 1]);
749 end;
750 end;
751
752 procedure TfrmOptions.lvwNotificationsDblClick(Sender: TObject);
753 // toggle check marks with double click
754 var
755 aListItem: TListItem;
756 begin
757 with (Sender as TListView) do
758 begin
759 if Checkboxes = false then exit;
760 if Selected = nil then exit;
761 // if Selected.SubItems[1] = 'Mandatory' then exit; <-- original line. //kt 8/8/2007
762 if Selected.SubItems[1] = DKLangConstW('fOptions_Mandatory') then exit; //kt added 8/8/2007
763 if Selected <> FLastClickedItem then exit;
764 aListItem := Selected;
765 aListItem.Checked := not aListItem.Checked;
766 ChangeOnOff(Sender as TListView, aListItem);
767
768 if aListItem.Checked then
769 aListItem.SubItems[0] := 'On'
770 else
771 // aListItem.SubItems[0] := 'Off'; <-- original line. //kt 8/8/2007
772 aListItem.SubItems[0] := DKLangConstW('fOptions_Off'); //kt added 8/8/2007
773 end;
774 end;
775
776 procedure TfrmOptions.ChangeOnOff(aListView: TListView; aListItem: TListItem);
777 // check if list items were edited
778 begin
779 if aListView = lvwNotifications then FdirtyNotifications := true;
780 if aListView = lvwOrderChecks then FdirtyOrderChecks := true;
781 CheckApply;
782 end;
783
784 procedure TfrmOptions.btnSurrogateClick(Sender: TObject);
785 // display Surrogate Options
786 var
787 topsize, leftsize: integer;
788 surrogateinfo: string;
789 begin
790 surrogateinfo := btnSurrogate.Hint;
791 Offset(topsize, -30, leftsize, -30);
792 DialogOptionsSurrogate(topsize, leftsize, Font.Size, surrogateinfo);
793 LabelSurrogate(surrogateinfo, lblNotificationsSurrogateText);
794 btnSurrogate.Hint := surrogateinfo;
795 end;
796
797 procedure TfrmOptions.btnCombinationsClick(Sender: TObject);
798 // display Combination List Options
799 var
800 topsize, leftsize, value: integer;
801 begin
802 value := 0;
803 Offset(topsize, -60, leftsize, -60);
804 DialogOptionsCombinations(topsize, leftsize, Font.Size, value);
805 end;
806
807 procedure TfrmOptions.btnNotesNotesClick(Sender: TObject);
808 // display Notes Options
809 var
810 topsize, leftsize, value: integer;
811 begin
812 value := 0;
813 Offset(topsize, -60, leftsize, -60);
814 DialogOptionsNotes(topsize, leftsize, Font.Size, value);
815 end;
816
817 procedure TfrmOptions.btnNotesTitlesClick(Sender: TObject);
818 // display Titles Options
819 var
820 topsize, leftsize, value: integer;
821 begin
822 value := 0;
823 Offset(topsize, -60, leftsize, -60);
824 DialogOptionsTitles(topsize, leftsize, Font.Size, value);
825 end;
826
827 procedure TfrmOptions.btnReportsClick(Sender: TObject);
828 var
829 topsize, leftsize, value: integer;
830 begin
831 value := 0;
832 Offset(topsize, 90, leftsize, 23);
833 DialogOptionsHSDefault(topsize, leftsize, Font.Size, value);
834 end;
835
836 procedure TfrmOptions.btnReport1Click(Sender: TObject);
837 var
838 topsize, leftsize, value: integer;
839 begin
840 value := 0;
841 Offset(topsize, -18, leftsize, -15);
842 DialogOptionsHSCustom(topsize, leftsize, Font.Size, value);
843 end;
844
845 procedure TfrmOptions.lvwNotificationsEnter(Sender: TObject);
846 begin
847 with Sender as TListView do begin
848 if (Selected = nil) and (Items.Count > 0) then
849 Selected := Items[0];
850 end;
851 end;
852
853 procedure TfrmOptions.lvwNotificationsMouseDown(Sender: TObject;
854 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
855 begin
856 FLastClickedItem := (Sender as TListView).GetItemAt(X,Y);
857 end;
858
859 procedure TfrmOptions.btnDiagnosesClick(Sender: TObject);
860 // display Personal Diagnoses List
861 var
862 topsize, leftsize, value: integer;
863 begin
864 if IsCIDCProvider(User.DUZ) then //(hds7564)
865 begin
866 value := 0;
867 Offset(topsize, -60, leftsize, -60);
868 DialogOptionsDiagnoses(topsize, leftsize, Font.Size, value);
869 end;
870 end;
871
872 procedure TfrmOptions.btnGraphSettingsClick(Sender: TObject);
873 // display GraphSettings
874 var
875 actiontype: boolean;
876 topsize, leftsize: integer;
877 begin
878 actiontype := false;
879 Offset(topsize, -60, leftsize, -60);
880 DialogOptionsGraphSettings(topsize, leftsize, Font.Size, actiontype);
881 end;
882
883 procedure TfrmOptions.btnGraphViewsClick(Sender: TObject);
884 // display Graph Views
885 var
886 actiontype: boolean;
887 topsize, leftsize: integer;
888 begin
889 actiontype := false;
890 Offset(topsize, -60, leftsize, -60);
891 DialogOptionsGraphProfiles(topsize, leftsize, Font.Size, actiontype);
892 end;
893
894 procedure TfrmOptions.rdoRDVClick(Sender: TObject);
895 var
896 iIndex: integer;
897 begin
898 iIndex := rdoRDV.ItemIndex;
899 with frmFrame do
900 if iIndex = 0 then
901 begin
902 ChangeVistaWebParam('0');
903 lblCIRN.Caption := ' Remote';
904 lblCIRNData.Caption := 'Data';
905 lblCIRNAvail.Caption := '';
906 lblCIRN.Width := 43;
907 lblCIRNData.Width := 43;
908 lblCIRNData.Alignment := taCenter;
909 lblCIRN.Alignment := taCenter;
910 lstCIRNLocations.Clear;
911 SetUpCIRN;
912 end
913 else
914 begin
915 ChangeVistaWebParam('1');
916 lblCIRN.Caption := 'Remote';
917 lblCIRNData.Caption := 'Data*'; //VistaWeb On
918 lblCIRN.Width := 43;
919 lblCIRNData.Width := 43;
920 lblCIRNData.Alignment := taCenter;
921 lblCIRN.Alignment := taCenter;
922 lblCIRN.Enabled := True;
923 lblCIRNData.Enabled := True;
924 pnlCIRN.TabStop := True;
925 if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then
926 begin
927 lblCIRN.Font.Color := clBlue;
928 lblCIRNData.Font.Color := clBlue;
929 lblCIRNAvail.Font.Color := clBlue;
930 lstCIRNLocations.Font.Color := clBlue;
931 end
932 else
933 begin
934 lblCIRN.Font.Color := clWindowText;
935 lblCIRNData.Font.Color := clWindowText;
936 lblCIRNAvail.Font.Color := clWindowText;
937 lstCIRNLocations.Font.Color := clWindowText;
938 end;
939 end;
940
941 end;
942
943 procedure TfrmOptions.cbLanguageChange(Sender: TObject); //kt added 6/29/07
944 var iIndex: Integer;
945 begin
946 iIndex := cbLanguage.ItemIndex;
947 if iIndex<0 then iIndex := 0; // When there's no valid selection in cbLanguage we use the default language (Index=0)
948 try
949 LangManager.LanguageID := LangManager.LanguageIDs[iIndex];
950 except
951 on EReadError do begin
952 //do nothing. Ignore error.
953 end
954 end;
955 frmFrame.Caption := TX_IN_USE + MixedCase(User.Name) + ' (' + RPCBrokerV.Server + ')'; //kt added
956 frmFrame.RenameTabs; //Resets names of tabs to correct translation //kt
957 frmFrame.mnuFileRefreshClick(self); //elh 6/23/08
958 uTMGOptions.WriteInteger('Language',LangManager.LanguageID);
959 end;
960
961 procedure TfrmOptions.Button1Click(Sender: TObject);
962 begin
963 MessageDlg('For a given language to be available, a *.lng (e.g. spanish.lng) '+
964 'must be in the same directory as CPRSchart.exe. This *.lng file '+
965 'may be created at any time by users by working with the CPRSchart.dklng '+
966 'file with the free language editor found at: '+
967 'http://www.dk-soft.org/products/dklang/',mtInformation,[mbOK],0);
968 end;
969
970 procedure TfrmOptions.btnApplySkinClick(Sender: TObject); //kt added
971 var fileS : String;
972 begin
973 {$IFDEF USE_SKINS}
974 fileS := '';
975 if lbSkins.ItemIndex > -1 then fileS := lbSkins.Items [lbSkins.ItemIndex];
976 frmFrame.CurrentSkinFile := 'TMG_Extra\Skins\' +fileS;
977 frmFrame.ActivateCurrentSkin;
978 btnApplyClick(btnOK);
979 {$ELSE}
980 MessageDlg('Use of skins has been disabled at compile time.',mtInformation,[mbOK],0);
981 {$ENDIF}
982 end;
983
984 procedure TfrmOptions.btnMoreSkinsClick(Sender: TObject); //kt added
985 begin
986 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);
987 end;
988
989 procedure TfrmOptions.FillSkinList; //kt added
990 var
991 SRec : TSearchRec;
992 R : Integer;
993 begin
994 lbSkins.Items.Clear;
995 R := FindFirst (ExtractFilePath (Application.ExeName) + 'TMG_Extra\Skins\*.ipz', faAnyFile, SRec);
996 while R = 0 do
997 begin
998 lbSkins.Items.Add (SRec.Name);
999 R := FindNext (SRec);
1000 end;
1001 lbSkins.Sorted := true;
1002 lbSkins.ItemIndex := 0;
1003 end;
1004
1005 procedure TfrmOptions.FormShow(Sender: TObject); //kt added
1006 begin
1007 FillSkinList;
1008 end;
1009
1010 procedure TfrmOptions.lbSkinsKeyPress(Sender: TObject; var Key: Char); //kt added
1011 begin
1012 if Key = #13 then btnApplySkinClick (Self);
1013 end;
1014
1015 procedure TfrmOptions.btnDisableSkinClick(Sender: TObject); //kt added
1016 begin
1017 frmFrame.InactivateSkin;
1018 end;
1019
1020 procedure TfrmOptions.cbSkinAtStartupClick(Sender: TObject);
1021 begin
1022 frmFrame.SkinAtStartup := cbSkinAtStartup.Checked;
1023 uTMGOptions.WriteBool('Load Skin At Startup',frmFrame.SkinAtStartup); //kt 9/11/08
1024 end;
1025
1026 procedure TfrmOptions.cboTransMethodChange(Sender: TObject);
1027 var Show : boolean;
1028 begin
1029 if cboTransMethod.Text = IMAGE_TRANSFER_METHODS[itmDirect] then begin
1030 MessageDlg('Sorry. Direct file access not yet supported.',mtInformation,[mbOK],0);
1031 cboTransMethod.ItemIndex := -1;
1032 end;
1033 if cboTransMethod.ItemIndex < 0 then begin
1034 cboTransMethod.ItemIndex := ord(itmRPC);
1035 cboTransMethod.Text := IMAGE_TRANSFER_METHODS[itmRPC];
1036 end;
1037 Show := (cboTransMethod.ItemIndex = ord(itmDropbox));
1038 editDropboxLocation.Visible := Show;
1039 btnBrowseDropBox.Visible := Show;
1040 lblDropBox.Visible := Show;
1041 FdirtyImageSettings := true;
1042 CheckApply;
1043 end;
1044
1045 procedure TfrmOptions.cbEnableImagesClick(Sender: TObject);
1046 begin
1047 FdirtyImageSettings := true;
1048 CheckApply;
1049 end;
1050
1051 procedure TfrmOptions.editDropboxLocationChange(Sender: TObject);
1052 begin
1053 FdirtyImageSettings := true;
1054 CheckApply;
1055 end;
1056
1057 procedure TfrmOptions.cbEnableScanningClick(Sender: TObject);
1058 begin
1059 editScannedLocation.Visible := cbEnableScanning.checked;
1060 btnBrowseScannedImages.Visible := cbEnableScanning.checked;
1061 edtPolFreq.Visible := cbEnableScanning.checked;
1062 lblScannedImagesFolder.Visible := cbEnableScanning.checked;
1063 lblPollingInterval.Visible := cbEnableScanning.checked;
1064 lblSeconds.Visible := cbEnableScanning.checked;
1065 FdirtyImageSettings := true;
1066 CheckApply;
1067 end;
1068
1069 procedure TfrmOptions.editScannedLocationChange(Sender: TObject);
1070 begin
1071 FdirtyImageSettings := true;
1072 CheckApply;
1073 end;
1074
1075 procedure TfrmOptions.edtPolFreqChange(Sender: TObject);
1076 begin
1077 FdirtyImageSettings := true;
1078 CheckApply;
1079 end;
1080
1081 procedure TfrmOptions.btnBrowseDropBoxClick(Sender: TObject);
1082 var
1083 sFolder: string;
1084 begin
1085 sFolder := BrowseDialog('Choose a Dropbox folder', BIF_RETURNONLYFSDIRS);
1086 if sFolder <> '' then begin
1087 if rightstr(sFolder,1) = '\' then begin
1088 editDropboxLocation.text := sFolder;
1089 end else begin
1090 editDropboxLocation.text := sFolder + '\';
1091 end;
1092 end;
1093 end;
1094
1095 function TfrmOptions.BrowseDialog(const Title: string; const Flag: integer): string;
1096 var
1097 lpItemID : PItemIDList;
1098 BrowseInfo : TBrowseInfo;
1099 DisplayName : array[0..MAX_PATH] of char;
1100 TempPath : array[0..MAX_PATH] of char;
1101 begin
1102 Result:='';
1103 FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
1104 with BrowseInfo do begin
1105 hwndOwner := Application.Handle;
1106 pszDisplayName := @DisplayName;
1107 lpszTitle := PChar(Title);
1108 ulFlags := Flag;
1109 end;
1110 lpItemID := SHBrowseForFolder(BrowseInfo);
1111 if lpItemId <> nil then begin
1112 SHGetPathFromIDList(lpItemID, TempPath);
1113 Result := TempPath;
1114 GlobalFreePtr(lpItemID);
1115 end;
1116 end;
1117
1118 procedure TfrmOptions.btnBrowseScannedImagesClick(Sender: TObject);
1119 var
1120 sFolder: string;
1121 begin
1122 sFolder := BrowseDialog('Choose a Scanned folder', BIF_RETURNONLYFSDIRS);
1123 if sFolder <> '' then begin
1124 if rightstr(sFolder,1) = '\' then begin
1125 editScannedLocation.text := sFolder;
1126 end else begin
1127 editScannedLocation.text := sFolder + '\';
1128 end;
1129 end;
1130 end;
1131
1132end.
1133
Note: See TracBrowser for help on using the repository browser.