//kt -- Modified with SourceScanner on 8/8/2007 unit fOptions; interface uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls, Buttons, ComCtrls, ExtCtrls, ORCtrls, OrFn, Dialogs, ORDtTmRng, fBAOptionsDiagnoses, uBAGlobals, TntStdCtrls, DKLang, jpeg, inifiles, uConst, StrUtils; //kt added 6/29/07 ------------------ {Note: an additional tab was added to form: tsLanguage, with caption "Language" It contained a combo box (TTntComboxBox to support unicode language display) It has an on change event added below. There was a memo field describing how adding languages works: For a given language to be available, a *.lng (e.g. spanish.lng) must be in the same directory as CPRSchart.exe. *.lng may be created by users by working with the CPRSchart.dklng file with the free language editor found at: http://www.dk-soft.org/products/dklang/ Note: Cancel for language change is not currently supported //kt 9/8/08 ---------------------------- Also, a tab was added to the form: Appearance, for selecting skins. } type TfrmOptions = class(TForm) pnlMain: TPanel; pnlBottom: TPanel; pagOptions: TPageControl; tsCoverSheet: TTabSheet; tsNotifications: TTabSheet; btnOK: TButton; btnCancel: TButton; btnApply: TButton; tsOrderChecks: TTabSheet; tsListsTeams: TTabSheet; tsLanguage: TTabSheet; //kt added 6/29/07 (added in form editor) lblCoverReminderDesc: TMemo; lblCoverReminders: TStaticText; lblCoverDaysDesc: TMemo; lblCoverDays: TStaticText; btnCoverDays: TButton; bvlCoverDays: TBevel; btnCoverReminders: TButton; bvlCoverReminders: TBevel; imgCoverDays: TImage; imgCoverReminders: TImage; lblPatientSelectionDesc: TMemo; lblPatientSelection: TStaticText; btnPatientSelection: TButton; bvlPatientSelection: TBevel; btnPersonalLists: TButton; imgPatientSelection: TImage; lblNotificationsOptions: TStaticText; lblNotifications: TStaticText; bvlNotifications: TBevel; imgNotifications: TImage; lblOrderChecksDesc: TLabel; lblOrderChecks: TStaticText; bvlOrderChecks: TBevel; imgOrderChecks: TImage; lblTeamsDesc: TMemo; lblTeams: TStaticText; btnTeams: TButton; bvlTeams: TBevel; lvwNotifications: TCaptionListView; lblNotificationView: TLabel; btnNotificationsRemove: TButton; chkNotificationsFlagged: TCheckBox; lvwOrderChecks: TCaptionListView; lblOrderChecksView: TLabel; btnSurrogate: TButton; lblNotificationsSurrogate: TStaticText; lblNotificationsSurrogateText: TStaticText; btnCombinations: TButton; bvlOtherParameters: TBevel; lblOtherParameters: TStaticText; imgOtherParameters: TImage; lblOtherParametersDesc: TMemo; btnOtherParameters: TButton; tsNotes: TTabSheet; lblNotesNotesDesc: TMemo; lblNotesNotes: TStaticText; bvlNotesNotes: TBevel; btnNotesNotes: TButton; lblNotesTitles: TStaticText; bvlNotesTitles: TBevel; lblNotesTitlesDesc: TMemo; btnNotesTitles: TButton; imgNotesNotes: TImage; imgNotes: TImage; imgTeams: TImage; tsCprsReports: TTabSheet; lblReports: TStaticText; bvlReports: TBevel; memReports: TMemo; imgReports: TImage; btnReports: TButton; lblReport1: TStaticText; memReport1: TMemo; btnReport1: TButton; bvlReport1: TBevel; btnDiagnoses: TButton; tsGraphs: TTabSheet; lblGraphSettings: TStaticText; bvlGraphSettings: TBevel; imgGraphSettings: TImage; btnGraphSettings: TButton; bvlGraphViews: TBevel; lblGraphViews: TStaticText; imgGraphViews: TImage; btnGraphViews: TButton; memGraphSettings: TMemo; memGraphViews: TMemo; bvlReport2: TBevel; lblReport2: TStaticText; memReport2: TMemo; imgReport1: TImage; imgReport2: TImage; rdoRDV: TRadioGroup; cbLanguage: TTntComboBox; Label1: TLabel; Label2: TLabel; DKLanguageController1: TDKLanguageController; Image1: TImage; Memo1: TMemo; Button1: TButton; tsAppearance: TTabSheet; Label12: TLabel; lbSkins: TListBox; cbSkinAtStartup: TCheckBox; btnMoreSkins: TButton; btnDisableSkin: TButton; btnApplySkin: TButton; tsImages: TTabSheet; cbEnableImages: TCheckBox; cboTransMethod: TComboBox; Label3: TLabel; editDropboxLocation: TEdit; lblDropBox: TLabel; btnBrowseDropBox: TBitBtn; dlgPickDir: TOpenDialog; cbEnableScanning: TCheckBox; lblPollingInterval: TLabel; editScannedLocation: TEdit; btnBrowseScannedImages: TBitBtn; lblScannedImagesFolder: TLabel; edtPolFreq: TEdit; lblSeconds: TLabel; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure btnCoverDaysClick(Sender: TObject); procedure btnCoverRemindersClick(Sender: TObject); procedure btnOtherParametersClick(Sender: TObject); procedure btnPatientSelectionClick(Sender: TObject); procedure btnPersonalListsClick(Sender: TObject); procedure btnTeamsClick(Sender: TObject); procedure btnNotificationsRemoveClick(Sender: TObject); procedure btnApplyClick(Sender: TObject); procedure chkNotificationsFlaggedClick(Sender: TObject); procedure lvwNotificationsChange(Sender: TObject; Item: TListItem; Change: TItemChange); procedure lvwNotificationsColumnClick(Sender: TObject; Column: TListColumn); procedure lvwNotificationsCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer); procedure lvwNotificationsDblClick(Sender: TObject); procedure btnSurrogateClick(Sender: TObject); procedure btnCombinationsClick(Sender: TObject); procedure btnNotesNotesClick(Sender: TObject); procedure btnNotesTitlesClick(Sender: TObject); procedure btnReportsClick(Sender: TObject); procedure btnReport1Click(Sender: TObject); procedure lvwNotificationsEnter(Sender: TObject); procedure lvwNotificationsMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure btnDiagnosesClick(Sender: TObject); procedure btnGraphSettingsClick(Sender: TObject); procedure btnGraphViewsClick(Sender: TObject); procedure rdoRDVClick(Sender: TObject); procedure cbLanguageChange(Sender: TObject); procedure Button1Click(Sender: TObject); procedure btnApplySkinClick(Sender: TObject); procedure btnMoreSkinsClick(Sender: TObject); procedure FormShow(Sender: TObject); procedure lbSkinsKeyPress(Sender: TObject; var Key: Char); procedure btnDisableSkinClick(Sender: TObject); procedure cbSkinAtStartupClick(Sender: TObject); procedure cboTransMethodChange(Sender: TObject); procedure cbEnableImagesClick(Sender: TObject); procedure editDropboxLocationChange(Sender: TObject); procedure cbEnableScanningClick(Sender: TObject); procedure editScannedLocationChange(Sender: TObject); procedure edtPolFreqChange(Sender: TObject); procedure btnBrowseDropBoxClick(Sender: TObject); procedure btnBrowseScannedImagesClick(Sender: TObject); //kt added 6/29/07 private { Private declarations } FdirtyNotifications: boolean; // used to determine edit changes to Notifications FdirtyImageSettings: boolean; // used to determine edit changes to Image Settings FdirtyOrderChecks: boolean; // used to determine edit changes to Order Checks FdirtyOtherStuff: boolean; // used to determine edit changes to misc settings FuseCheckBoxes: boolean; FsortCol: integer; FsortAscending: boolean; FLastClickedItem: TListItem; procedure FillSkinList; //kt procedure Offset(var topnum: integer; topoffset: integer; var leftnum: integer; leftoffset: integer); procedure LoadNotifications; procedure LoadImageSettings; procedure LoadOrderChecks; procedure ApplyNotifications; procedure ApplyOrderChecks; procedure ApplyOtherStuff; procedure ApplyImageSettings; procedure CheckApply; procedure LoadListView(aListView: TListView; aList: TStrings); procedure ChangeOnOff(aListView: TListView; aListItem: TListItem); function BrowseDialog(const Title: string; const Flag: integer): string; public { Public declarations } end; var frmOptions: TfrmOptions; procedure DialogOptions(var actiontype: Integer); implementation uses fOptionsDays, fOptionsReminders, fOptionsSurrogate, fOptionsPatientSelection, fOptionsLists, fOptionsTeams, fOptionsCombinations, fOptionsOther, fOptionsNotes, fOptionsTitles, fOptionsReportsCustom, fOptionsReportsDefault, fGraphs, fGraphSettings, fGraphProfiles, rGraphs, uGraphs, rOptions, rCore, uCore, uOptions, UBACore, fFrame, //fTestDialog; //kt mod 6/29/07 ----- ShellAPI, //kt 9/8/08 uTMGOptions, //kt 2/10/10 UploadImages, fImages, //elh 04/15/10 ShlObj, //elh 04/15/10 ORNet, //allows access to RPCBrokerV TntForms, TntSystem, TntSysUtils; //kt end mod --------- {$R *.DFM} type TRule = class public IEN: string; OriginalValue: string; ItemText: string; end; procedure DialogOptions(var actiontype: Integer); // create the form and make in modal, return an action const PixelGapBetweenButtons = 5; var frmOptions: TfrmOptions; begin frmOptions := TfrmOptions.Create(Application); try with frmOptions do begin cbSkinAtStartup.Checked := frmFrame.SkinAtStartup; with pagOptions do begin tsCoverSheet.TabVisible := false; tsNotifications.TabVisible := false; tsOrderChecks.TabVisible := false; tsListsTeams.TabVisible := false; case actiontype of 1: begin tsCoverSheet.TabVisible := true; end; 2: begin tsNotifications.TabVisible := true; end; 3: begin tsOrderChecks.TabVisible := true; end; 4: begin tsListsTeams.TabVisible := true; end; else begin tsCoverSheet.TabVisible := true; tsNotifications.TabVisible := true; tsOrderChecks.TabVisible := true; tsListsTeams.TabVisible := true; ActivePage := tsCoverSheet; // memReports.Text := 'Change the default date range and occurrence limits for all reports on ' + <-- original line. //kt 8/8/2007 memReports.Text := DKLangConstW('fOptions_Change_the_default_date_range_and_occurrence_limits_for_all_reports_on') + //kt added 8/8/2007 // 'the CPRS Reports tab (excluding health summary reports) .'; <-- original line. //kt 8/8/2007 DKLangConstW('fOptions_the_CPRS_Reports_tab_xexcluding_health_summary_reportsx_x'); //kt added 8/8/2007 // memReport1.Text := 'Change the individual date range and occurrence limits for each report on ' + <-- original line. //kt 8/8/2007 memReport1.Text := DKLangConstW('fOptions_Change_the_individual_date_range_and_occurrence_limits_for_each_report_on') + //kt added 8/8/2007 // 'the CPRS Reports tab (excluding health summary reports) .'; <-- original line. //kt 8/8/2007 DKLangConstW('fOptions_the_CPRS_Reports_tab_xexcluding_health_summary_reportsx_x'); //kt added 8/8/2007 // btnReports.caption := 'Set All Reports...'; <-- original line. //kt 8/8/2007 btnReports.caption := DKLangConstW('fOptions_Set_All_Reportsxxx'); //kt added 8/8/2007 // btnReport1.caption := 'Set Individual Reports...'; <-- original line. //kt 8/8/2007 btnReport1.caption := DKLangConstW('fOptions_Set_Individual_Reportsxxx'); //kt added 8/8/2007 if User.IsReportsOnly then // For "Reports Only" users. begin tsCoverSheet.TabVisible := false; tsNotifications.TabVisible := false; tsOrderChecks.TabVisible := false; tsListsTeams.TabVisible := false; tsNotes.TabVisible := false; if (not User.ToolsRptEdit) then begin btnOK.visible := false; btnApply.visible := false; // btnCancel.caption := 'Close'; <-- original line. //kt 8/8/2007 btnCancel.caption := DKLangConstW('fOptions_Close'); //kt added 8/8/2007 end; end; if (not User.ToolsRptEdit) then // For users with Reports settings edit parameter not set. begin // memReports.Text := 'View the default date range and occurrence limits for all reports on ' + <-- original line. //kt 8/8/2007 memReports.Text := DKLangConstW('fOptions_View_the_default_date_range_and_occurrence_limits_for_all_reports_on') + //kt added 8/8/2007 // 'the CPRS Reports tab (excluding health summary reports) .'; <-- original line. //kt 8/8/2007 DKLangConstW('fOptions_the_CPRS_Reports_tab_xexcluding_health_summary_reportsx_x'); //kt added 8/8/2007 // memReport1.Text := 'View the individual date range and occurrence limits for each report on ' + <-- original line. //kt 8/8/2007 memReport1.Text := DKLangConstW('fOptions_View_the_individual_date_range_and_occurrence_limits_for_each_report_on') + //kt added 8/8/2007 // 'the CPRS Reports tab (excluding health summary reports) .'; <-- original line. //kt 8/8/2007 DKLangConstW('fOptions_the_CPRS_Reports_tab_xexcluding_health_summary_reportsx_x'); //kt added 8/8/2007 // btnReports.caption := 'View All Report Settings...'; <-- original line. //kt 8/8/2007 btnReports.caption := DKLangConstW('fOptions_View_All_Report_Settingsxxx'); //kt added 8/8/2007 // btnReport1.caption := 'View Individual Report Settings...'; <-- original line. //kt 8/8/2007 btnReport1.caption := DKLangConstW('fOptions_View_Individual_Report_Settingsxxx'); //kt added 8/8/2007 end; end; end; end; actiontype := 0; ResizeAnchoredFormToFont(frmOptions); btnApply.Left := pagOptions.Left + pagOptions.Width - btnApply.Width; btnCancel.Left := btnApply.Left - btnCancel.Width - PixelGapBetweenButtons; btnOK.Left := btnCancel.Left - btnOK.Width - PixelGapBetweenButtons; ShowModal; actiontype := btnOK.Tag; end; finally frmFrame.SkinAtStartup := frmOptions.cbSkinAtStartup.Checked; frmOptions.Release; end; end; procedure TfrmOptions.FormCreate(Sender: TObject); // initialize form var i : integer; //kt added 6/29/07 j : TImgTransferMethod; begin //kt start mod cboTransMethod.Items.Clear; for j := itmDropbox to itmRPC do cboTransMethod.Items.Add(IMAGE_TRANSFER_METHODS[j]); //kt end mod LoadNotifications; LoadOrderChecks; LoadImageSettings; //kt FdirtyImageSettings := false; //kt FdirtyNotifications := false; FdirtyOrderChecks := false; FdirtyOtherStuff := false; CheckApply; if (Encounter.Provider = 0) and not IsCIDCProvider(User.DUZ) then btnDiagnoses.Enabled := False; if UseVistaWeb then rdoRDV.ItemIndex := 1; //kt begin modification 6/29/07 --------------- // Fill cbLanguage with available languages // Note: LangManager was populated at form creation of fFrame for i := 0 to LangManager.LanguageCount-1 do cbLanguage.Items.Add(LangManager.LanguageNames[i]); //Index=0 always means the default language cbLanguage.ItemIndex := LangManager.LanguageIndex; //kt end modification 6/29/07 --------------- cbSkinAtStartup.Checked := frmFrame.SkinAtStartup; //kt 9/8/08 end; procedure TfrmOptions.FormDestroy(Sender: TObject); // cleanup creation of objects var i: integer; begin for i := 0 to lvwOrderChecks.Items.Count - 1 do lvwOrderChecks.Items.Item[i].SubItems.Objects[2].free; for i := 0 to lvwNotifications.Items.Count - 1 do lvwNotifications.Items.Item[i].SubItems.Objects[2].free; end; procedure TfrmOptions.btnCoverDaysClick(Sender: TObject); // display Date Range Defaults on Cover Sheet var topsize, leftsize, value: integer; begin value := 0; Offset(topsize, -60, leftsize, -60); DialogOptionsDays(topsize, leftsize, Font.Size, value); end; procedure TfrmOptions.btnCoverRemindersClick(Sender: TObject); // display Clinical Reminder Options var topsize, leftsize, value: integer; begin value := 0; Offset(topsize, -60, leftsize, -60); DialogOptionsReminders(topsize, leftsize, Font.Size, value); end; procedure TfrmOptions.btnOtherParametersClick(Sender: TObject); // display Other Parameters Options var topsize, leftsize, value: integer; begin value := 0; Offset(topsize, 40, leftsize, 40); DialogOptionsOther(topsize, leftsize, Font.Size, value); end; procedure TfrmOptions.btnPatientSelectionClick(Sender: TObject); // display Patient Selection Options var topsize, leftsize, value: integer; begin value := 0; Offset(topsize, -60, leftsize, -60); DialogOptionsPatientSelection(topsize, leftsize, Font.Size, value); end; procedure TfrmOptions.btnPersonalListsClick(Sender: TObject); // display Personal Lists Options var topsize, leftsize, value: integer; begin value := 0; Offset(topsize, -60, leftsize, -60); DialogOptionsLists(topsize, leftsize, Font.Size, value); end; procedure TfrmOptions.btnTeamsClick(Sender: TObject); // display Team Options var topsize, leftsize, value: integer; begin value := 0; Offset(topsize, -60, leftsize, -60); DialogOptionsTeams(topsize, leftsize, Font.Size, value); end; procedure TfrmOptions.btnNotificationsRemoveClick(Sender: TObject); // confirm before clearing notifications begin //if InfoBox('CAUTION: This will clear all the current notifications you have pending.' <-- original line. //kt 8/8/2007 if InfoBox(DKLangConstW('fOptions_CAUTIONx_This_will_clear_all_the_current_notifications_you_have_pendingx') //kt added 8/8/2007 // + #13 + 'If you say YES, these changes will take place immediately.' <-- original line. //kt 8/8/2007 + #13 + DKLangConstW('fOptions_If_you_say_YESx_these_changes_will_take_place_immediatelyx') //kt added 8/8/2007 // + #13 + 'Are you sure you want to erase all of your notifications?', <-- original line. //kt 8/8/2007 + #13 + DKLangConstW('fOptions_Are_you_sure_you_want_to_erase_all_of_your_notificationsx'), //kt added 8/8/2007 // 'Warning', MB_YESNO or MB_ICONWARNING) = IDYES then <-- original line. //kt 8/8/2007 DKLangConstW('fOptions_Warning'), MB_YESNO or MB_ICONWARNING) = IDYES then //kt added 8/8/2007 begin rpcClearNotifications; end; end; procedure TfrmOptions.Offset(var topnum: integer; topoffset: integer; var leftnum: integer; leftoffset: integer); // get positions to display dialog begin // use these top and left values to display dialog topnum := Top; leftnum := Left; topnum := topnum + topoffset; if topnum < 0 then topnum := 0; leftnum := leftnum + leftoffset; if leftnum < 0 then leftnum := 0; end; procedure TfrmOptions.btnApplyClick(Sender: TObject); // save actions without exiting begin if FdirtyNotifications then ApplyNotifications; if FdirtyImageSettings then ApplyImageSettings; if FdirtyOrderChecks then ApplyOrderChecks; if FdirtyOtherStuff then ApplyOtherStuff; CheckApply; if Sender = btnOK then Close; end; procedure TfrmOptions.LoadNotifications; // load Notification tab var notifydefaults, surrogateinfo, flag, enableerase: string; begin LoadListView(lvwNotifications, rpcGetNotifications); lvwNotificationsColumnClick(lvwNotifications, lvwNotifications.Column[0]); // make sure sorted notifydefaults := rpcGetNotificationDefaults; flag := Piece(notifydefaults, '^', 2); enableerase := Piece(notifydefaults, '^', 3); chkNotificationsFlagged.Checked := flag = '1'; btnNotificationsRemove.Enabled := enableerase = '1'; surrogateinfo := rpcGetSurrogateInfo; btnSurrogate.Hint := surrogateinfo; LabelSurrogate(surrogateinfo, lblNotificationsSurrogateText); end; procedure TfrmOptions.LoadImageSettings; begin cbEnableImages.Checked := uTMGOptions.ReadBool('EnableImages',true); cboTransMethod.ItemIndex := uTMGOptions.ReadInteger('ImageTransferMethod',2); editDropboxLocation.text := uTMGOptions.ReadString('Dropbox directory',''); cbEnableScanning.Checked := uTMGOptions.ReadBool('Scan Enabled',false); editScannedLocation.text := uTMGOptions.ReadString('Pol Directory',''); edtPolFreq.text := IntToStr(uTMGOptions.ReadInteger('Pol Interval (milliseconds)',0)); cbEnableScanningClick(self); cboTransMethodChange(self); end; procedure TfrmOptions.LoadOrderChecks; // load Order Check tab begin LoadListView(lvwOrderChecks, rpcGetOrderChecks); lvwOrderChecks.Checkboxes := true; end; procedure TfrmOptions.ApplyNotifications; // save Notification changes var i: integer; newonoff: string; aRule: TRule; aList: TStringList; begin aList := TStringList.Create; for i := 0 to lvwNotifications.Items.Count - 1 do begin aRule := TRule(lvwNotifications.Items.Item[i].SubItems.Objects[2]); // if lvwNotifications.Items.Item[i].SubItems[1] <> 'Mandatory' then <-- original line. //kt 8/8/2007 if lvwNotifications.Items.Item[i].SubItems[1] <> DKLangConstW('fOptions_Mandatory') then //kt added 8/8/2007 begin newonoff := Uppercase(lvwNotifications.Items.Item[i].SubItems[0]); if aRule.OriginalValue <> newonoff then begin //***showmessage(aRule.IEN + ' ' + aRule.OriginalValue + ' ' + newonoff); aList.Add(aRule.IEN + '^' + newonoff); aRule.OriginalValue := lvwNotifications.Items.Item[i].SubItems[0]; end; end; end; rpcSetNotifications(aList); aList.free; FdirtyNotifications := false; end; procedure TfrmOptions.ApplyImageSettings; begin uTMGOptions.WriteBool('EnableImages',cbEnableImages.Checked); frmFrame.SetATabVisibility(CT_IMAGES, cbEnableImages.Checked, 'Images'); uTMGOptions.WriteInteger('ImageTransferMethod',cboTransMethod.itemindex); frmImages.TransferMethod := TImgTransferMethod(cboTransMethod.itemindex); { if cboTransMethod.text = 'Dropbox Transfer' then begin frmImages.UseDropBox := True; end else begin frmImages.UseDropBox := False; end; } uTMGOptions.WriteString('Dropbox directory',editDropboxLocation.text); frmImages.DropBoxDir := editDropboxLocation.text; uTMGOptions.WriteBool('Scan Enabled',cbEnableScanning.Checked); uTMGOptions.WriteString('Pol Directory',editScannedLocation.text); UploadForm.FScanDir := editScannedLocation.text; uTMGOptions.WriteInteger('Pol Interval (milliseconds)',StrToInt(edtPolFreq.text)); UploadForm.PolInterval := StrToInt(edtPolFreq.text); FdirtyImageSettings := false; end; procedure TfrmOptions.ApplyOrderChecks; // save Order Check changes var i: integer; newonoff: string; aRule: TRule; aList: TStringList; begin aList := TStringList.Create; for i := 0 to lvwOrderChecks.Items.Count - 1 do begin aRule := TRule(lvwOrderChecks.Items.Item[i].SubItems.Objects[2]); newonoff := Uppercase(lvwOrderChecks.Items.Item[i].SubItems[0]); if aRule.OriginalValue <> newonoff then begin aList.Add(aRule.IEN + '^' + newonoff); aRule.OriginalValue := lvwOrderChecks.Items.Item[i].SubItems[0]; end; end; rpcSetOrderChecks(aList); aList.free; FdirtyOrderChecks := false; end; procedure TfrmOptions.ApplyOtherStuff; // save other changes var aString: string; begin aString := ''; if chkNotificationsFlagged.Checked then aString := aString + '^1' else aString := aString + '^0'; rpcSetOtherStuff(aString); FdirtyOtherStuff := false; end; procedure TfrmOptions.CheckApply; // determine if Apply button is enabled begin btnApply.Enabled := FdirtyImageSettings or FdirtyOrderChecks or FdirtyNotifications or FdirtyOtherStuff; end; procedure TfrmOptions.chkNotificationsFlaggedClick(Sender: TObject); // set notification flagged status begin FdirtyOtherStuff := true; CheckApply; end; procedure TfrmOptions.LoadListView(aListView: TListView; aList: TStrings); // load a list view with: name, on/off, comment var i: integer; aListItem: TListItem; aRule: TRule; rulenum, ruletext, ruleonoff, rulecomment: string; begin FuseCheckBoxes := false; aListView.Items.Clear; aListView.SortType := stNone; // if Sorting during load then potential error with aList do begin for i := 0 to aList.Count - 1 do begin rulenum := Piece(aList[i], '^', 1); ruletext := Piece(aList[i], '^', 2); ruleonoff := Piece(aList[i], '^', 3); rulecomment := Piece(aList[i], '^', 4); aListItem := aListView.Items.Add; with aListItem do begin Caption := ruletext; SubItems.Add(ruleonoff); if ruleonoff = 'On' then Checked := true; SubItems.Add(rulecomment); end; aRule := TRule.Create; with aRule do begin IEN := rulenum; OriginalValue := ruleonoff; ItemText := ruletext; end; // aListItem.SubItems.AddObject('rule object', aRule); <-- original line. //kt 8/8/2007 aListItem.SubItems.AddObject(DKLangConstW('fOptions_rule_object'), aRule); //kt added 8/8/2007 end; end; aListView.SortType := stBoth; FuseCheckBoxes := true; end; procedure TfrmOptions.lvwNotificationsChange(Sender: TObject; Item: TListItem; Change: TItemChange); // change on/off on checkmark begin if (Sender as TListView).ItemIndex = -1 then exit; if not FuseCheckBoxes then exit; if (Sender as TListView).Checkboxes = false then exit; //if (Item.SubItems[1] = 'Mandatory') and not Item.Checked then begin <-- original line. //kt 8/8/2007 if (Item.SubItems[1] = DKLangConstW('fOptions_Mandatory')) and not Item.Checked then begin //kt added 8/8/2007 Item.Checked := True; exit; end; if Item.Checked then begin if Item.SubItems[0] <> 'On' then ChangeOnOff(Sender as TListView, Item); Item.SubItems[0] := 'On'; end else begin // if Item.SubItems[0] <> 'Off' then <-- original line. //kt 8/8/2007 if Item.SubItems[0] <> DKLangConstW('fOptions_Off') then //kt added 8/8/2007 ChangeOnOff(Sender as TListView, Item); // Item.SubItems[0] := 'Off'; <-- original line. //kt 8/8/2007 Item.SubItems[0] := DKLangConstW('fOptions_Off'); //kt added 8/8/2007 end; end; procedure TfrmOptions.lvwNotificationsColumnClick(Sender: TObject; Column: TListColumn); // toggle sort begin if FsortCol = Column.Index then FsortAscending := not FsortAscending else FsortAscending := true; FsortCol := Column.Index; (Sender as TListView).AlphaSort; end; procedure TfrmOptions.lvwNotificationsCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer); // sort columns begin if not(Sender is TListView) then exit; if FsortAscending then begin if FsortCol = 0 then Compare := CompareStr(Item1.Caption, Item2.Caption) else Compare := CompareStr(Item1.SubItems[FsortCol - 1], Item2.SubItems[FsortCol - 1]); end else begin if FsortCol = 0 then Compare := CompareStr(Item2.Caption, Item1.Caption) else Compare := CompareStr(Item2.SubItems[FsortCol - 1], Item1.SubItems[FsortCol - 1]); end; end; procedure TfrmOptions.lvwNotificationsDblClick(Sender: TObject); // toggle check marks with double click var aListItem: TListItem; begin with (Sender as TListView) do begin if Checkboxes = false then exit; if Selected = nil then exit; // if Selected.SubItems[1] = 'Mandatory' then exit; <-- original line. //kt 8/8/2007 if Selected.SubItems[1] = DKLangConstW('fOptions_Mandatory') then exit; //kt added 8/8/2007 if Selected <> FLastClickedItem then exit; aListItem := Selected; aListItem.Checked := not aListItem.Checked; ChangeOnOff(Sender as TListView, aListItem); if aListItem.Checked then aListItem.SubItems[0] := 'On' else // aListItem.SubItems[0] := 'Off'; <-- original line. //kt 8/8/2007 aListItem.SubItems[0] := DKLangConstW('fOptions_Off'); //kt added 8/8/2007 end; end; procedure TfrmOptions.ChangeOnOff(aListView: TListView; aListItem: TListItem); // check if list items were edited begin if aListView = lvwNotifications then FdirtyNotifications := true; if aListView = lvwOrderChecks then FdirtyOrderChecks := true; CheckApply; end; procedure TfrmOptions.btnSurrogateClick(Sender: TObject); // display Surrogate Options var topsize, leftsize: integer; surrogateinfo: string; begin surrogateinfo := btnSurrogate.Hint; Offset(topsize, -30, leftsize, -30); DialogOptionsSurrogate(topsize, leftsize, Font.Size, surrogateinfo); LabelSurrogate(surrogateinfo, lblNotificationsSurrogateText); btnSurrogate.Hint := surrogateinfo; end; procedure TfrmOptions.btnCombinationsClick(Sender: TObject); // display Combination List Options var topsize, leftsize, value: integer; begin value := 0; Offset(topsize, -60, leftsize, -60); DialogOptionsCombinations(topsize, leftsize, Font.Size, value); end; procedure TfrmOptions.btnNotesNotesClick(Sender: TObject); // display Notes Options var topsize, leftsize, value: integer; begin value := 0; Offset(topsize, -60, leftsize, -60); DialogOptionsNotes(topsize, leftsize, Font.Size, value); end; procedure TfrmOptions.btnNotesTitlesClick(Sender: TObject); // display Titles Options var topsize, leftsize, value: integer; begin value := 0; Offset(topsize, -60, leftsize, -60); DialogOptionsTitles(topsize, leftsize, Font.Size, value); end; procedure TfrmOptions.btnReportsClick(Sender: TObject); var topsize, leftsize, value: integer; begin value := 0; Offset(topsize, 90, leftsize, 23); DialogOptionsHSDefault(topsize, leftsize, Font.Size, value); end; procedure TfrmOptions.btnReport1Click(Sender: TObject); var topsize, leftsize, value: integer; begin value := 0; Offset(topsize, -18, leftsize, -15); DialogOptionsHSCustom(topsize, leftsize, Font.Size, value); end; procedure TfrmOptions.lvwNotificationsEnter(Sender: TObject); begin with Sender as TListView do begin if (Selected = nil) and (Items.Count > 0) then Selected := Items[0]; end; end; procedure TfrmOptions.lvwNotificationsMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin FLastClickedItem := (Sender as TListView).GetItemAt(X,Y); end; procedure TfrmOptions.btnDiagnosesClick(Sender: TObject); // display Personal Diagnoses List var topsize, leftsize, value: integer; begin if IsCIDCProvider(User.DUZ) then //(hds7564) begin value := 0; Offset(topsize, -60, leftsize, -60); DialogOptionsDiagnoses(topsize, leftsize, Font.Size, value); end; end; procedure TfrmOptions.btnGraphSettingsClick(Sender: TObject); // display GraphSettings var actiontype: boolean; topsize, leftsize: integer; begin actiontype := false; Offset(topsize, -60, leftsize, -60); DialogOptionsGraphSettings(topsize, leftsize, Font.Size, actiontype); end; procedure TfrmOptions.btnGraphViewsClick(Sender: TObject); // display Graph Views var actiontype: boolean; topsize, leftsize: integer; begin actiontype := false; Offset(topsize, -60, leftsize, -60); DialogOptionsGraphProfiles(topsize, leftsize, Font.Size, actiontype); end; procedure TfrmOptions.rdoRDVClick(Sender: TObject); var iIndex: integer; begin iIndex := rdoRDV.ItemIndex; with frmFrame do if iIndex = 0 then begin ChangeVistaWebParam('0'); lblCIRN.Caption := ' Remote'; lblCIRNData.Caption := 'Data'; lblCIRNAvail.Caption := ''; lblCIRN.Width := 43; lblCIRNData.Width := 43; lblCIRNData.Alignment := taCenter; lblCIRN.Alignment := taCenter; lstCIRNLocations.Clear; SetUpCIRN; end else begin ChangeVistaWebParam('1'); lblCIRN.Caption := 'Remote'; lblCIRNData.Caption := 'Data*'; //VistaWeb On lblCIRN.Width := 43; lblCIRNData.Width := 43; lblCIRNData.Alignment := taCenter; lblCIRN.Alignment := taCenter; lblCIRN.Enabled := True; lblCIRNData.Enabled := True; pnlCIRN.TabStop := True; if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then begin lblCIRN.Font.Color := clBlue; lblCIRNData.Font.Color := clBlue; lblCIRNAvail.Font.Color := clBlue; lstCIRNLocations.Font.Color := clBlue; end else begin lblCIRN.Font.Color := clWindowText; lblCIRNData.Font.Color := clWindowText; lblCIRNAvail.Font.Color := clWindowText; lstCIRNLocations.Font.Color := clWindowText; end; end; end; procedure TfrmOptions.cbLanguageChange(Sender: TObject); //kt added 6/29/07 var iIndex: Integer; begin iIndex := cbLanguage.ItemIndex; if iIndex<0 then iIndex := 0; // When there's no valid selection in cbLanguage we use the default language (Index=0) try LangManager.LanguageID := LangManager.LanguageIDs[iIndex]; except on EReadError do begin //do nothing. Ignore error. end end; frmFrame.Caption := TX_IN_USE + MixedCase(User.Name) + ' (' + RPCBrokerV.Server + ')'; //kt added frmFrame.RenameTabs; //Resets names of tabs to correct translation //kt frmFrame.mnuFileRefreshClick(self); //elh 6/23/08 uTMGOptions.WriteInteger('Language',LangManager.LanguageID); end; procedure TfrmOptions.Button1Click(Sender: TObject); begin MessageDlg('For a given language to be available, a *.lng (e.g. spanish.lng) '+ 'must be in the same directory as CPRSchart.exe. This *.lng file '+ 'may be created at any time by users by working with the CPRSchart.dklng '+ 'file with the free language editor found at: '+ 'http://www.dk-soft.org/products/dklang/',mtInformation,[mbOK],0); end; procedure TfrmOptions.btnApplySkinClick(Sender: TObject); //kt added var fileS : String; begin {$IFDEF USE_SKINS} fileS := ''; if lbSkins.ItemIndex > -1 then fileS := lbSkins.Items [lbSkins.ItemIndex]; frmFrame.CurrentSkinFile := 'TMG_Extra\Skins\' +fileS; frmFrame.ActivateCurrentSkin; btnApplyClick(btnOK); {$ELSE} MessageDlg('Use of skins has been disabled at compile time.',mtInformation,[mbOK],0); {$ENDIF} end; procedure TfrmOptions.btnMoreSkinsClick(Sender: TObject); //kt added begin 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); end; procedure TfrmOptions.FillSkinList; //kt added var SRec : TSearchRec; R : Integer; begin lbSkins.Items.Clear; R := FindFirst (ExtractFilePath (Application.ExeName) + 'TMG_Extra\Skins\*.ipz', faAnyFile, SRec); while R = 0 do begin lbSkins.Items.Add (SRec.Name); R := FindNext (SRec); end; lbSkins.Sorted := true; lbSkins.ItemIndex := 0; end; procedure TfrmOptions.FormShow(Sender: TObject); //kt added begin FillSkinList; end; procedure TfrmOptions.lbSkinsKeyPress(Sender: TObject; var Key: Char); //kt added begin if Key = #13 then btnApplySkinClick (Self); end; procedure TfrmOptions.btnDisableSkinClick(Sender: TObject); //kt added begin frmFrame.InactivateSkin; end; procedure TfrmOptions.cbSkinAtStartupClick(Sender: TObject); begin frmFrame.SkinAtStartup := cbSkinAtStartup.Checked; uTMGOptions.WriteBool('Load Skin At Startup',frmFrame.SkinAtStartup); //kt 9/11/08 end; procedure TfrmOptions.cboTransMethodChange(Sender: TObject); var Show : boolean; begin if cboTransMethod.Text = IMAGE_TRANSFER_METHODS[itmDirect] then begin MessageDlg('Sorry. Direct file access not yet supported.',mtInformation,[mbOK],0); cboTransMethod.ItemIndex := -1; end; if cboTransMethod.ItemIndex < 0 then begin cboTransMethod.ItemIndex := ord(itmRPC); cboTransMethod.Text := IMAGE_TRANSFER_METHODS[itmRPC]; end; Show := (cboTransMethod.ItemIndex = ord(itmDropbox)); editDropboxLocation.Visible := Show; btnBrowseDropBox.Visible := Show; lblDropBox.Visible := Show; FdirtyImageSettings := true; CheckApply; end; procedure TfrmOptions.cbEnableImagesClick(Sender: TObject); begin FdirtyImageSettings := true; CheckApply; end; procedure TfrmOptions.editDropboxLocationChange(Sender: TObject); begin FdirtyImageSettings := true; CheckApply; end; procedure TfrmOptions.cbEnableScanningClick(Sender: TObject); begin editScannedLocation.Visible := cbEnableScanning.checked; btnBrowseScannedImages.Visible := cbEnableScanning.checked; edtPolFreq.Visible := cbEnableScanning.checked; lblScannedImagesFolder.Visible := cbEnableScanning.checked; lblPollingInterval.Visible := cbEnableScanning.checked; lblSeconds.Visible := cbEnableScanning.checked; FdirtyImageSettings := true; CheckApply; end; procedure TfrmOptions.editScannedLocationChange(Sender: TObject); begin FdirtyImageSettings := true; CheckApply; end; procedure TfrmOptions.edtPolFreqChange(Sender: TObject); begin FdirtyImageSettings := true; CheckApply; end; procedure TfrmOptions.btnBrowseDropBoxClick(Sender: TObject); var sFolder: string; begin sFolder := BrowseDialog('Choose a Dropbox folder', BIF_RETURNONLYFSDIRS); if sFolder <> '' then begin if rightstr(sFolder,1) = '\' then begin editDropboxLocation.text := sFolder; end else begin editDropboxLocation.text := sFolder + '\'; end; end; end; function TfrmOptions.BrowseDialog(const Title: string; const Flag: integer): string; var lpItemID : PItemIDList; BrowseInfo : TBrowseInfo; DisplayName : array[0..MAX_PATH] of char; TempPath : array[0..MAX_PATH] of char; begin Result:=''; FillChar(BrowseInfo, sizeof(TBrowseInfo), #0); with BrowseInfo do begin hwndOwner := Application.Handle; pszDisplayName := @DisplayName; lpszTitle := PChar(Title); ulFlags := Flag; end; lpItemID := SHBrowseForFolder(BrowseInfo); if lpItemId <> nil then begin SHGetPathFromIDList(lpItemID, TempPath); Result := TempPath; GlobalFreePtr(lpItemID); end; end; procedure TfrmOptions.btnBrowseScannedImagesClick(Sender: TObject); var sFolder: string; begin sFolder := BrowseDialog('Choose a Scanned folder', BIF_RETURNONLYFSDIRS); if sFolder <> '' then begin if rightstr(sFolder,1) = '\' then begin editScannedLocation.text := sFolder; end else begin editScannedLocation.text := sFolder + '\'; end; end; end; end.