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

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

Bug fixes. Improved Adding Image

File size: 40.7 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;
[801]142 lblDropBox: TLabel;
143 btnBrowseDropBox: TBitBtn;
[735]144 dlgPickDir: TOpenDialog;
145 cbEnableScanning: TCheckBox;
[801]146 lblPollingInterval: TLabel;
[738]147 editScannedLocation: TEdit;
[801]148 btnBrowseScannedImages: TBitBtn;
149 lblScannedImagesFolder: TLabel;
[735]150 edtPolFreq: TEdit;
[801]151 lblSeconds: 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);
[801]197 procedure btnBrowseDropBoxClick(Sender: TObject);
198 procedure btnBrowseScannedImagesClick(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
[801]359 j : TImgTransferMethod;
[487]360 begin
[801]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
[487]365 LoadNotifications;
366 LoadOrderChecks;
[801]367 LoadImageSettings; //kt
368 FdirtyImageSettings := false; //kt
[487]369 FdirtyNotifications := false;
370 FdirtyOrderChecks := false;
371 FdirtyOtherStuff := false;
372 CheckApply;
[453]373
[487]374 if (Encounter.Provider = 0) and not IsCIDCProvider(User.DUZ) then
375 btnDiagnoses.Enabled := False;
376 if UseVistaWeb then rdoRDV.ItemIndex := 1;
[453]377
[487]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;
[453]387
[487]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;
[453]398
[487]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;
[453]408
[487]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;
[453]418
[487]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;
[453]428
[487]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;
[453]438
[487]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;
[453]448
[487]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;
[453]458
[487]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;
[453]474
[487]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;
[453]486
[487]487 procedure TfrmOptions.btnApplyClick(Sender: TObject);
488 // save actions without exiting
489 begin
490 if FdirtyNotifications then
491 ApplyNotifications;
[738]492 if FdirtyImageSettings then
493 ApplyImageSettings;
[487]494 if FdirtyOrderChecks then
495 ApplyOrderChecks;
496 if FdirtyOtherStuff then
497 ApplyOtherStuff;
498 CheckApply;
499 if Sender = btnOK then
500 Close;
501 end;
[453]502
[487]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;
[453]519
[738]520 procedure TfrmOptions.LoadImageSettings;
521 begin
[801]522 cbEnableImages.Checked := uTMGOptions.ReadBool('EnableImages',true);
523 cboTransMethod.ItemIndex := uTMGOptions.ReadInteger('ImageTransferMethod',2);
[738]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
[487]532 procedure TfrmOptions.LoadOrderChecks;
533 // load Order Check tab
534 begin
535 LoadListView(lvwOrderChecks, rpcGetOrderChecks);
536 lvwOrderChecks.Checkboxes := true;
537 end;
[453]538
[487]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;
[453]567
[738]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);
[801]574 frmImages.TransferMethod := TImgTransferMethod(cboTransMethod.itemindex);
575 {
[738]576 if cboTransMethod.text = 'Dropbox Transfer' then begin
577 frmImages.UseDropBox := True;
578 end else begin
579 frmImages.UseDropBox := False;
580 end;
[801]581 }
[738]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
[487]596 procedure TfrmOptions.ApplyOrderChecks;
597 // save Order Check changes
598 var
599 i: integer;
600 newonoff: string;
601 aRule: TRule;
602 aList: TStringList;
[453]603 begin
[487]604 aList := TStringList.Create;
605 for i := 0 to lvwOrderChecks.Items.Count - 1 do
[453]606 begin
[487]607 aRule := TRule(lvwOrderChecks.Items.Item[i].SubItems.Objects[2]);
608 newonoff := Uppercase(lvwOrderChecks.Items.Item[i].SubItems[0]);
[453]609 if aRule.OriginalValue <> newonoff then
610 begin
611 aList.Add(aRule.IEN + '^' + newonoff);
[487]612 aRule.OriginalValue := lvwOrderChecks.Items.Item[i].SubItems[0];
[453]613 end;
614 end;
[487]615 rpcSetOrderChecks(aList);
616 aList.free;
617 FdirtyOrderChecks := false;
[453]618 end;
619
[487]620 procedure TfrmOptions.ApplyOtherStuff;
621 // save other changes
622 var
623 aString: string;
[453]624 begin
[487]625 aString := '';
626 if chkNotificationsFlagged.Checked then
627 aString := aString + '^1'
628 else
629 aString := aString + '^0';
630 rpcSetOtherStuff(aString);
631 FdirtyOtherStuff := false;
[453]632 end;
633
[487]634 procedure TfrmOptions.CheckApply;
635 // determine if Apply button is enabled
636 begin
[738]637 btnApply.Enabled := FdirtyImageSettings or FdirtyOrderChecks or FdirtyNotifications or FdirtyOtherStuff;
[487]638 end;
[453]639
[487]640 procedure TfrmOptions.chkNotificationsFlaggedClick(Sender: TObject);
641 // set notification flagged status
642 begin
643 FdirtyOtherStuff := true;
644 CheckApply;
645 end;
[453]646
[487]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;
[453]654 begin
[487]655 FuseCheckBoxes := false;
656 aListView.Items.Clear;
657 aListView.SortType := stNone; // if Sorting during load then potential error
658 with aList do
[453]659 begin
[487]660 for i := 0 to aList.Count - 1 do
[453]661 begin
[487]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
[453]683 end;
684 end;
[487]685 aListView.SortType := stBoth;
686 FuseCheckBoxes := true;
[453]687 end;
688
[487]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;
[453]715 end;
[487]716
717 procedure TfrmOptions.lvwNotificationsColumnClick(Sender: TObject;
718 Column: TListColumn);
719 // toggle sort
[453]720 begin
[487]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
[453]732 begin
[487]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;
[453]750 end;
751
[487]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);
[453]767
[487]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
[453]778 begin
[487]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;
[453]789 begin
[487]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;
[453]795 end;
796
[487]797 procedure TfrmOptions.btnCombinationsClick(Sender: TObject);
798 // display Combination List Options
799 var
800 topsize, leftsize, value: integer;
[453]801 begin
[487]802 value := 0;
803 Offset(topsize, -60, leftsize, -60);
804 DialogOptionsCombinations(topsize, leftsize, Font.Size, value);
805 end;
[453]806
[487]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);
[453]815 end;
816
[487]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;
[453]826
[487]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;
[453]835
[487]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;
[453]844
[487]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;
[453]852
[487]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;
[453]858
[487]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;
[453]871
[487]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;
[453]882
[487]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);
[453]892 end;
893
[487]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;
[453]940
[487]941 end;
942
943 procedure TfrmOptions.cbLanguageChange(Sender: TObject); //kt added 6/29/07
944 var iIndex: Integer;
[453]945 begin
[487]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
[729]958 uTMGOptions.WriteInteger('Language',LangManager.LanguageID);
[453]959 end;
960
[487]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;
[453]969
[487]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;
[489]978 btnApplyClick(btnOK);
[487]979 {$ELSE}
980 MessageDlg('Use of skins has been disabled at compile time.',mtInformation,[mbOK],0);
981 {$ENDIF}
982 end;
[453]983
[487]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
[453]997 begin
[487]998 lbSkins.Items.Add (SRec.Name);
999 R := FindNext (SRec);
[453]1000 end;
[487]1001 lbSkins.Sorted := true;
1002 lbSkins.ItemIndex := 0;
1003 end;
[453]1004
[487]1005 procedure TfrmOptions.FormShow(Sender: TObject); //kt added
1006 begin
1007 FillSkinList;
1008 end;
[453]1009
[487]1010 procedure TfrmOptions.lbSkinsKeyPress(Sender: TObject; var Key: Char); //kt added
1011 begin
1012 if Key = #13 then btnApplySkinClick (Self);
[453]1013 end;
1014
[487]1015 procedure TfrmOptions.btnDisableSkinClick(Sender: TObject); //kt added
1016 begin
1017 frmFrame.InactivateSkin;
1018 end;
[453]1019
[729]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
[801]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;
[738]1032 end;
[801]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;
[738]1041 FdirtyImageSettings := true;
1042 CheckApply;
[801]1043 end;
[738]1044
[801]1045 procedure TfrmOptions.cbEnableImagesClick(Sender: TObject);
1046 begin
1047 FdirtyImageSettings := true;
1048 CheckApply;
1049 end;
[738]1050
[801]1051 procedure TfrmOptions.editDropboxLocationChange(Sender: TObject);
1052 begin
1053 FdirtyImageSettings := true;
1054 CheckApply;
1055 end;
[738]1056
[801]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;
[738]1068
[801]1069 procedure TfrmOptions.editScannedLocationChange(Sender: TObject);
1070 begin
1071 FdirtyImageSettings := true;
1072 CheckApply;
1073 end;
[738]1074
[801]1075 procedure TfrmOptions.edtPolFreqChange(Sender: TObject);
1076 begin
1077 FdirtyImageSettings := true;
1078 CheckApply;
1079 end;
[738]1080
[801]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;
[738]1092 end;
1093 end;
1094
[801]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;
[738]1116 end;
1117
[801]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;
[738]1129 end;
1130 end;
1131
[453]1132end.
1133
Note: See TracBrowser for help on using the repository browser.