Ignore:
Timestamp:
Sep 7, 2008, 8:34:08 PM (16 years ago)
Author:
Kevin Toppenberg
Message:

adding skin support (incomplete)

Location:
cprs/branches/tmg-cprs/CPRS-Chart/Options
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • cprs/branches/tmg-cprs/CPRS-Chart/Options/fOptions.dfm

    r473 r487  
    1616  OnCreate = FormCreate
    1717  OnDestroy = FormDestroy
     18  OnShow = FormShow
    1819  PixelsPerInch = 96
    1920  TextHeight = 13
    … …  
    8687      Height = 323
    8788      HelpContext = 9999
    88       ActivePage = tsCoverSheet
     89      ActivePage = tsAppearance
    8990      Align = alClient
    9091      TabOrder = 0
    … …  
    17501751        end
    17511752      end
     1753      object tsAppearance: TTabSheet
     1754        Caption = 'Appearance'
     1755        ImageIndex = 8
     1756        DesignSize = (
     1757          409
     1758          295)
     1759        object Label12: TLabel
     1760          Left = 8
     1761          Top = 5
     1762          Width = 45
     1763          Height = 13
     1764          Caption = 'Skin files:'
     1765          Transparent = True
     1766        end
     1767        object lbSkins: TListBox
     1768          Left = 8
     1769          Top = 24
     1770          Width = 281
     1771          Height = 241
     1772          Font.Charset = DEFAULT_CHARSET
     1773          Font.Color = clWindowText
     1774          Font.Height = -11
     1775          Font.Name = 'MS Sans Serif'
     1776          Font.Style = []
     1777          ItemHeight = 13
     1778          ParentFont = False
     1779          TabOrder = 0
     1780          OnDblClick = btnApplyClick
     1781          OnKeyPress = lbSkinsKeyPress
     1782        end
     1783        object cbSkinAtStartup: TCheckBox
     1784          Left = 8
     1785          Top = 272
     1786          Width = 265
     1787          Height = 17
     1788          Anchors = [akLeft, akBottom]
     1789          Caption = 'Load last selected skin when starting program'
     1790          Checked = True
     1791          State = cbChecked
     1792          TabOrder = 1
     1793        end
     1794        object btnMoreSkins: TButton
     1795          Left = 304
     1796          Top = 96
     1797          Width = 97
     1798          Height = 25
     1799          Caption = '&More skins...'
     1800          TabOrder = 2
     1801          OnClick = btnMoreSkinsClick
     1802        end
     1803        object btnDisableSkin: TButton
     1804          Left = 304
     1805          Top = 64
     1806          Width = 97
     1807          Height = 25
     1808          Caption = '&Disable skin'
     1809          ModalResult = 7
     1810          TabOrder = 3
     1811          OnClick = btnDisableSkinClick
     1812        end
     1813        object btnApplySkin: TButton
     1814          Left = 304
     1815          Top = 32
     1816          Width = 97
     1817          Height = 25
     1818          Caption = '&Apply skin'
     1819          TabOrder = 4
     1820          OnClick = btnApplySkinClick
     1821        end
     1822      end
    17521823    end
    17531824  end
    17541825  object DKLanguageController1: TDKLanguageController
    1755     Left = 80
    1756     Top = 280
     1826    Left = 328
     1827    Top = 192
    17571828    LangData = {
    17581829      0A0066726D4F7074696F6E73010200000001000000070043617074696F6E0200
    1759       0000080048656C7046696C6501640000000900706E6C426F74746F6D00000500
     1830      0000080048656C7046696C65016B0000000900706E6C426F74746F6D00000500
    17601831      62746E4F4B010100000003000000070043617074696F6E00090062746E43616E
    17611832      63656C010100000004000000070043617074696F6E00080062746E4170706C79
    … …  
    18521923      676501020000004C000000040048696E744D000000040054657874000600496D
    18531924      61676531000005004D656D6F3101010000004F00000005004C696E6573000700
    1854       427574746F6E31010100000050000000070043617074696F6E00}
     1925      427574746F6E31010100000050000000070043617074696F6E000C0074734170
     1926      70656172616E6365010100000051000000070043617074696F6E0007004C6162
     1927      656C3132010100000052000000070043617074696F6E0007006C62536B696E73
     1928      00000F006362536B696E41745374617274757001010000005300000007004361
     1929      7074696F6E000C0062746E4D6F7265536B696E73010100000054000000070043
     1930      617074696F6E000E0062746E44697361626C65536B696E010100000055000000
     1931      070043617074696F6E000C0062746E4170706C79536B696E0101000000560000
     1932      00070043617074696F6E00}
    18551933  end
    18561934end

  • cprs/branches/tmg-cprs/CPRS-Chart/Options/fOptions.pas

    r453 r487  
    44interface
    55
    6 uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
     6uses
     7  Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
    78  Buttons, ComCtrls, ExtCtrls, ORCtrls, OrFn, Dialogs, ORDtTmRng, fBAOptionsDiagnoses,
    89  uBAGlobals, TntStdCtrls, DKLang, jpeg, inifiles;
    … …  
    2021
    2122 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.
    2225 }
    2326
    … …  
    125128    Memo1: TMemo;
    126129    Button1: TButton;
     130    tsAppearance: TTabSheet;
     131    Label12: TLabel;
     132    lbSkins: TListBox;
     133    cbSkinAtStartup: TCheckBox;
     134    btnMoreSkins: TButton;
     135    btnDisableSkin: TButton;
     136    btnApplySkin: TButton;
    127137    procedure FormCreate(Sender: TObject);
    128138    procedure FormDestroy(Sender: TObject);
    … …  
    157167    procedure rdoRDVClick(Sender: TObject);
    158168    procedure cbLanguageChange(Sender: TObject);
    159     procedure Button1Click(Sender: TObject);  //kt added 6/29/07
     169    procedure Button1Click(Sender: TObject);
     170    procedure btnApplySkinClick(Sender: TObject);
     171    procedure btnMoreSkinsClick(Sender: TObject);
     172    procedure FormShow(Sender: TObject);
     173    procedure lbSkinsKeyPress(Sender: TObject; var Key: Char);
     174    procedure btnDisableSkinClick(Sender: TObject);  //kt added 6/29/07
    160175  private
    161176    { Private declarations }
    … …  
    167182    FsortAscending: boolean;
    168183    FLastClickedItem: TListItem;
     184    procedure FillSkinList;  //kt
    169185    procedure Offset(var topnum: integer; topoffset: integer; var leftnum: integer; leftoffset: integer);
    170186    procedure LoadNotifications;
    … …  
    187203implementation
    188204
    189 uses fOptionsDays, fOptionsReminders, fOptionsSurrogate,
    190      fOptionsPatientSelection, fOptionsLists, fOptionsTeams, fOptionsCombinations,
    191      fOptionsOther, fOptionsNotes, fOptionsTitles, fOptionsReportsCustom, fOptionsReportsDefault,
    192      fGraphs, fGraphSettings, fGraphProfiles, rGraphs, uGraphs,
    193      rOptions, rCore, uCore, uOptions, UBACore, fFrame,
    194      //fTestDialog;
     205  uses fOptionsDays, fOptionsReminders, fOptionsSurrogate,
     206       fOptionsPatientSelection, fOptionsLists, fOptionsTeams, fOptionsCombinations,
     207       fOptionsOther, fOptionsNotes, fOptionsTitles, fOptionsReportsCustom, fOptionsReportsDefault,
     208       fGraphs, fGraphSettings, fGraphProfiles, rGraphs, uGraphs,
     209       rOptions, rCore, uCore, uOptions, UBACore, fFrame,
     210       //fTestDialog;
    195211
    196212    //kt mod 6/29/07 -----
     213    ShellAPI, //kt 9/8/08
    197214    ORNet, //allows access to RPCBrokerV
    198215    TntForms, TntSystem, TntSysUtils;
    … …  
    202219{$R *.DFM}
    203220
    204 type
    205   TRule = class
    206   public
    207     IEN: string;
    208     OriginalValue: string;
    209     ItemText: string;
    210 end;
    211 
    212 procedure DialogOptions(var actiontype: Integer);
    213 // create the form and make in modal, return an action
    214 const
    215   PixelGapBetweenButtons = 5;
    216 var
    217   frmOptions: TfrmOptions;
    218 begin
    219   frmOptions := TfrmOptions.Create(Application);
    220   try
    221     with frmOptions do
     221  type
     222    TRule = class
     223    public
     224      IEN: string;
     225      OriginalValue: string;
     226      ItemText: string;
     227  end;
     228
     229  procedure DialogOptions(var actiontype: Integer);
     230  // create the form and make in modal, return an action
     231  const
     232    PixelGapBetweenButtons = 5;
     233  var
     234    frmOptions: TfrmOptions;
     235  begin
     236    frmOptions := TfrmOptions.Create(Application);
     237    try
     238      with frmOptions do
     239      begin
     240        with pagOptions do
     241        begin
     242          tsCoverSheet.TabVisible := false;
     243          tsNotifications.TabVisible := false;
     244          tsOrderChecks.TabVisible := false;
     245          tsListsTeams.TabVisible := false;
     246          case actiontype of
     247          1: begin
     248               tsCoverSheet.TabVisible := true;
     249             end;
     250          2: begin
     251               tsNotifications.TabVisible := true;
     252             end;
     253          3: begin
     254               tsOrderChecks.TabVisible := true;
     255             end;
     256          4: begin
     257               tsListsTeams.TabVisible := true;
     258             end;
     259          else
     260             begin
     261               tsCoverSheet.TabVisible := true;
     262               tsNotifications.TabVisible := true;
     263               tsOrderChecks.TabVisible := true;
     264               tsListsTeams.TabVisible := true;
     265               ActivePage := tsCoverSheet;
     266  //           memReports.Text := 'Change the default date range and occurrence limits for all reports on ' +  <-- original line.  //kt 8/8/2007
     267               memReports.Text := DKLangConstW('fOptions_Change_the_default_date_range_and_occurrence_limits_for_all_reports_on') + //kt added 8/8/2007
     268  //                             'the CPRS Reports tab (excluding health summary reports) .';  <-- original line.  //kt 8/8/2007
     269                                 DKLangConstW('fOptions_the_CPRS_Reports_tab_xexcluding_health_summary_reportsx_x'); //kt added 8/8/2007
     270  //           memReport1.Text := 'Change the individual date range and occurrence limits for each report on ' +  <-- original line.  //kt 8/8/2007
     271               memReport1.Text := DKLangConstW('fOptions_Change_the_individual_date_range_and_occurrence_limits_for_each_report_on') + //kt added 8/8/2007
     272  //                             'the CPRS Reports tab (excluding health summary reports) .';  <-- original line.  //kt 8/8/2007
     273                                 DKLangConstW('fOptions_the_CPRS_Reports_tab_xexcluding_health_summary_reportsx_x'); //kt added 8/8/2007
     274  //           btnReports.caption := 'Set All Reports...';  <-- original line.  //kt 8/8/2007
     275               btnReports.caption := DKLangConstW('fOptions_Set_All_Reportsxxx'); //kt added 8/8/2007
     276  //           btnReport1.caption := 'Set Individual Reports...';  <-- original line.  //kt 8/8/2007
     277               btnReport1.caption := DKLangConstW('fOptions_Set_Individual_Reportsxxx'); //kt added 8/8/2007
     278               if User.IsReportsOnly then // For "Reports Only" users.
     279                 begin
     280                   tsCoverSheet.TabVisible := false;
     281                   tsNotifications.TabVisible := false;
     282                   tsOrderChecks.TabVisible := false;
     283                   tsListsTeams.TabVisible := false;
     284                   tsNotes.TabVisible := false;
     285                   if (not User.ToolsRptEdit) then
     286                   begin
     287                     btnOK.visible := false;
     288                     btnApply.visible := false;
     289  //                 btnCancel.caption := 'Close';  <-- original line.  //kt 8/8/2007
     290                     btnCancel.caption := DKLangConstW('fOptions_Close'); //kt added 8/8/2007
     291                   end;
     292                 end;
     293               if (not User.ToolsRptEdit) then // For users with Reports settings edit parameter not set.
     294                 begin
     295  //               memReports.Text := 'View the default date range and occurrence limits for all reports on ' +  <-- original line.  //kt 8/8/2007
     296                   memReports.Text := DKLangConstW('fOptions_View_the_default_date_range_and_occurrence_limits_for_all_reports_on') + //kt added 8/8/2007
     297  //                                 'the CPRS Reports tab (excluding health summary reports) .';  <-- original line.  //kt 8/8/2007
     298                                     DKLangConstW('fOptions_the_CPRS_Reports_tab_xexcluding_health_summary_reportsx_x'); //kt added 8/8/2007
     299  //               memReport1.Text := 'View the individual date range and occurrence limits for each report on ' +  <-- original line.  //kt 8/8/2007
     300                   memReport1.Text := DKLangConstW('fOptions_View_the_individual_date_range_and_occurrence_limits_for_each_report_on') + //kt added 8/8/2007
     301  //                                 'the CPRS Reports tab (excluding health summary reports) .';  <-- original line.  //kt 8/8/2007
     302                                     DKLangConstW('fOptions_the_CPRS_Reports_tab_xexcluding_health_summary_reportsx_x'); //kt added 8/8/2007
     303  //               btnReports.caption := 'View All Report Settings...';  <-- original line.  //kt 8/8/2007
     304                   btnReports.caption := DKLangConstW('fOptions_View_All_Report_Settingsxxx'); //kt added 8/8/2007
     305  //               btnReport1.caption := 'View Individual Report Settings...';  <-- original line.  //kt 8/8/2007
     306                   btnReport1.caption := DKLangConstW('fOptions_View_Individual_Report_Settingsxxx'); //kt added 8/8/2007
     307                 end;
     308             end;
     309          end;
     310        end;
     311        actiontype := 0;
     312        ResizeAnchoredFormToFont(frmOptions);
     313        btnApply.Left := pagOptions.Left + pagOptions.Width - btnApply.Width;
     314        btnCancel.Left := btnApply.Left - btnCancel.Width - PixelGapBetweenButtons;
     315        btnOK.Left := btnCancel.Left - btnOK.Width - PixelGapBetweenButtons;
     316        ShowModal;
     317        actiontype := btnOK.Tag;
     318      end;
     319    finally
     320      frmOptions.Release;
     321    end;
     322  end;
     323
     324  procedure TfrmOptions.FormCreate(Sender: TObject);
     325  // initialize form
     326  var i : integer;  //kt added 6/29/07
     327  begin
     328    LoadNotifications;
     329    LoadOrderChecks;
     330    FdirtyNotifications := false;
     331    FdirtyOrderChecks := false;
     332    FdirtyOtherStuff := false;
     333    CheckApply;
     334
     335    if (Encounter.Provider = 0) and not IsCIDCProvider(User.DUZ) then
     336        btnDiagnoses.Enabled := False;
     337    if UseVistaWeb then rdoRDV.ItemIndex := 1;
     338
     339    //kt begin modification 6/29/07 ---------------
     340
     341    // Fill cbLanguage with available languages
     342    // Note: LangManager was populated at form creation of fFrame
     343    for i := 0 to LangManager.LanguageCount-1 do cbLanguage.Items.Add(LangManager.LanguageNames[i]);
     344    //Index=0 always means the default language
     345    cbLanguage.ItemIndex := LangManager.LanguageIndex;
     346    //kt end modification 6/29/07 ---------------
     347
     348    cbSkinAtStartup.Checked := frmFrame.SkinAtStartup; //kt 9/8/08
     349
     350  end;
     351
     352  procedure TfrmOptions.FormDestroy(Sender: TObject);
     353  // cleanup creation of objects
     354  var
     355    i: integer;
     356  begin
     357    for i := 0 to lvwOrderChecks.Items.Count - 1 do
     358      lvwOrderChecks.Items.Item[i].SubItems.Objects[2].free;
     359    for i := 0 to lvwNotifications.Items.Count - 1 do
     360      lvwNotifications.Items.Item[i].SubItems.Objects[2].free;
     361  end;
     362
     363  procedure TfrmOptions.btnCoverDaysClick(Sender: TObject);
     364  // display Date Range Defaults on Cover Sheet
     365  var
     366    topsize, leftsize, value: integer;
     367  begin
     368    value := 0;
     369    Offset(topsize, -60, leftsize, -60);
     370    DialogOptionsDays(topsize, leftsize, Font.Size, value);
     371  end;
     372
     373  procedure TfrmOptions.btnCoverRemindersClick(Sender: TObject);
     374  // display Clinical Reminder Options
     375  var
     376    topsize, leftsize, value: integer;
     377  begin
     378    value := 0;
     379    Offset(topsize, -60, leftsize, -60);
     380    DialogOptionsReminders(topsize, leftsize, Font.Size, value);
     381  end;
     382
     383  procedure TfrmOptions.btnOtherParametersClick(Sender: TObject);
     384  // display Other Parameters Options
     385  var
     386    topsize, leftsize, value: integer;
     387  begin
     388    value := 0;
     389    Offset(topsize, 40, leftsize, 40);
     390    DialogOptionsOther(topsize, leftsize, Font.Size, value);
     391  end;
     392
     393  procedure TfrmOptions.btnPatientSelectionClick(Sender: TObject);
     394  // display Patient Selection Options
     395  var
     396    topsize, leftsize, value: integer;
     397  begin
     398    value := 0;
     399    Offset(topsize, -60, leftsize, -60);
     400    DialogOptionsPatientSelection(topsize, leftsize, Font.Size, value);
     401  end;
     402
     403  procedure TfrmOptions.btnPersonalListsClick(Sender: TObject);
     404  // display Personal Lists Options
     405  var
     406    topsize, leftsize, value: integer;
     407  begin
     408    value := 0;
     409    Offset(topsize, -60, leftsize, -60);
     410    DialogOptionsLists(topsize, leftsize, Font.Size, value);
     411  end;
     412
     413  procedure TfrmOptions.btnTeamsClick(Sender: TObject);
     414  // display Team Options
     415  var
     416    topsize, leftsize, value: integer;
     417  begin
     418    value := 0;
     419    Offset(topsize, -60, leftsize, -60);
     420    DialogOptionsTeams(topsize, leftsize, Font.Size, value);
     421  end;
     422
     423  procedure TfrmOptions.btnNotificationsRemoveClick(Sender: TObject);
     424  // confirm before clearing notifications
     425  begin
     426  //if InfoBox('CAUTION: This will clear all the current notifications you have pending.'  <-- original line.  //kt 8/8/2007
     427    if InfoBox(DKLangConstW('fOptions_CAUTIONx_This_will_clear_all_the_current_notifications_you_have_pendingx') //kt added 8/8/2007
     428  //  + #13 + 'If you say YES, these changes will take place immediately.'  <-- original line.  //kt 8/8/2007
     429      + #13 + DKLangConstW('fOptions_If_you_say_YESx_these_changes_will_take_place_immediatelyx') //kt added 8/8/2007
     430  //  + #13 + 'Are you sure you want to erase all of your notifications?',  <-- original line.  //kt 8/8/2007
     431      + #13 + DKLangConstW('fOptions_Are_you_sure_you_want_to_erase_all_of_your_notificationsx'), //kt added 8/8/2007
     432  //  'Warning', MB_YESNO or MB_ICONWARNING) = IDYES then  <-- original line.  //kt 8/8/2007
     433      DKLangConstW('fOptions_Warning'), MB_YESNO or MB_ICONWARNING) = IDYES then //kt added 8/8/2007
     434      begin
     435        rpcClearNotifications;
     436      end;
     437  end;
     438
     439  procedure TfrmOptions.Offset(var topnum: integer; topoffset: integer; var leftnum: integer; leftoffset: integer);
     440  // get positions to display dialog
     441  begin
     442    // use these top and left values to display dialog
     443    topnum := Top;
     444    leftnum := Left;
     445    topnum := topnum + topoffset;
     446    if topnum < 0 then topnum := 0;
     447    leftnum := leftnum + leftoffset;
     448    if leftnum < 0 then leftnum := 0;
     449  end;
     450
     451  procedure TfrmOptions.btnApplyClick(Sender: TObject);
     452  // save actions without exiting
     453  begin
     454    if FdirtyNotifications then
     455      ApplyNotifications;
     456    if FdirtyOrderChecks then
     457      ApplyOrderChecks;
     458    if FdirtyOtherStuff then
     459      ApplyOtherStuff;
     460    CheckApply;
     461    if Sender = btnOK then
     462      Close;
     463  end;
     464
     465  procedure TfrmOptions.LoadNotifications;
     466  // load Notification tab
     467  var
     468    notifydefaults, surrogateinfo, flag, enableerase: string;
     469  begin
     470    LoadListView(lvwNotifications, rpcGetNotifications);
     471    lvwNotificationsColumnClick(lvwNotifications, lvwNotifications.Column[0]); // make sure sorted
     472    notifydefaults := rpcGetNotificationDefaults;
     473    flag := Piece(notifydefaults, '^', 2);
     474    enableerase := Piece(notifydefaults, '^', 3);
     475    chkNotificationsFlagged.Checked := flag = '1';
     476    btnNotificationsRemove.Enabled := enableerase = '1';
     477    surrogateinfo := rpcGetSurrogateInfo;
     478    btnSurrogate.Hint := surrogateinfo;
     479    LabelSurrogate(surrogateinfo, lblNotificationsSurrogateText);
     480  end;
     481
     482  procedure TfrmOptions.LoadOrderChecks;
     483  // load Order Check tab
     484  begin
     485    LoadListView(lvwOrderChecks, rpcGetOrderChecks);
     486    lvwOrderChecks.Checkboxes := true;
     487  end;
     488
     489  procedure TfrmOptions.ApplyNotifications;
     490  // save Notification changes
     491  var
     492    i: integer;
     493    newonoff: string;
     494    aRule: TRule;
     495    aList: TStringList;
     496  begin
     497    aList := TStringList.Create;
     498    for i := 0 to lvwNotifications.Items.Count - 1 do
    222499    begin
    223       with pagOptions do
     500      aRule := TRule(lvwNotifications.Items.Item[i].SubItems.Objects[2]);
     501  //  if lvwNotifications.Items.Item[i].SubItems[1] <> 'Mandatory' then  <-- original line.  //kt 8/8/2007
     502      if lvwNotifications.Items.Item[i].SubItems[1] <> DKLangConstW('fOptions_Mandatory') then //kt added 8/8/2007
    224503      begin
    225         tsCoverSheet.TabVisible := false;
    226         tsNotifications.TabVisible := false;
    227         tsOrderChecks.TabVisible := false;
    228         tsListsTeams.TabVisible := false;
    229         case actiontype of
    230         1: begin
    231              tsCoverSheet.TabVisible := true;
    232            end;
    233         2: begin
    234              tsNotifications.TabVisible := true;
    235            end;
    236         3: begin
    237              tsOrderChecks.TabVisible := true;
    238            end;
    239         4: begin
    240              tsListsTeams.TabVisible := true;
    241            end;
    242         else
    243            begin
    244              tsCoverSheet.TabVisible := true;
    245              tsNotifications.TabVisible := true;
    246              tsOrderChecks.TabVisible := true;
    247              tsListsTeams.TabVisible := true;
    248              ActivePage := tsCoverSheet;
    249 //           memReports.Text := 'Change the default date range and occurrence limits for all reports on ' +  <-- original line.  //kt 8/8/2007
    250              memReports.Text := DKLangConstW('fOptions_Change_the_default_date_range_and_occurrence_limits_for_all_reports_on') + //kt added 8/8/2007
    251 //                             'the CPRS Reports tab (excluding health summary reports) .';  <-- original line.  //kt 8/8/2007
    252                                DKLangConstW('fOptions_the_CPRS_Reports_tab_xexcluding_health_summary_reportsx_x'); //kt added 8/8/2007
    253 //           memReport1.Text := 'Change the individual date range and occurrence limits for each report on ' +  <-- original line.  //kt 8/8/2007
    254              memReport1.Text := DKLangConstW('fOptions_Change_the_individual_date_range_and_occurrence_limits_for_each_report_on') + //kt added 8/8/2007
    255 //                             'the CPRS Reports tab (excluding health summary reports) .';  <-- original line.  //kt 8/8/2007
    256                                DKLangConstW('fOptions_the_CPRS_Reports_tab_xexcluding_health_summary_reportsx_x'); //kt added 8/8/2007
    257 //           btnReports.caption := 'Set All Reports...';  <-- original line.  //kt 8/8/2007
    258              btnReports.caption := DKLangConstW('fOptions_Set_All_Reportsxxx'); //kt added 8/8/2007
    259 //           btnReport1.caption := 'Set Individual Reports...';  <-- original line.  //kt 8/8/2007
    260              btnReport1.caption := DKLangConstW('fOptions_Set_Individual_Reportsxxx'); //kt added 8/8/2007
    261              if User.IsReportsOnly then // For "Reports Only" users.
    262                begin
    263                  tsCoverSheet.TabVisible := false;
    264                  tsNotifications.TabVisible := false;
    265                  tsOrderChecks.TabVisible := false;
    266                  tsListsTeams.TabVisible := false;
    267                  tsNotes.TabVisible := false;
    268                  if (not User.ToolsRptEdit) then
    269                  begin
    270                    btnOK.visible := false;
    271                    btnApply.visible := false;
    272 //                 btnCancel.caption := 'Close';  <-- original line.  //kt 8/8/2007
    273                    btnCancel.caption := DKLangConstW('fOptions_Close'); //kt added 8/8/2007
    274                  end;
    275                end;
    276              if (not User.ToolsRptEdit) then // For users with Reports settings edit parameter not set.
    277                begin
    278 //               memReports.Text := 'View the default date range and occurrence limits for all reports on ' +  <-- original line.  //kt 8/8/2007
    279                  memReports.Text := DKLangConstW('fOptions_View_the_default_date_range_and_occurrence_limits_for_all_reports_on') + //kt added 8/8/2007
    280 //                                 'the CPRS Reports tab (excluding health summary reports) .';  <-- original line.  //kt 8/8/2007
    281                                    DKLangConstW('fOptions_the_CPRS_Reports_tab_xexcluding_health_summary_reportsx_x'); //kt added 8/8/2007
    282 //               memReport1.Text := 'View the individual date range and occurrence limits for each report on ' +  <-- original line.  //kt 8/8/2007
    283                  memReport1.Text := DKLangConstW('fOptions_View_the_individual_date_range_and_occurrence_limits_for_each_report_on') + //kt added 8/8/2007
    284 //                                 'the CPRS Reports tab (excluding health summary reports) .';  <-- original line.  //kt 8/8/2007
    285                                    DKLangConstW('fOptions_the_CPRS_Reports_tab_xexcluding_health_summary_reportsx_x'); //kt added 8/8/2007
    286 //               btnReports.caption := 'View All Report Settings...';  <-- original line.  //kt 8/8/2007
    287                  btnReports.caption := DKLangConstW('fOptions_View_All_Report_Settingsxxx'); //kt added 8/8/2007
    288 //               btnReport1.caption := 'View Individual Report Settings...';  <-- original line.  //kt 8/8/2007
    289                  btnReport1.caption := DKLangConstW('fOptions_View_Individual_Report_Settingsxxx'); //kt added 8/8/2007
    290                end;
    291            end;
     504        newonoff := Uppercase(lvwNotifications.Items.Item[i].SubItems[0]);
     505        if aRule.OriginalValue <> newonoff then
     506        begin
     507          //***showmessage(aRule.IEN + ' ' + aRule.OriginalValue + ' ' + newonoff);
     508          aList.Add(aRule.IEN + '^' + newonoff);
     509          aRule.OriginalValue := lvwNotifications.Items.Item[i].SubItems[0];
    292510        end;
    293511      end;
    294       actiontype := 0;
    295       ResizeAnchoredFormToFont(frmOptions);
    296       btnApply.Left := pagOptions.Left + pagOptions.Width - btnApply.Width;
    297       btnCancel.Left := btnApply.Left - btnCancel.Width - PixelGapBetweenButtons;
    298       btnOK.Left := btnCancel.Left - btnOK.Width - PixelGapBetweenButtons;
    299       ShowModal;
    300       actiontype := btnOK.Tag;
    301     end;
    302   finally
    303     frmOptions.Release;
    304   end;
    305 end;
    306 
    307 procedure TfrmOptions.FormCreate(Sender: TObject);
    308 // initialize form
    309 var i : integer;  //kt added 6/29/07
    310 begin
    311   LoadNotifications;
    312   LoadOrderChecks;
    313   FdirtyNotifications := false;
    314   FdirtyOrderChecks := false;
    315   FdirtyOtherStuff := false;
    316   CheckApply;
    317 
    318   if (Encounter.Provider = 0) and not IsCIDCProvider(User.DUZ) then
    319       btnDiagnoses.Enabled := False;
    320   if UseVistaWeb then rdoRDV.ItemIndex := 1;
    321 
    322   //kt begin modification 6/29/07 ---------------
    323 
    324   // Fill cbLanguage with available languages
    325   // Note: LangManager was populated at form creation of fFrame
    326   for i := 0 to LangManager.LanguageCount-1 do cbLanguage.Items.Add(LangManager.LanguageNames[i]);
    327   //Index=0 always means the default language
    328   cbLanguage.ItemIndex := LangManager.LanguageIndex;
    329 
    330   //kt end modification 6/29/07 ---------------
    331 
    332 
    333 end;
    334 
    335 procedure TfrmOptions.FormDestroy(Sender: TObject);
    336 // cleanup creation of objects
    337 var
    338   i: integer;
    339 begin
    340   for i := 0 to lvwOrderChecks.Items.Count - 1 do
    341     lvwOrderChecks.Items.Item[i].SubItems.Objects[2].free;
    342   for i := 0 to lvwNotifications.Items.Count - 1 do
    343     lvwNotifications.Items.Item[i].SubItems.Objects[2].free;
    344 end;
    345 
    346 procedure TfrmOptions.btnCoverDaysClick(Sender: TObject);
    347 // display Date Range Defaults on Cover Sheet
    348 var
    349   topsize, leftsize, value: integer;
    350 begin
    351   value := 0;
    352   Offset(topsize, -60, leftsize, -60);
    353   DialogOptionsDays(topsize, leftsize, Font.Size, value);
    354 end;
    355 
    356 procedure TfrmOptions.btnCoverRemindersClick(Sender: TObject);
    357 // display Clinical Reminder Options
    358 var
    359   topsize, leftsize, value: integer;
    360 begin
    361   value := 0;
    362   Offset(topsize, -60, leftsize, -60);
    363   DialogOptionsReminders(topsize, leftsize, Font.Size, value);
    364 end;
    365 
    366 procedure TfrmOptions.btnOtherParametersClick(Sender: TObject);
    367 // display Other Parameters Options
    368 var
    369   topsize, leftsize, value: integer;
    370 begin
    371   value := 0;
    372   Offset(topsize, 40, leftsize, 40);
    373   DialogOptionsOther(topsize, leftsize, Font.Size, value);
    374 end;
    375 
    376 procedure TfrmOptions.btnPatientSelectionClick(Sender: TObject);
    377 // display Patient Selection Options
    378 var
    379   topsize, leftsize, value: integer;
    380 begin
    381   value := 0;
    382   Offset(topsize, -60, leftsize, -60);
    383   DialogOptionsPatientSelection(topsize, leftsize, Font.Size, value);
    384 end;
    385 
    386 procedure TfrmOptions.btnPersonalListsClick(Sender: TObject);
    387 // display Personal Lists Options
    388 var
    389   topsize, leftsize, value: integer;
    390 begin
    391   value := 0;
    392   Offset(topsize, -60, leftsize, -60);
    393   DialogOptionsLists(topsize, leftsize, Font.Size, value);
    394 end;
    395 
    396 procedure TfrmOptions.btnTeamsClick(Sender: TObject);
    397 // display Team Options
    398 var
    399   topsize, leftsize, value: integer;
    400 begin
    401   value := 0;
    402   Offset(topsize, -60, leftsize, -60);
    403   DialogOptionsTeams(topsize, leftsize, Font.Size, value);
    404 end;
    405 
    406 procedure TfrmOptions.btnNotificationsRemoveClick(Sender: TObject);
    407 // confirm before clearing notifications
    408 begin
    409 //if InfoBox('CAUTION: This will clear all the current notifications you have pending.'  <-- original line.  //kt 8/8/2007
    410   if InfoBox(DKLangConstW('fOptions_CAUTIONx_This_will_clear_all_the_current_notifications_you_have_pendingx') //kt added 8/8/2007
    411 //  + #13 + 'If you say YES, these changes will take place immediately.'  <-- original line.  //kt 8/8/2007
    412     + #13 + DKLangConstW('fOptions_If_you_say_YESx_these_changes_will_take_place_immediatelyx') //kt added 8/8/2007
    413 //  + #13 + 'Are you sure you want to erase all of your notifications?',  <-- original line.  //kt 8/8/2007
    414     + #13 + DKLangConstW('fOptions_Are_you_sure_you_want_to_erase_all_of_your_notificationsx'), //kt added 8/8/2007
    415 //  'Warning', MB_YESNO or MB_ICONWARNING) = IDYES then  <-- original line.  //kt 8/8/2007
    416     DKLangConstW('fOptions_Warning'), MB_YESNO or MB_ICONWARNING) = IDYES then //kt added 8/8/2007
     512    end;
     513    rpcSetNotifications(aList);
     514    aList.free;
     515    FdirtyNotifications := false;
     516  end;
     517
     518  procedure TfrmOptions.ApplyOrderChecks;
     519  // save Order Check changes
     520  var
     521    i: integer;
     522    newonoff: string;
     523    aRule: TRule;
     524    aList: TStringList;
     525  begin
     526    aList := TStringList.Create;
     527    for i := 0 to lvwOrderChecks.Items.Count - 1 do
    417528    begin
    418       rpcClearNotifications;
    419     end;
    420 end;
    421 
    422 procedure TfrmOptions.Offset(var topnum: integer; topoffset: integer; var leftnum: integer; leftoffset: integer);
    423 // get positions to display dialog
    424 begin
    425   // use these top and left values to display dialog
    426   topnum := Top;
    427   leftnum := Left;
    428   topnum := topnum + topoffset;
    429   if topnum < 0 then topnum := 0;
    430   leftnum := leftnum + leftoffset;
    431   if leftnum < 0 then leftnum := 0;
    432 end;
    433 
    434 procedure TfrmOptions.btnApplyClick(Sender: TObject);
    435 // save actions without exiting
    436 begin
    437   if FdirtyNotifications then
    438     ApplyNotifications;
    439   if FdirtyOrderChecks then
    440     ApplyOrderChecks;
    441   if FdirtyOtherStuff then
    442     ApplyOtherStuff;
    443   CheckApply;
    444   if Sender = btnOK then
    445     Close;
    446 end;
    447 
    448 procedure TfrmOptions.LoadNotifications;
    449 // load Notification tab
    450 var
    451   notifydefaults, surrogateinfo, flag, enableerase: string;
    452 begin
    453   LoadListView(lvwNotifications, rpcGetNotifications);
    454   lvwNotificationsColumnClick(lvwNotifications, lvwNotifications.Column[0]); // make sure sorted
    455   notifydefaults := rpcGetNotificationDefaults;
    456   flag := Piece(notifydefaults, '^', 2);
    457   enableerase := Piece(notifydefaults, '^', 3);
    458   chkNotificationsFlagged.Checked := flag = '1';
    459   btnNotificationsRemove.Enabled := enableerase = '1';
    460   surrogateinfo := rpcGetSurrogateInfo;
    461   btnSurrogate.Hint := surrogateinfo;
    462   LabelSurrogate(surrogateinfo, lblNotificationsSurrogateText);
    463 end;
    464 
    465 procedure TfrmOptions.LoadOrderChecks;
    466 // load Order Check tab
    467 begin
    468   LoadListView(lvwOrderChecks, rpcGetOrderChecks);
    469   lvwOrderChecks.Checkboxes := true;
    470 end;
    471 
    472 procedure TfrmOptions.ApplyNotifications;
    473 // save Notification changes
    474 var
    475   i: integer;
    476   newonoff: string;
    477   aRule: TRule;
    478   aList: TStringList;
    479 begin
    480   aList := TStringList.Create;
    481   for i := 0 to lvwNotifications.Items.Count - 1 do
    482   begin
    483     aRule := TRule(lvwNotifications.Items.Item[i].SubItems.Objects[2]);
    484 //  if lvwNotifications.Items.Item[i].SubItems[1] <> 'Mandatory' then  <-- original line.  //kt 8/8/2007
    485     if lvwNotifications.Items.Item[i].SubItems[1] <> DKLangConstW('fOptions_Mandatory') then //kt added 8/8/2007
    486     begin
    487       newonoff := Uppercase(lvwNotifications.Items.Item[i].SubItems[0]);
     529      aRule := TRule(lvwOrderChecks.Items.Item[i].SubItems.Objects[2]);
     530      newonoff := Uppercase(lvwOrderChecks.Items.Item[i].SubItems[0]);
    488531      if aRule.OriginalValue <> newonoff then
    489532      begin
    490         //***showmessage(aRule.IEN + ' ' + aRule.OriginalValue + ' ' + newonoff);
    491533        aList.Add(aRule.IEN + '^' + newonoff);
    492         aRule.OriginalValue := lvwNotifications.Items.Item[i].SubItems[0];
     534        aRule.OriginalValue := lvwOrderChecks.Items.Item[i].SubItems[0];
    493535      end;
    494536    end;
    495   end;
    496   rpcSetNotifications(aList);
    497   aList.free;
    498   FdirtyNotifications := false;
    499 end;
    500 
    501 procedure TfrmOptions.ApplyOrderChecks;
    502 // save Order Check changes
    503 var
    504   i: integer;
    505   newonoff: string;
    506   aRule: TRule;
    507   aList: TStringList;
    508 begin
    509   aList := TStringList.Create;
    510   for i := 0 to lvwOrderChecks.Items.Count - 1 do
    511   begin
    512     aRule := TRule(lvwOrderChecks.Items.Item[i].SubItems.Objects[2]);
    513     newonoff := Uppercase(lvwOrderChecks.Items.Item[i].SubItems[0]);
    514     if aRule.OriginalValue <> newonoff then
     537    rpcSetOrderChecks(aList);
     538    aList.free;
     539    FdirtyOrderChecks := false;
     540  end;
     541
     542  procedure TfrmOptions.ApplyOtherStuff;
     543  // save other changes
     544  var
     545    aString: string;
     546  begin
     547    aString := '';
     548    if chkNotificationsFlagged.Checked then
     549      aString := aString + '^1'
     550    else
     551      aString := aString + '^0';
     552    rpcSetOtherStuff(aString);
     553    FdirtyOtherStuff := false;
     554  end;
     555
     556  procedure TfrmOptions.CheckApply;
     557  // determine if Apply button is enabled
     558  begin
     559    btnApply.Enabled :=  FdirtyOrderChecks or FdirtyNotifications or FdirtyOtherStuff;
     560  end;
     561
     562  procedure TfrmOptions.chkNotificationsFlaggedClick(Sender: TObject);
     563  // set notification flagged status
     564  begin
     565    FdirtyOtherStuff := true;
     566    CheckApply;
     567  end;
     568
     569  procedure TfrmOptions.LoadListView(aListView: TListView; aList: TStrings);
     570  // load a list view with: name, on/off, comment
     571  var
     572    i: integer;
     573    aListItem: TListItem;
     574    aRule: TRule;
     575    rulenum, ruletext, ruleonoff, rulecomment: string;
     576  begin
     577    FuseCheckBoxes := false;
     578    aListView.Items.Clear;
     579    aListView.SortType := stNone; // if Sorting during load then potential error
     580    with aList do
    515581    begin
    516       aList.Add(aRule.IEN + '^' + newonoff);
    517       aRule.OriginalValue := lvwOrderChecks.Items.Item[i].SubItems[0];
    518     end;
    519   end;
    520   rpcSetOrderChecks(aList);
    521   aList.free;
    522   FdirtyOrderChecks := false;
    523 end;
    524 
    525 procedure TfrmOptions.ApplyOtherStuff;
    526 // save other changes
    527 var
    528   aString: string;
    529 begin
    530   aString := '';
    531   if chkNotificationsFlagged.Checked then
    532     aString := aString + '^1'
    533   else
    534     aString := aString + '^0';
    535   rpcSetOtherStuff(aString);
    536   FdirtyOtherStuff := false;
    537 end;
    538 
    539 procedure TfrmOptions.CheckApply;
    540 // determine if Apply button is enabled
    541 begin
    542   btnApply.Enabled :=  FdirtyOrderChecks or FdirtyNotifications or FdirtyOtherStuff;
    543 end;
    544 
    545 procedure TfrmOptions.chkNotificationsFlaggedClick(Sender: TObject);
    546 // set notification flagged status
    547 begin
    548   FdirtyOtherStuff := true;
    549   CheckApply;
    550 end;
    551 
    552 procedure TfrmOptions.LoadListView(aListView: TListView; aList: TStrings);
    553 // load a list view with: name, on/off, comment
    554 var
    555   i: integer;
    556   aListItem: TListItem;
    557   aRule: TRule;
    558   rulenum, ruletext, ruleonoff, rulecomment: string;
    559 begin
    560   FuseCheckBoxes := false;
    561   aListView.Items.Clear;
    562   aListView.SortType := stNone; // if Sorting during load then potential error
    563   with aList do
    564   begin
    565     for i := 0 to aList.Count - 1 do
     582      for i := 0 to aList.Count - 1 do
     583      begin
     584        rulenum := Piece(aList[i], '^', 1);
     585        ruletext := Piece(aList[i], '^', 2);
     586        ruleonoff := Piece(aList[i], '^', 3);
     587        rulecomment := Piece(aList[i], '^', 4);
     588        aListItem := aListView.Items.Add;
     589        with aListItem do
     590        begin
     591          Caption := ruletext;
     592          SubItems.Add(ruleonoff);
     593          if ruleonoff = 'On' then Checked := true;
     594          SubItems.Add(rulecomment);
     595        end;
     596        aRule := TRule.Create;
     597        with aRule do
     598        begin
     599          IEN := rulenum;
     600          OriginalValue := ruleonoff;
     601          ItemText := ruletext;
     602        end;
     603  //    aListItem.SubItems.AddObject('rule object', aRule);  <-- original line.  //kt 8/8/2007
     604        aListItem.SubItems.AddObject(DKLangConstW('fOptions_rule_object'), aRule); //kt added 8/8/2007
     605      end;
     606    end;
     607    aListView.SortType := stBoth;
     608    FuseCheckBoxes := true;
     609  end;
     610
     611  procedure TfrmOptions.lvwNotificationsChange(Sender: TObject;
     612    Item: TListItem; Change: TItemChange);
     613  // change on/off on checkmark
     614  begin
     615    if (Sender as TListView).ItemIndex = -1 then exit;
     616    if not FuseCheckBoxes then exit;
     617    if (Sender as TListView).Checkboxes = false then exit;
     618  //if (Item.SubItems[1] = 'Mandatory') and not Item.Checked then begin  <-- original line.  //kt 8/8/2007
     619    if (Item.SubItems[1] = DKLangConstW('fOptions_Mandatory')) and not Item.Checked then begin //kt added 8/8/2007
     620      Item.Checked := True;
     621      exit;
     622    end;
     623    if Item.Checked then
    566624    begin
    567       rulenum := Piece(aList[i], '^', 1);
    568       ruletext := Piece(aList[i], '^', 2);
    569       ruleonoff := Piece(aList[i], '^', 3);
    570       rulecomment := Piece(aList[i], '^', 4);
    571       aListItem := aListView.Items.Add;
    572       with aListItem do
     625      if Item.SubItems[0] <> 'On' then
     626        ChangeOnOff(Sender as TListView, Item);
     627      Item.SubItems[0] := 'On';
     628    end
     629    else
     630    begin
     631  //  if Item.SubItems[0] <> 'Off' then  <-- original line.  //kt 8/8/2007
     632      if Item.SubItems[0] <> DKLangConstW('fOptions_Off') then //kt added 8/8/2007
     633        ChangeOnOff(Sender as TListView, Item);
     634  //  Item.SubItems[0] := 'Off';  <-- original line.  //kt 8/8/2007
     635      Item.SubItems[0] := DKLangConstW('fOptions_Off'); //kt added 8/8/2007
     636    end;
     637  end;
     638
     639  procedure TfrmOptions.lvwNotificationsColumnClick(Sender: TObject;
     640    Column: TListColumn);
     641  // toggle sort
     642  begin
     643    if FsortCol = Column.Index then
     644      FsortAscending := not FsortAscending
     645    else
     646      FsortAscending := true;
     647    FsortCol := Column.Index;
     648    (Sender as TListView).AlphaSort;
     649  end;
     650
     651  procedure TfrmOptions.lvwNotificationsCompare(Sender: TObject; Item1,
     652    Item2: TListItem; Data: Integer; var Compare: Integer);
     653  //  sort columns
     654  begin
     655    if not(Sender is TListView) then exit;
     656    if FsortAscending then
     657    begin
     658      if FsortCol = 0 then
     659        Compare := CompareStr(Item1.Caption, Item2.Caption)
     660      else
     661        Compare := CompareStr(Item1.SubItems[FsortCol - 1],
     662          Item2.SubItems[FsortCol - 1]);
     663    end
     664    else
     665    begin
     666      if FsortCol = 0 then
     667        Compare := CompareStr(Item2.Caption, Item1.Caption)
     668      else
     669        Compare := CompareStr(Item2.SubItems[FsortCol - 1],
     670          Item1.SubItems[FsortCol - 1]);
     671    end;
     672  end;
     673
     674  procedure TfrmOptions.lvwNotificationsDblClick(Sender: TObject);
     675  // toggle check marks with double click
     676  var
     677    aListItem: TListItem;
     678  begin
     679    with (Sender as TListView) do
     680    begin
     681      if Checkboxes = false then exit;
     682      if Selected = nil then exit;
     683  //  if Selected.SubItems[1] = 'Mandatory' then exit;  <-- original line.  //kt 8/8/2007
     684      if Selected.SubItems[1] = DKLangConstW('fOptions_Mandatory') then exit; //kt added 8/8/2007
     685      if Selected <> FLastClickedItem then exit;
     686      aListItem := Selected;
     687      aListItem.Checked := not aListItem.Checked;
     688      ChangeOnOff(Sender as TListView, aListItem);
     689
     690      if aListItem.Checked then
     691        aListItem.SubItems[0] := 'On'
     692      else
     693  //    aListItem.SubItems[0] := 'Off';  <-- original line.  //kt 8/8/2007
     694        aListItem.SubItems[0] := DKLangConstW('fOptions_Off'); //kt added 8/8/2007
     695    end;
     696  end;
     697
     698  procedure TfrmOptions.ChangeOnOff(aListView: TListView; aListItem: TListItem);
     699  // check if list items were edited
     700  begin
     701    if aListView = lvwNotifications then FdirtyNotifications := true;
     702    if aListView = lvwOrderChecks then FdirtyOrderChecks := true;
     703    CheckApply;
     704  end;
     705
     706  procedure TfrmOptions.btnSurrogateClick(Sender: TObject);
     707  // display Surrogate Options
     708  var
     709    topsize, leftsize: integer;
     710    surrogateinfo: string;
     711  begin
     712    surrogateinfo := btnSurrogate.Hint;
     713    Offset(topsize, -30, leftsize, -30);
     714    DialogOptionsSurrogate(topsize, leftsize, Font.Size, surrogateinfo);
     715    LabelSurrogate(surrogateinfo, lblNotificationsSurrogateText);
     716    btnSurrogate.Hint := surrogateinfo;
     717  end;
     718
     719  procedure TfrmOptions.btnCombinationsClick(Sender: TObject);
     720  // display Combination List Options
     721  var
     722    topsize, leftsize, value: integer;
     723  begin
     724    value := 0;
     725    Offset(topsize, -60, leftsize, -60);
     726    DialogOptionsCombinations(topsize, leftsize, Font.Size, value);
     727  end;
     728
     729  procedure TfrmOptions.btnNotesNotesClick(Sender: TObject);
     730  // display Notes Options
     731  var
     732    topsize, leftsize, value: integer;
     733  begin
     734    value := 0;
     735    Offset(topsize, -60, leftsize, -60);
     736    DialogOptionsNotes(topsize, leftsize, Font.Size, value);
     737  end;
     738
     739  procedure TfrmOptions.btnNotesTitlesClick(Sender: TObject);
     740  // display Titles Options
     741  var
     742    topsize, leftsize, value: integer;
     743  begin
     744    value := 0;
     745    Offset(topsize, -60, leftsize, -60);
     746    DialogOptionsTitles(topsize, leftsize, Font.Size, value);
     747  end;
     748
     749  procedure TfrmOptions.btnReportsClick(Sender: TObject);
     750  var
     751    topsize, leftsize, value: integer;
     752  begin
     753    value := 0;
     754    Offset(topsize, 90, leftsize, 23);
     755    DialogOptionsHSDefault(topsize, leftsize, Font.Size, value);
     756  end;
     757
     758  procedure TfrmOptions.btnReport1Click(Sender: TObject);
     759  var
     760    topsize, leftsize, value: integer;
     761  begin
     762    value := 0;
     763    Offset(topsize, -18, leftsize, -15);
     764    DialogOptionsHSCustom(topsize, leftsize, Font.Size, value);
     765  end;
     766
     767  procedure TfrmOptions.lvwNotificationsEnter(Sender: TObject);
     768  begin
     769    with Sender as TListView do begin
     770      if (Selected = nil) and (Items.Count > 0) then
     771        Selected := Items[0];
     772    end;
     773  end;
     774
     775  procedure TfrmOptions.lvwNotificationsMouseDown(Sender: TObject;
     776    Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
     777  begin
     778    FLastClickedItem := (Sender as TListView).GetItemAt(X,Y);
     779  end;
     780
     781  procedure TfrmOptions.btnDiagnosesClick(Sender: TObject);
     782  // display Personal Diagnoses List
     783  var
     784    topsize, leftsize, value: integer;
     785  begin
     786    if IsCIDCProvider(User.DUZ) then    //(hds7564)
     787    begin
     788       value := 0;
     789       Offset(topsize, -60, leftsize, -60);
     790       DialogOptionsDiagnoses(topsize, leftsize, Font.Size, value);
     791    end;
     792  end;
     793
     794  procedure TfrmOptions.btnGraphSettingsClick(Sender: TObject);
     795  // display GraphSettings
     796  var
     797    actiontype: boolean;
     798    topsize, leftsize: integer;
     799  begin
     800    actiontype := false;
     801    Offset(topsize, -60, leftsize, -60);
     802    DialogOptionsGraphSettings(topsize, leftsize, Font.Size, actiontype);
     803  end;
     804
     805  procedure TfrmOptions.btnGraphViewsClick(Sender: TObject);
     806  // display Graph Views
     807  var
     808    actiontype: boolean;
     809    topsize, leftsize: integer;
     810  begin
     811    actiontype := false;
     812    Offset(topsize, -60, leftsize, -60);
     813    DialogOptionsGraphProfiles(topsize, leftsize, Font.Size, actiontype);
     814  end;
     815
     816  procedure TfrmOptions.rdoRDVClick(Sender: TObject);
     817  var
     818    iIndex: integer;
     819  begin
     820    iIndex := rdoRDV.ItemIndex;
     821     with frmFrame do
     822     if iIndex = 0 then
    573823      begin
    574         Caption := ruletext;
    575         SubItems.Add(ruleonoff);
    576         if ruleonoff = 'On' then Checked := true;
    577         SubItems.Add(rulecomment);
     824        ChangeVistaWebParam('0');
     825        lblCIRN.Caption := ' Remote';
     826        lblCIRNData.Caption := 'Data';
     827        lblCIRNAvail.Caption := '';
     828        lblCIRN.Width := 43;
     829        lblCIRNData.Width := 43;
     830        lblCIRNData.Alignment := taCenter;
     831        lblCIRN.Alignment := taCenter;
     832        lstCIRNLocations.Clear;
     833        SetUpCIRN;
     834      end
     835    else
     836      begin
     837        ChangeVistaWebParam('1');
     838        lblCIRN.Caption := 'Remote';
     839        lblCIRNData.Caption := 'Data*';  //VistaWeb On
     840        lblCIRN.Width := 43;
     841        lblCIRNData.Width := 43;
     842        lblCIRNData.Alignment := taCenter;
     843        lblCIRN.Alignment := taCenter;
     844        lblCIRN.Enabled     := True;
     845        lblCIRNData.Enabled := True;
     846        pnlCIRN.TabStop     := True;
     847        if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then
     848          begin
     849            lblCIRN.Font.Color  := clBlue;
     850            lblCIRNData.Font.Color  := clBlue;
     851            lblCIRNAvail.Font.Color := clBlue;
     852            lstCIRNLocations.Font.Color  := clBlue;
     853          end
     854        else
     855          begin
     856            lblCIRN.Font.Color  := clWindowText;
     857            lblCIRNData.Font.Color  := clWindowText;
     858            lblCIRNAvail.Font.Color := clWindowText;
     859            lstCIRNLocations.Font.Color  := clWindowText;
     860          end;
    578861      end;
    579       aRule := TRule.Create;
    580       with aRule do
    581       begin
    582         IEN := rulenum;
    583         OriginalValue := ruleonoff;
    584         ItemText := ruletext;
    585       end;
    586 //    aListItem.SubItems.AddObject('rule object', aRule);  <-- original line.  //kt 8/8/2007
    587       aListItem.SubItems.AddObject(DKLangConstW('fOptions_rule_object'), aRule); //kt added 8/8/2007
    588     end;
    589   end;
    590   aListView.SortType := stBoth;
    591   FuseCheckBoxes := true;
    592 end;
    593 
    594 procedure TfrmOptions.lvwNotificationsChange(Sender: TObject;
    595   Item: TListItem; Change: TItemChange);
    596 // change on/off on checkmark
    597 begin
    598   if (Sender as TListView).ItemIndex = -1 then exit;
    599   if not FuseCheckBoxes then exit;
    600   if (Sender as TListView).Checkboxes = false then exit;
    601 //if (Item.SubItems[1] = 'Mandatory') and not Item.Checked then begin  <-- original line.  //kt 8/8/2007
    602   if (Item.SubItems[1] = DKLangConstW('fOptions_Mandatory')) and not Item.Checked then begin //kt added 8/8/2007
    603     Item.Checked := True;
    604     exit;
    605   end;
    606   if Item.Checked then
    607   begin
    608     if Item.SubItems[0] <> 'On' then
    609       ChangeOnOff(Sender as TListView, Item);
    610     Item.SubItems[0] := 'On';
    611   end
    612   else
    613   begin
    614 //  if Item.SubItems[0] <> 'Off' then  <-- original line.  //kt 8/8/2007
    615     if Item.SubItems[0] <> DKLangConstW('fOptions_Off') then //kt added 8/8/2007
    616       ChangeOnOff(Sender as TListView, Item);
    617 //  Item.SubItems[0] := 'Off';  <-- original line.  //kt 8/8/2007
    618     Item.SubItems[0] := DKLangConstW('fOptions_Off'); //kt added 8/8/2007
    619   end;
    620 end;
    621 
    622 procedure TfrmOptions.lvwNotificationsColumnClick(Sender: TObject;
    623   Column: TListColumn);
    624 // toggle sort
    625 begin
    626   if FsortCol = Column.Index then
    627     FsortAscending := not FsortAscending
    628   else
    629     FsortAscending := true;
    630   FsortCol := Column.Index;
    631   (Sender as TListView).AlphaSort;
    632 end;
    633 
    634 procedure TfrmOptions.lvwNotificationsCompare(Sender: TObject; Item1,
    635   Item2: TListItem; Data: Integer; var Compare: Integer);
    636 //  sort columns
    637 begin
    638   if not(Sender is TListView) then exit;
    639   if FsortAscending then
    640   begin
    641     if FsortCol = 0 then
    642       Compare := CompareStr(Item1.Caption, Item2.Caption)
    643     else
    644       Compare := CompareStr(Item1.SubItems[FsortCol - 1],
    645         Item2.SubItems[FsortCol - 1]);
    646   end
    647   else
    648   begin
    649     if FsortCol = 0 then
    650       Compare := CompareStr(Item2.Caption, Item1.Caption)
    651     else
    652       Compare := CompareStr(Item2.SubItems[FsortCol - 1],
    653         Item1.SubItems[FsortCol - 1]);
    654   end;
    655 end;
    656 
    657 procedure TfrmOptions.lvwNotificationsDblClick(Sender: TObject);
    658 // toggle check marks with double click
    659 var
    660   aListItem: TListItem;
    661 begin
    662   with (Sender as TListView) do
    663   begin
    664     if Checkboxes = false then exit;
    665     if Selected = nil then exit;
    666 //  if Selected.SubItems[1] = 'Mandatory' then exit;  <-- original line.  //kt 8/8/2007
    667     if Selected.SubItems[1] = DKLangConstW('fOptions_Mandatory') then exit; //kt added 8/8/2007
    668     if Selected <> FLastClickedItem then exit;
    669     aListItem := Selected;
    670     aListItem.Checked := not aListItem.Checked;
    671     ChangeOnOff(Sender as TListView, aListItem);
    672 
    673     if aListItem.Checked then
    674       aListItem.SubItems[0] := 'On'
    675     else
    676 //    aListItem.SubItems[0] := 'Off';  <-- original line.  //kt 8/8/2007
    677       aListItem.SubItems[0] := DKLangConstW('fOptions_Off'); //kt added 8/8/2007
    678   end;
    679 end;
    680 
    681 procedure TfrmOptions.ChangeOnOff(aListView: TListView; aListItem: TListItem);
    682 // check if list items were edited
    683 begin
    684   if aListView = lvwNotifications then FdirtyNotifications := true;
    685   if aListView = lvwOrderChecks then FdirtyOrderChecks := true;
    686   CheckApply;
    687 end;
    688 
    689 procedure TfrmOptions.btnSurrogateClick(Sender: TObject);
    690 // display Surrogate Options
    691 var
    692   topsize, leftsize: integer;
    693   surrogateinfo: string;
    694 begin
    695   surrogateinfo := btnSurrogate.Hint;
    696   Offset(topsize, -30, leftsize, -30);
    697   DialogOptionsSurrogate(topsize, leftsize, Font.Size, surrogateinfo);
    698   LabelSurrogate(surrogateinfo, lblNotificationsSurrogateText);
    699   btnSurrogate.Hint := surrogateinfo;
    700 end;
    701 
    702 procedure TfrmOptions.btnCombinationsClick(Sender: TObject);
    703 // display Combination List Options
    704 var
    705   topsize, leftsize, value: integer;
    706 begin
    707   value := 0;
    708   Offset(topsize, -60, leftsize, -60);
    709   DialogOptionsCombinations(topsize, leftsize, Font.Size, value);
    710 end;
    711 
    712 procedure TfrmOptions.btnNotesNotesClick(Sender: TObject);
    713 // display Notes Options
    714 var
    715   topsize, leftsize, value: integer;
    716 begin
    717   value := 0;
    718   Offset(topsize, -60, leftsize, -60);
    719   DialogOptionsNotes(topsize, leftsize, Font.Size, value);
    720 end;
    721 
    722 procedure TfrmOptions.btnNotesTitlesClick(Sender: TObject);
    723 // display Titles Options
    724 var
    725   topsize, leftsize, value: integer;
    726 begin
    727   value := 0;
    728   Offset(topsize, -60, leftsize, -60);
    729   DialogOptionsTitles(topsize, leftsize, Font.Size, value);
    730 end;
    731 
    732 procedure TfrmOptions.btnReportsClick(Sender: TObject);
    733 var
    734   topsize, leftsize, value: integer;
    735 begin
    736   value := 0;
    737   Offset(topsize, 90, leftsize, 23);
    738   DialogOptionsHSDefault(topsize, leftsize, Font.Size, value);
    739 end;
    740 
    741 procedure TfrmOptions.btnReport1Click(Sender: TObject);
    742 var
    743   topsize, leftsize, value: integer;
    744 begin
    745   value := 0;
    746   Offset(topsize, -18, leftsize, -15);
    747   DialogOptionsHSCustom(topsize, leftsize, Font.Size, value);
    748 end;
    749 
    750 procedure TfrmOptions.lvwNotificationsEnter(Sender: TObject);
    751 begin
    752   with Sender as TListView do begin
    753     if (Selected = nil) and (Items.Count > 0) then
    754       Selected := Items[0];
    755   end;
    756 end;
    757 
    758 procedure TfrmOptions.lvwNotificationsMouseDown(Sender: TObject;
    759   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    760 begin
    761   FLastClickedItem := (Sender as TListView).GetItemAt(X,Y);
    762 end;
    763 
    764 procedure TfrmOptions.btnDiagnosesClick(Sender: TObject);
    765 // display Personal Diagnoses List
    766 var
    767   topsize, leftsize, value: integer;
    768 begin
    769   if IsCIDCProvider(User.DUZ) then    //(hds7564)
    770   begin
    771      value := 0;
    772      Offset(topsize, -60, leftsize, -60);
    773      DialogOptionsDiagnoses(topsize, leftsize, Font.Size, value);
    774   end;
    775 end;
    776 
    777 procedure TfrmOptions.btnGraphSettingsClick(Sender: TObject);
    778 // display GraphSettings
    779 var
    780   actiontype: boolean;
    781   topsize, leftsize: integer;
    782 begin
    783   actiontype := false;
    784   Offset(topsize, -60, leftsize, -60);
    785   DialogOptionsGraphSettings(topsize, leftsize, Font.Size, actiontype);
    786 end;
    787 
    788 procedure TfrmOptions.btnGraphViewsClick(Sender: TObject);
    789 // display Graph Views
    790 var
    791   actiontype: boolean;
    792   topsize, leftsize: integer;
    793 begin
    794   actiontype := false;
    795   Offset(topsize, -60, leftsize, -60);
    796   DialogOptionsGraphProfiles(topsize, leftsize, Font.Size, actiontype);
    797 end;
    798 
    799 procedure TfrmOptions.rdoRDVClick(Sender: TObject);
    800 var
    801   iIndex: integer;
    802 begin
    803   iIndex := rdoRDV.ItemIndex;
    804    with frmFrame do
    805    if iIndex = 0 then
     862
     863  end;
     864
     865  procedure TfrmOptions.cbLanguageChange(Sender: TObject);  //kt added 6/29/07
     866  var iIndex: Integer;
     867  CPRSChartINI: TINIFile;
     868  begin
     869    iIndex := cbLanguage.ItemIndex;
     870    if iIndex<0 then iIndex := 0; // When there's no valid selection in cbLanguage we use the default language (Index=0)
     871    try
     872      LangManager.LanguageID := LangManager.LanguageIDs[iIndex];
     873    except
     874      on EReadError do begin
     875        //do nothing.  Ignore error.
     876      end
     877    end;
     878    frmFrame.Caption := TX_IN_USE + MixedCase(User.Name) + '  (' + RPCBrokerV.Server + ')';  //kt added
     879    frmFrame.RenameTabs;  //Resets names of tabs to correct translation  //kt
     880    frmFrame.mnuFileRefreshClick(self); //elh 6/23/08
     881    CPRSChartINI := TINIFile.Create(ExtractFilePath(ParamStr(0)) + 'CPRSChart.ini');  // Write to INI  elh  6/23/08
     882    CPRSChartINI.WriteInteger('Options','Language',LangManager.LanguageID);
     883    CPRSChartINI.Free;
     884  end;
     885
     886  procedure TfrmOptions.Button1Click(Sender: TObject);
     887  begin
     888    MessageDlg('For a given language to be available, a *.lng (e.g. spanish.lng) '+
     889               'must be in the same directory as CPRSchart.exe.  This *.lng file '+
     890               'may be created at any time by users by working with the CPRSchart.dklng '+
     891               'file with the free language editor found at:  '+
     892               'http://www.dk-soft.org/products/dklang/',mtInformation,[mbOK],0);
     893  end;
     894
     895  procedure TfrmOptions.btnApplySkinClick(Sender: TObject);   //kt added
     896  var fileS : String;
     897  begin
     898    {$IFDEF USE_SKINS}
     899    fileS := '';
     900    if lbSkins.ItemIndex > -1 then fileS := lbSkins.Items [lbSkins.ItemIndex];
     901    frmFrame.CurrentSkinFile := 'TMG_Extra\Skins\' +fileS;
     902    frmFrame.ActivateCurrentSkin;
     903    {$ELSE}
     904    MessageDlg('Use of skins has been disabled at compile time.',mtInformation,[mbOK],0);
     905    {$ENDIF}
     906  end;
     907
     908  procedure TfrmOptions.btnMoreSkinsClick(Sender: TObject);    //kt added
     909  begin
     910    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);
     911  end;
     912
     913  procedure TfrmOptions.FillSkinList;  //kt added
     914  var
     915    SRec : TSearchRec;
     916    R : Integer;
     917  begin
     918    lbSkins.Items.Clear;
     919    R := FindFirst (ExtractFilePath (Application.ExeName) + 'TMG_Extra\Skins\*.ipz', faAnyFile, SRec);
     920    while R = 0 do
    806921    begin
    807       ChangeVistaWebParam('0');
    808       lblCIRN.Caption := ' Remote';
    809       lblCIRNData.Caption := 'Data';
    810       lblCIRNAvail.Caption := '';
    811       lblCIRN.Width := 43;
    812       lblCIRNData.Width := 43;
    813       lblCIRNData.Alignment := taCenter;
    814       lblCIRN.Alignment := taCenter;
    815       lstCIRNLocations.Clear;
    816       SetUpCIRN;
    817     end
    818   else
    819     begin
    820       ChangeVistaWebParam('1');
    821       lblCIRN.Caption := 'Remote';
    822       lblCIRNData.Caption := 'Data*';  //VistaWeb On
    823       lblCIRN.Width := 43;
    824       lblCIRNData.Width := 43;
    825       lblCIRNData.Alignment := taCenter;
    826       lblCIRN.Alignment := taCenter;
    827       lblCIRN.Enabled     := True;
    828       lblCIRNData.Enabled := True;
    829       pnlCIRN.TabStop     := True;
    830       if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then
    831         begin
    832           lblCIRN.Font.Color  := clBlue;
    833           lblCIRNData.Font.Color  := clBlue;
    834           lblCIRNAvail.Font.Color := clBlue;
    835           lstCIRNLocations.Font.Color  := clBlue;
    836         end
    837       else
    838         begin
    839           lblCIRN.Font.Color  := clWindowText;
    840           lblCIRNData.Font.Color  := clWindowText;
    841           lblCIRNAvail.Font.Color := clWindowText;
    842           lstCIRNLocations.Font.Color  := clWindowText;
    843         end;
    844     end;
    845 
    846 end;
    847 
    848 procedure TfrmOptions.cbLanguageChange(Sender: TObject);  //kt added 6/29/07
    849 var iIndex: Integer;
    850 CPRSChartINI: TINIFile;
    851 begin
    852   iIndex := cbLanguage.ItemIndex;
    853   if iIndex<0 then iIndex := 0; // When there's no valid selection in cbLanguage we use the default language (Index=0)
    854   try
    855     LangManager.LanguageID := LangManager.LanguageIDs[iIndex];
    856   except
    857     on EReadError do begin
    858       //do nothing.  Ignore error.
    859     end
    860   end;
    861   frmFrame.Caption := TX_IN_USE + MixedCase(User.Name) + '  (' + RPCBrokerV.Server + ')';  //kt added
    862   frmFrame.RenameTabs;  //Resets names of tabs to correct translation  //kt
    863   frmFrame.mnuFileRefreshClick(self); //elh 6/23/08
    864   CPRSChartINI := TINIFile.Create(ExtractFilePath(ParamStr(0)) + 'CPRSChart.ini');  // Write to INI  elh  6/23/08
    865   CPRSChartINI.WriteInteger('Options','Language',LangManager.LanguageID);
    866   CPRSChartINI.Free;
    867 
    868 end;
    869 
    870 procedure TfrmOptions.Button1Click(Sender: TObject);
    871 begin
    872   MessageDlg('For a given language to be available, a *.lng (e.g. spanish.lng) '+
    873              'must be in the same directory as CPRSchart.exe.  This *.lng file '+
    874              'may be created at any time by users by working with the CPRSchart.dklng '+
    875              'file with the free language editor found at:  '+
    876              'http://www.dk-soft.org/products/dklang/',mtInformation,[mbOK],0);
    877 end;
     922      lbSkins.Items.Add (SRec.Name);
     923      R := FindNext (SRec);
     924    end;
     925    lbSkins.Sorted := true;
     926    lbSkins.ItemIndex := 0;
     927  end;
     928
     929  procedure TfrmOptions.FormShow(Sender: TObject);  //kt added
     930  begin
     931    FillSkinList;
     932  end;
     933
     934  procedure TfrmOptions.lbSkinsKeyPress(Sender: TObject; var Key: Char); //kt added
     935  begin
     936    if Key = #13 then btnApplySkinClick (Self);
     937  end;
     938
     939  procedure TfrmOptions.btnDisableSkinClick(Sender: TObject); //kt added
     940  begin
     941    frmFrame.InactivateSkin;
     942  end;
    878943
    879944end.
Note: See TracChangeset for help on using the changeset viewer.