Ignore:
Timestamp:
Jul 7, 2010, 4:31:10 PM (14 years ago)
Author:
Kevin Toppenberg
Message:

Upgrade to version 27

Location:
cprs/trunk/CPRS-Chart/Templates
Files:
2 added
21 edited

Legend:

Unmodified
Added
Removed

  • cprs/trunk/CPRS-Chart/Templates/fTemplateAutoGen.dfm

    r456 r829  
    1 object frmTemplateAutoGen: TfrmTemplateAutoGen
     1inherited frmTemplateAutoGen: TfrmTemplateAutoGen
    22  Left = 361
    33  Top = 230
    … …  
    88  ClientHeight = 213
    99  ClientWidth = 415
    10   Color = clBtnFace
    11   Font.Charset = DEFAULT_CHARSET
    12   Font.Color = clWindowText
    13   Font.Height = -11
    14   Font.Name = 'MS Sans Serif'
    15   Font.Style = []
    16   OldCreateOrder = False
    1710  Position = poScreenCenter
    1811  OnShow = FormShow
    1912  PixelsPerInch = 96
    2013  TextHeight = 13
    21   object lblTop: TMemo
     14  object lblTop: TMemo [0]
    2215    Left = 256
    2316    Top = 8
    … …  
    3528    TabOrder = 5
    3629  end
    37   object lblSelect: TStaticText
     30  object lblSelect: TStaticText [1]
    3831    Left = 0
    3932    Top = 0
    … …  
    4639    TabOrder = 6
    4740  end
    48   object rgSource: TKeyClickRadioGroup
     41  object rgSource: TKeyClickRadioGroup [2]
    4942    Left = 256
    5043    Top = 88
    … …  
    5952    OnClick = rgSourceClick
    6053  end
    61   object cbxObjects: TORComboBox
     54  object cbxObjects: TORComboBox [3]
    6255    Left = 0
    6356    Top = 0
    … …  
    7467    ListItemsOnly = False
    7568    LongList = False
     69    LookupPiece = 0
    7670    MaxLength = 0
    7771    Pieces = '1'
    … …  
    8175    Visible = False
    8276    OnDblClick = cbxObjectsDblClick
     77    CharsNeedMatch = 1
    8378  end
    84   object btnOK: TButton
     79  object btnOK: TButton [4]
    8580    Left = 257
    8681    Top = 190
    … …  
    9287    TabOrder = 3
    9388  end
    94   object btnCancel: TButton
     89  object btnCancel: TButton [5]
    9590    Left = 337
    9691    Top = 190
    … …  
    10297    TabOrder = 4
    10398  end
    104   object cbxTitles: TORComboBox
     99  object cbxTitles: TORComboBox [6]
    105100    Left = 0
    106101    Top = 0
    … …  
    117112    ListItemsOnly = True
    118113    LongList = True
     114    LookupPiece = 0
    119115    MaxLength = 0
    120116    Pieces = '2'
    … …  
    125121    OnDblClick = cbxTitlesDblClick
    126122    OnNeedData = cbxTitlesNeedData
     123    CharsNeedMatch = 1
     124  end
     125  inherited amgrMain: TVA508AccessibilityManager
     126    Data = (
     127      (
     128        'Component = lblTop'
     129        'Status = stsDefault')
     130      (
     131        'Component = lblSelect'
     132        'Status = stsDefault')
     133      (
     134        'Component = rgSource'
     135        'Status = stsDefault')
     136      (
     137        'Component = cbxObjects'
     138        'Status = stsDefault')
     139      (
     140        'Component = btnOK'
     141        'Status = stsDefault')
     142      (
     143        'Component = btnCancel'
     144        'Status = stsDefault')
     145      (
     146        'Component = cbxTitles'
     147        'Status = stsDefault')
     148      (
     149        'Component = frmTemplateAutoGen'
     150        'Status = stsDefault'))
    127151  end
    128152end

  • cprs/trunk/CPRS-Chart/Templates/fTemplateAutoGen.pas

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   StdCtrls, ORCtrls, ExtCtrls, ORFn;
     7  StdCtrls, ORCtrls, ExtCtrls, ORFn, fBase508Form, VA508AccessibilityManager;
    88
    99type
    10   TfrmTemplateAutoGen = class(TForm)
     10  TfrmTemplateAutoGen = class(TfrmBase508Form)
    1111    rgSource: TKeyClickRadioGroup;
    1212    cbxObjects: TORComboBox;
    … …  
    121121          end;
    122122      if DoIt then
    123         cbxObjects.Items.Assign(dmodShared.TIUObjects);
     123        FastAssign(dmodShared.TIUObjects, cbxObjects.Items);
    124124      FObjectsDone := TRUE;
    125125    end;

  • cprs/trunk/CPRS-Chart/Templates/fTemplateDialog.dfm

    r456 r829  
    1 object frmTemplateDialog: TfrmTemplateDialog
     1inherited frmTemplateDialog: TfrmTemplateDialog
    22  Left = 268
    33  Top = 155
    4   Width = 640
    5   Height = 440
    64  BorderIcons = [biSystemMenu, biMaximize]
    75  Caption = 'Text Dialog'
    8   Color = clBtnFace
    9   Font.Charset = DEFAULT_CHARSET
    10   Font.Color = clWindowText
    11   Font.Height = -11
    12   Font.Name = 'MS Sans Serif'
    13   Font.Style = []
    14   OldCreateOrder = False
     6  ClientHeight = 413
     7  ClientWidth = 632
    158  Position = poScreenCenter
    169  OnClose = FormClose
    … …  
    1912  OnDestroy = FormDestroy
    2013  OnPaint = FormPaint
     14  OnShow = FormShow
     15  ExplicitWidth = 640
     16  ExplicitHeight = 440
    2117  PixelsPerInch = 96
    2218  TextHeight = 13
    23   object sbMain: TScrollBox
     19  object sbMain: TScrollBox [0]
    2420    Left = 0
    2521    Top = 0
    … …  
    3632    TabOrder = 0
    3733  end
    38   object pnlBottom: TScrollBox
     34  object pnlBottom: TScrollBox [1]
    3935    Left = 0
    4036    Top = 375
    … …  
    10096    end
    10197  end
     98  inherited amgrMain: TVA508AccessibilityManager
     99    Data = (
     100      (
     101        'Component = sbMain'
     102        'Status = stsDefault')
     103      (
     104        'Component = pnlBottom'
     105        'Status = stsDefault')
     106      (
     107        'Component = lblFootnote'
     108        'Status = stsDefault')
     109      (
     110        'Component = btnCancel'
     111        'Status = stsDefault')
     112      (
     113        'Component = btnOK'
     114        'Status = stsDefault')
     115      (
     116        'Component = btnAll'
     117        'Status = stsDefault')
     118      (
     119        'Component = btnNone'
     120        'Status = stsDefault')
     121      (
     122        'Component = btnPreview'
     123        'Status = stsDefault')
     124      (
     125        'Component = frmTemplateDialog'
     126        'Status = stsDefault'))
     127  end
    102128end

  • cprs/trunk/CPRS-Chart/Templates/fTemplateDialog.pas

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   StdCtrls, ExtCtrls, ORCtrls, ORFn, AppEvnts, uTemplates;
     7  StdCtrls, ExtCtrls, ORCtrls, ORFn, AppEvnts, uTemplates, fBase508Form, uConst,
     8  VA508AccessibilityManager;
    89
    910type
    10   TfrmTemplateDialog = class(TForm)
     11  TfrmTemplateDialog = class(TfrmBase508Form)
    1112    sbMain: TScrollBox;
    1213    pnlBottom: TScrollBox;
    … …  
    2627    procedure btnPreviewClick(Sender: TObject);
    2728    procedure FormClose(Sender: TObject; var Action: TCloseAction);
     29    procedure FormShow(Sender: TObject);
    2830  private
     31    FFirstBuild: boolean;
    2932    SL: TStrings;
    3033    BuildIdx: TStringList;
    … …  
    5760    procedure ParentCBEnter(Sender: TObject);
    5861    procedure ParentCBExit(Sender: TObject);
     62    procedure UMScreenReaderInit(var Message: TMessage); message UM_MISC;
     63    procedure InitScreenReaderSetup;
    5964  public
    6065    property Silent: boolean read FSilent write FSilent ;
    … …  
    7277implementation
    7378
    74 uses dShared, uConst, uTemplateFields, fRptBox, uInit, rMisc;
     79uses dShared, uTemplateFields, fRptBox, uInit, rMisc, uDlgComponents,
     80  VA508AccessibilityRouter, VAUtils;
    7581
    7682{$R *.DFM}
    … …  
    187193  Result := FALSE;
    188194  CancelDlg := FALSE;
     195  SetTemplateDialogCanceled(FALSE);
    189196  frmTemplateDialog := TfrmTemplateDialog.Create(Application);
    190197  try
    … …  
    272279  end;
    273280
    274   if not Result then
     281  if Result then
     282    SetTemplateDialogCanceled(TRUE)
     283  else
     284  begin
     285    SetTemplateDialogCanceled(FALSE);
    275286    CheckBoilerplate4Fields(SL, CaptionText, PreviewMode);
    276 
     287  end;
     288 
    277289end;
    278290
    … …  
    289301      SL.Clear;
    290302  end;
     303  StripScreenReaderCodes(SL);
    291304end;
    292305
    … …  
    380393end;
    381394
     395procedure TfrmTemplateDialog.InitScreenReaderSetup;
     396var
     397  ctrl: TWinControl;
     398  list: TList;
     399begin
     400  if ScreenReaderSystemActive then
     401  begin
     402    list := TList.Create;
     403    try
     404      sbMain.GetTabOrderList(list);
     405      if list.Count > 0 then
     406      begin
     407        ctrl := TWinControl(list[0]);
     408        PostMessage(Handle, UM_MISC, WParam(ctrl), 0);
     409      end;
     410    finally
     411      list.free;
     412    end;
     413  end;
     414end;
     415
    382416function TfrmTemplateDialog.IsAncestor( OldID: string; NewID: string): boolean;
    383417begin
    … …  
    398432  KillCtrl, doHint, dsp, noTextParent: boolean;
    399433  Entry: TTemplateDialogEntry;
    400   StringIn, StringOut: string;
     434//  StringIn, StringOut: string;
     435  cb: TCPRSDialogParentCheckBox;
    401436
    402437  procedure NextTabCtrl(ACtrl: TControl);
    … …  
    511546      Entry := TTemplateDialogEntry(Entries.Objects[idx]);
    512547
    513     pnl := Entry.GetPanel(FMaxPnlWidth, sbMain);
     548    if(dsp or OneOnly) then
     549      cb := nil
     550    else
     551      cb := TCPRSDialogParentCheckBox.Create(Self);
     552
     553    pnl := Entry.GetPanel(FMaxPnlWidth, sbMain, cb);
    514554    pnl.Show;
    515555    if(doHint and (not pnl.ShowHint)) then
    … …  
    521561      Entry.OnChange := FieldChanged;
    522562    end;
    523     if(dsp or OneOnly) then
     563    if not assigned(cb) then
    524564      ctrl := pnl
    525565    else
    526566    begin
    527       ctrl := TORCheckBox.Create(Self);
     567      ctrl := cb;
    528568      ctrl.Parent := sbMain;
    529569
    … …  
    539579      TORCheckBox(ctrl).AutoSize := false;
    540580      TORCheckBox(ctrl).Associate := pnl;
     581      pnl.Tag := Integer(ctrl);
    541582      tmpID := copy(ID, 1, (pos('.', ID) - 1)); {copy the ID without the decimal place}
    542       if Templates.IndexOf(tmpID) > -1 then
    543         StringIn := 'Sub-Template: ' + TTemplate(Templates.Objects[Templates.IndexOf(tmpID)]).PrintName
    544       else
    545         StringIn := 'Sub-Template:';
    546       StringOut := StringReplace(StringIn, '&', '&&', [rfReplaceAll]);
    547       TORCheckBox(ctrl).Caption := StringOut;
     583//      if Templates.IndexOf(tmpID) > -1 then
     584//        StringIn := 'Sub-Template: ' + TTemplate(Templates.Objects[Templates.IndexOf(tmpID)]).PrintName
     585//      else
     586//        StringIn := 'Sub-Template:';
     587//      StringOut := StringReplace(StringIn, '&', '&&', [rfReplaceAll]);
     588//      TORCheckBox(ctrl).Caption := StringOut;
     589      UpdateColorsFor508Compliance(ctrl);
    548590
    549591    end;
    … …  
    615657    for i := 1 to Count do
    616658      BuildCB(i, Y, FirstTime);
     659    if ScreenReaderSystemActive then
     660    begin
     661      amgrMain.RefreshComponents;
     662      Application.ProcessMessages;
     663    end;
    617664  finally
    618665    FBuilding := FALSE;
    … …  
    626673    RepaintBuild := FALSE;
    627674    BuildAllControls;
     675    InitScreenReaderSetup;
     676  end;
     677end;
     678
     679procedure TfrmTemplateDialog.FormShow(Sender: TObject);
     680begin
     681  inherited;
     682  if FFirstBuild then
     683  begin
     684    FFirstBuild := FALSE;
     685    InitScreenReaderSetup;
    628686  end;
    629687end;
    … …  
    631689procedure TfrmTemplateDialog.FormCreate(Sender: TObject);
    632690begin
     691  FFirstBuild := TRUE;
    633692  BuildIdx := TStringList.Create;
    634693  Entries := TStringList.Create;
    … …  
    700759      if not CanClose then
    701760      begin
    702         ShowMessage(MissingFieldsTxt);
     761        ShowMsg(MissingFieldsTxt);
    703762        break;
    704763      end;
    … …  
    719778  TmpSL := TStringList.Create;
    720779  try
    721     TmpSL.Assign(SL);
     780    FastAssign(SL, TmpSL);
    722781    GetText(TmpSL, FALSE);  {FALSE = Do not include embedded fields}
     782    StripScreenReaderCodes(TmpSL);
    723783    ReportBox(TmpSL, 'Dialog Preview', FALSE);
    724784  finally
    … …  
    755815end;
    756816
     817procedure TfrmTemplateDialog.UMScreenReaderInit(var Message: TMessage);
     818var
     819  ctrl: TWinControl;
     820  item: TVA508AccessibilityItem;
     821begin
     822  ctrl := TWinControl(Message.WParam);
     823  // Refresh the accessibility manager entry -
     824  // fixes bug where first focusable check boxes weren't working correctly 
     825  if ctrl is TCPRSDialogParentCheckBox then
     826  begin
     827    item := amgrMain.AccessData.FindItem(ctrl, FALSE);
     828    if assigned(item) then
     829      item.free;
     830    amgrMain.AccessData.EnsureItemExists(ctrl);
     831  end;
     832end;
     833
    757834end.
    758835

  • cprs/trunk/CPRS-Chart/Templates/fTemplateEditor.dfm

    r456 r829  
    1 object frmTemplateEditor: TfrmTemplateEditor
    2   Left = 135
    3   Top = 239
    4   Width = 748
    5   Height = 470
     1inherited frmTemplateEditor: TfrmTemplateEditor
     2  Left = 321
     3  Top = 119
    64  HelpContext = 10000
    75  ActiveControl = tvPersonal
    86  BorderIcons = [biSystemMenu, biMaximize]
    97  Caption = 'Template Editor'
    10   Color = clBtnFace
    11   Font.Charset = DEFAULT_CHARSET
    12   Font.Color = clWindowText
    13   Font.Height = -11
    14   Font.Name = 'MS Sans Serif'
    15   Font.Style = []
    16   OldCreateOrder = False
     8  ClientHeight = 450
     9  ClientWidth = 740
    1710  Position = poScreenCenter
    1811  Scaled = False
     12  OnClose = FormClose
    1913  OnCloseQuery = FormCloseQuery
    2014  OnCreate = FormCreate
    2115  OnDestroy = FormDestroy
    2216  OnShow = FormShow
     17  ExplicitWidth = 748
     18  ExplicitHeight = 477
    2319  PixelsPerInch = 96
    2420  TextHeight = 13
    25   object splMain: TSplitter
     21  object splMain: TSplitter [0]
    2622    Left = 0
    2723    Top = 239
    … …  
    3531    OnMoved = splMainMoved
    3632  end
    37   object splNotes: TSplitter
     33  object splNotes: TSplitter [1]
    3834    Left = 0
    39     Top = 371
     35    Top = 377
    4036    Width = 740
    4137    Height = 3
    … …  
    4642    Visible = False
    4743    OnMoved = splBoilMoved
     44    ExplicitTop = 371
    4845  end
    49   object pnlBottom: TORAutoPanel
     46  object pnlBottom: TPanel [2]
    5047    Left = 0
    51     Top = 416
     48    Top = 423
    5249    Width = 740
    5350    Height = 27
    … …  
    5552    BevelOuter = bvNone
    5653    TabOrder = 4
     54    ExplicitTop = 416
    5755    DesignSize = (
    5856      740
    … …  
    130128    end
    131129  end
    132   object pnlBoilerplate: TPanel
     130  object pnlBoilerplate: TPanel [3]
    133131    Left = 0
    134132    Top = 284
    135133    Width = 740
    136     Height = 87
     134    Height = 93
    137135    Align = alClient
    138136    BevelOuter = bvNone
    … …  
    142140    object splBoil: TSplitter
    143141      Left = 0
    144       Top = 43
     142      Top = 14
    145143      Width = 740
    146144      Height = 3
    147145      Cursor = crVSplit
    148       Align = alBottom
     146      Align = alTop
    149147      AutoSnap = False
    150148      Beveled = True
    151149      Visible = False
    152150      OnMoved = splBoilMoved
     151      ExplicitTop = 43
    153152    end
    154153    object reBoil: TRichEdit
    155154      Left = 0
    156       Top = 14
     155      Top = 17
    157156      Width = 740
    158       Height = 29
     157      Height = 30
    159158      Align = alClient
    160159      Font.Charset = ANSI_CHARSET
    … …  
    163162      Font.Name = 'Courier New'
    164163      Font.Style = []
     164      Constraints.MinHeight = 30
    165165      ParentFont = False
    166166      PlainText = True
    … …  
    175175      OnResizeRequest = reResizeRequest
    176176      OnSelectionChange = reBoilSelectionChange
     177      ExplicitTop = 14
    177178    end
    178179    object pnlGroupBP: TPanel
    179180      Left = 0
    180       Top = 46
     181      Top = 47
    181182      Width = 740
    182       Height = 41
     183      Height = 46
    183184      Align = alBottom
    184185      BevelOuter = bvNone
    … …  
    192193        Align = alTop
    193194        Caption = 'Group Boilerplate'
     195        ExplicitWidth = 81
    194196      end
    195197      object lblGroupRow: TLabel
    … …  
    211213        Top = 16
    212214        Width = 740
    213         Height = 25
     215        Height = 30
    214216        Align = alClient
    215217        Color = clCream
    … …  
    219221        Font.Name = 'Courier New'
    220222        Font.Style = []
     223        Constraints.MinHeight = 30
    221224        ParentFont = False
    222225        PlainText = True
    … …  
    281284    end
    282285  end
    283   object pnlTop: TPanel
     286  object pnlTop: TPanel [4]
    284287    Left = 0
    285288    Top = 0
    … …  
    293296      Left = 297
    294297      Top = 24
    295       Width = 3
    296298      Height = 215
    297       Cursor = crHSplit
    298299      Align = alRight
    299300      AutoSnap = False
    … …  
    319320        Left = 216
    320321        Top = 0
    321         Width = 3
    322322        Height = 215
    323         Cursor = crHSplit
    324323        Align = alRight
    325324        AutoSnap = False
    … …  
    428427          FocusControl = tvPersonal
    429428          PopupMenu = popTemplates
     429          ExplicitWidth = 93
    430430        end
    431431        object tvPersonal: TORTreeView
    … …  
    716716            ShowHint = True
    717717            TabOrder = 5
     718            WordWrap = True
    718719            OnClick = cbExcludeClick
    719             WordWrap = True
    720720            AutoSize = True
    721721          end
    … …  
    760760              'erplate, between each item'#39's boilerplate.'
    761761            Associate = edtGap
    762             Min = 0
    763762            Max = 3
    764763            ParentShowHint = False
    765             Position = 0
    766764            ShowHint = True
    767765            TabOrder = 8
    768             Wrap = False
    769766          end
    770767          object edtName: TCaptionEdit
    … …  
    871868            ShowHint = True
    872869            TabOrder = 4
     870            WordWrap = True
    873871            OnClick = cbHideItemsClick
    874             WordWrap = True
    875872            AutoSize = True
    876873          end
    … …  
    913910            TabOrder = 2
    914911            OnChange = cbxRemDlgsChange
     912            CharsNeedMatch = 1
    915913          end
    916914          object cbLock: TORCheckBox
    … …  
    943941        FocusControl = tvShared
    944942        PopupMenu = popTemplates
     943        ExplicitWidth = 86
    945944      end
    946945      object tvShared: TORTreeView
    … …  
    11881187        OnChange = cboOwnerChange
    11891188        OnNeedData = cboOwnerNeedData
     1189        CharsNeedMatch = 1
    11901190      end
    11911191      object btnNew: TORAlignButton
    … …  
    11941194        Width = 182
    11951195        Height = 22
     1196        Align = alRight
    11961197        Caption = '&New Template'
    11971198        TabOrder = 2
    11981199        OnClick = btnNewClick
    1199         Align = alRight
    12001200      end
    12011201      object pnlMenu: TPanel
    … …  
    12121212          Left = 1
    12131213          Top = 1
    1214           Width = 69
     1214          Width = 107
    12151215          Height = 20
    12161216          Align = alLeft
    … …  
    12191219          ButtonWidth = 43
    12201220          Caption = 'mbMain'
    1221           Flat = True
    12221221          Menu = mnuMain
    12231222          ShowCaptions = True
    … …  
    12281227    end
    12291228  end
    1230   object pnlNotes: TPanel
     1229  object pnlNotes: TPanel [5]
    12311230    Left = 0
    1232     Top = 374
     1231    Top = 380
    12331232    Width = 740
    1234     Height = 42
     1233    Height = 43
    12351234    Align = alBottom
    12361235    BevelOuter = bvNone
    … …  
    12441243      Align = alTop
    12451244      Caption = 'Template Notes:'
     1245      ExplicitWidth = 78
    12461246    end
    12471247    object reNotes: TRichEdit
    … …  
    12491249      Top = 13
    12501250      Width = 740
    1251       Height = 29
     1251      Height = 30
    12521252      Align = alClient
    12531253      Font.Charset = ANSI_CHARSET
    … …  
    12561256      Font.Name = 'Courier New'
    12571257      Font.Style = []
     1258      Constraints.MinHeight = 30
    12581259      ParentFont = False
    12591260      PlainText = True
    … …  
    12691270    end
    12701271  end
    1271   object pnlCOM: TPanel
     1272  object pnlCOM: TPanel [6]
    12721273    Left = 0
    12731274    Top = 263
    … …  
    12861287      Caption = '  Passed Value: '
    12871288      Layout = tlCenter
     1289      ExplicitHeight = 13
    12881290    end
    12891291    object lblCOMObj: TLabel
    … …  
    12951297      Caption = ' COM Object: '
    12961298      Layout = tlCenter
     1299      ExplicitHeight = 13
    12971300    end
    12981301    object edtCOMParam: TCaptionEdit
    … …  
    13011304      Width = 380
    13021305      Height = 21
     1306      Align = alClient
    13031307      TabOrder = 0
    13041308      OnChange = edtCOMParamChange
    1305       Align = alClient
    13061309      Caption = 'Passed Value'
    13071310    end
    … …  
    13291332      TabOrder = 1
    13301333      OnChange = cbxCOMObjChange
     1334      CharsNeedMatch = 1
    13311335    end
    13321336  end
    1333   object pnlLink: TPanel
     1337  object pnlLink: TPanel [7]
    13341338    Left = 0
    13351339    Top = 242
    … …  
    13481352      Caption = ' Associated Consult Service: '
    13491353      Layout = tlCenter
     1354      ExplicitHeight = 13
    13501355    end
    13511356    object cbxLink: TORComboBox
    … …  
    13671372      LookupPiece = 0
    13681373      MaxLength = 0
    1369       Pieces = '2,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,1'
     1374      Pieces = '2'
    13701375      HideSynonyms = True
    13711376      Sorted = False
    … …  
    13761381      OnChange = cbxLinkChange
    13771382      OnNeedData = cbxLinkNeedData
    1378       OnSynonymCheck = cbxLinkSynonymCheck
    1379     end
     1383      CharsNeedMatch = 1
     1384    end
     1385  end
     1386  inherited amgrMain: TVA508AccessibilityManager
     1387    Data = (
     1388      (
     1389        'Component = pnlBottom'
     1390        'Status = stsDefault')
     1391      (
     1392        'Component = btnApply'
     1393        'Status = stsDefault')
     1394      (
     1395        'Component = btnCancel'
     1396        'Status = stsDefault')
     1397      (
     1398        'Component = btnOK'
     1399        'Status = stsDefault')
     1400      (
     1401        'Component = cbEditShared'
     1402        'Status = stsDefault')
     1403      (
     1404        'Component = cbNotes'
     1405        'Status = stsDefault')
     1406      (
     1407        'Component = cbEditUser'
     1408        'Status = stsDefault')
     1409      (
     1410        'Component = pnlBoilerplate'
     1411        'Status = stsDefault')
     1412      (
     1413        'Component = reBoil'
     1414        'Label = lblBoilerplate'
     1415        'Status = stsOK')
     1416      (
     1417        'Component = pnlGroupBP'
     1418        'Status = stsDefault')
     1419      (
     1420        'Component = reGroupBP'
     1421        'Label = lblGroupBP'
     1422        'Status = stsOK')
     1423      (
     1424        'Component = pnlGroupBPGap'
     1425        'Status = stsDefault')
     1426      (
     1427        'Component = pnlBP'
     1428        'Status = stsDefault')
     1429      (
     1430        'Component = cbLongLines'
     1431        'Status = stsDefault')
     1432      (
     1433        'Component = pnlTop'
     1434        'Status = stsDefault')
     1435      (
     1436        'Component = pnlRightTop'
     1437        'Status = stsDefault')
     1438      (
     1439        'Component = pnlCopyBtns'
     1440        'Status = stsDefault')
     1441      (
     1442        'Component = sbCopyRight'
     1443        'Property = Hint'
     1444        'Status = stsOK')
     1445      (
     1446        'Component = sbCopyLeft'
     1447        'Property = Hint'
     1448        'Status = stsOK')
     1449      (
     1450        'Component = pnlPersonal'
     1451        'Status = stsDefault')
     1452      (
     1453        'Component = tvPersonal'
     1454        'Status = stsDefault')
     1455      (
     1456        'Component = pnlPersonalBottom'
     1457        'Status = stsDefault')
     1458      (
     1459        'Component = sbPerUp'
     1460        'Property = Hint'
     1461        'Status = stsOK')
     1462      (
     1463        'Component = sbPerDown'
     1464        'Property = Hint'
     1465        'Status = stsOK')
     1466      (
     1467        'Component = sbPerDelete'
     1468        'Property = Hint'
     1469        'Status = stsOK')
     1470      (
     1471        'Component = cbPerHide'
     1472        'Property = Hint'
     1473        'Status = stsOK')
     1474      (
     1475        'Component = pnlPersonalGap'
     1476        'Status = stsDefault')
     1477      (
     1478        'Component = pnlPerSearch'
     1479        'Status = stsDefault')
     1480      (
     1481        'Component = btnPerFind'
     1482        'Text = Find Personal Template'
     1483        'Status = stsOK')
     1484      (
     1485        'Component = edtPerSearch'
     1486        'Status = stsDefault')
     1487      (
     1488        'Component = cbPerMatchCase'
     1489        'Status = stsDefault')
     1490      (
     1491        'Component = cbPerWholeWords'
     1492        'Status = stsDefault')
     1493      (
     1494        'Component = pnlProperties'
     1495        'Status = stsDefault')
     1496      (
     1497        'Component = gbProperties'
     1498        'Status = stsDefault')
     1499      (
     1500        'Component = cbExclude'
     1501        'Status = stsDefault')
     1502      (
     1503        'Component = cbActive'
     1504        'Status = stsDefault')
     1505      (
     1506        'Component = edtGap'
     1507        'Status = stsDefault')
     1508      (
     1509        'Component = udGap'
     1510        'Status = stsDefault')
     1511      (
     1512        'Component = edtName'
     1513        'Status = stsDefault')
     1514      (
     1515        'Component = gbDialogProps'
     1516        'Status = stsDefault')
     1517      (
     1518        'Component = cbDisplayOnly'
     1519        'Status = stsDefault')
     1520      (
     1521        'Component = cbOneItemOnly'
     1522        'Status = stsDefault')
     1523      (
     1524        'Component = cbFirstLine'
     1525        'Status = stsDefault')
     1526      (
     1527        'Component = cbHideDlgItems'
     1528        'Status = stsDefault')
     1529      (
     1530        'Component = cbIndent'
     1531        'Status = stsDefault')
     1532      (
     1533        'Component = cbHideItems'
     1534        'Status = stsDefault')
     1535      (
     1536        'Component = cbxType'
     1537        'Status = stsDefault')
     1538      (
     1539        'Component = cbxRemDlgs'
     1540        'Status = stsDefault')
     1541      (
     1542        'Component = cbLock'
     1543        'Status = stsDefault')
     1544      (
     1545        'Component = pnlShared'
     1546        'Status = stsDefault')
     1547      (
     1548        'Component = tvShared'
     1549        'Status = stsDefault')
     1550      (
     1551        'Component = pnlSharedBottom'
     1552        'Status = stsDefault')
     1553      (
     1554        'Component = sbShUp'
     1555        'Property = Hint'
     1556        'Status = stsOK')
     1557      (
     1558        'Component = sbShDown'
     1559        'Property = Hint'
     1560        'Status = stsOK')
     1561      (
     1562        'Component = sbShDelete'
     1563        'Property = Hint'
     1564        'Status = stsOK')
     1565      (
     1566        'Component = cbShHide'
     1567        'Property = Hint'
     1568        'Status = stsOK')
     1569      (
     1570        'Component = pnlSharedGap'
     1571        'Status = stsDefault')
     1572      (
     1573        'Component = pnlShSearch'
     1574        'Status = stsDefault')
     1575      (
     1576        'Component = btnShFind'
     1577        'Text = Find Shared Template'
     1578        'Status = stsOK')
     1579      (
     1580        'Component = edtShSearch'
     1581        'Status = stsDefault')
     1582      (
     1583        'Component = cbShMatchCase'
     1584        'Status = stsDefault')
     1585      (
     1586        'Component = cbShWholeWords'
     1587        'Status = stsDefault')
     1588      (
     1589        'Component = pnlMenuBar'
     1590        'Status = stsDefault')
     1591      (
     1592        'Component = cboOwner'
     1593        'Status = stsDefault')
     1594      (
     1595        'Component = btnNew'
     1596        'Status = stsDefault')
     1597      (
     1598        'Component = pnlMenu'
     1599        'Status = stsDefault')
     1600      (
     1601        'Component = mbMain'
     1602        'Status = stsDefault')
     1603      (
     1604        'Component = pnlNotes'
     1605        'Status = stsDefault')
     1606      (
     1607        'Component = reNotes'
     1608        'Label = lblNotes'
     1609        'Status = stsOK')
     1610      (
     1611        'Component = pnlCOM'
     1612        'Status = stsDefault')
     1613      (
     1614        'Component = edtCOMParam'
     1615        'Label = lblCOMParam'
     1616        'Status = stsOK')
     1617      (
     1618        'Component = cbxCOMObj'
     1619        'Property = Caption'
     1620        'Status = stsOK')
     1621      (
     1622        'Component = pnlLink'
     1623        'Status = stsDefault')
     1624      (
     1625        'Component = cbxLink'
     1626        'Label = lblLink'
     1627        'Status = stsOK')
     1628      (
     1629        'Component = frmTemplateEditor'
     1630        'Status = stsDefault'))
    13801631  end
    13811632  object popTemplates: TPopupMenu
    … …  
    17502001    Top = 136
    17512002  end
     2003  object imgLblTemplates: TVA508ImageListLabeler
     2004    Components = <
     2005      item
     2006        Component = tvPersonal
     2007      end
     2008      item
     2009        Component = tvShared
     2010      end>
     2011    Labels = <>
     2012    RemoteLabeler = dmodShared.imgLblHealthFactorLabels
     2013    Left = 104
     2014    Top = 144
     2015  end
    17522016end

  • cprs/trunk/CPRS-Chart/Templates/fTemplateEditor.pas

    r456 r829  
    1818  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    1919  ExtCtrls, StdCtrls, ComCtrls, ORCtrls, Buttons, Mask, ORFn, ORNet,
    20   uTemplates, Menus, ImgList, Clipbrd, ToolWin, MenuBar, TypInfo, MSXML_TLB;
     20  uTemplates, Menus, ImgList, Clipbrd, ToolWin, MenuBar, TypInfo, MSXML_TLB, fBase508Form,
     21  VA508AccessibilityManager, VA508ImageListLabeler;
    2122
    2223type
    … …  
    2425  TTemplateTreeType = (ttShared, ttPersonal);
    2526
    26   TfrmTemplateEditor = class(TForm)
     27  TfrmTemplateEditor = class(TfrmBase508Form)
    2728    splMain: TSplitter;
    28     pnlBottom: TORAutoPanel;
     29    pnlBottom: TPanel;
    2930    btnApply: TButton;
    3031    btnCancel: TButton;
    … …  
    209210    cbxLink: TORComboBox;
    210211    lblLink: TLabel;
     212    imgLblTemplates: TVA508ImageListLabeler;
    211213    procedure btnNewClick(Sender: TObject);
    212214    procedure btnApplyClick(Sender: TObject);
    … …  
    339341      Direction, InsertAt: Integer);
    340342    procedure cbxLinkChange(Sender: TObject);
    341     procedure cbxLinkSynonymCheck(Sender: TObject; const Text: String;
    342       var IsSynonym: Boolean);
    343343    procedure reBoilKeyUp(Sender: TObject; var Key: Word;
    344344      Shift: TShiftState);
    … …  
    346346    procedure reBoilKeyDown(Sender: TObject; var Key: Word;
    347347      Shift: TShiftState);
     348    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    348349  private
    349350    FLastRect: TRect;
    … …  
    386387    FCanDoReminders: boolean;
    387388    FCanDoCOMObjects: boolean;
    388     FPersonalObjects: TStringList;
     389    //FPersonalObjects: TStringList;
    389390    FShowingTemplate: TTemplate;
    390391    FConsultServices: TStringList;
    … …  
    416417    procedure UpdateInsertsDialogs;
    417418    procedure AutoLongLines(Sender: TObject);
    418     procedure UpdatePersonalObjects;
     419    //procedure UpdatePersonalObjects;
    419420    procedure UpdateApply(Template: TTemplate);
    420421    procedure TemplateLocked(Sender: TObject);
    421422    procedure InitTrees;
     423    procedure AdjustControls4FontChange;
     424    procedure ShowGroupBoilerplate(Visible: boolean);
    422425    function GetLinkType(const ANode: TTreeNode): TTemplateLinkType;
    423426  end;
    424427
    425428procedure EditTemplates(Form: TForm; NewTemplate: boolean = FALSE; CopiedText: string = ''; Shared: boolean = FALSE);
     429
     430const
     431  TemplateEditorSplitters = 'frmTempEditSplitters';
     432  TemplateEditorSplitters2 = 'frmTempEditSplitters2';
     433
     434var
     435  tmplEditorSplitterMiddle: integer = 0;
     436  tmplEditorSplitterProperties: integer = 0;
     437  tmplEditorSplitterMain: integer = 0;
     438  tmplEditorSplitterBoil: integer = 0;
     439  tmplEditorSplitterNotes: integer = 0;
    426440
    427441implementation
    … …  
    431445uses dShared, uCore, rTemplates, fTemplateObjects, uSpell, fTemplateView,
    432446  fTemplateAutoGen, fDrawers, fTemplateFieldEditor, fTemplateFields, XMLUtils,
    433   fIconLegend, uReminders, uConst, rCore, rEventHooks, rConsults;
     447  fIconLegend, uReminders, uConst, rCore, rEventHooks, rConsults, VAUtils,
     448  rMisc, fFindingTemplates;
    434449
    435450const
    … …  
    499514      Drawers := TFrmDrawers(Form)
    500515    else
    501     if IsPublishedProp(Form, 'Drawers') then
    502       Drawers := TFrmDrawers(GetOrdProp(Form, 'Drawers'));
     516    if IsPublishedProp(Form, DrawersProperty) then
     517      Drawers := TFrmDrawers(GetOrdProp(Form, DrawersProperty));
    503518  end;
    504519
    … …  
    724739
    725740  BtnApply.Enabled := BackupDiffers;
     741  SetFormPosition(Self);
    726742end;
    727743
    … …  
    873889  end;
    874890  lblNotes.Enabled := (not reNotes.ReadOnly);
    875   if(reNotes.ReadOnly) then
    876     reNotes.Color := ReadOnlyColor
    877   else
    878     reNotes.Color := clWindow;
     891  UpdateReadOnlyColorScheme(reNotes, reNotes.ReadOnly);
    879892  cbxType.Enabled := ok;
    880893  lblType.Enabled := ok;
    … …  
    894907  lblLines.Enabled := ok;
    895908  reBoil.ReadOnly := not ok;
    896   if(ok) then
    897     reBoil.Color := clWindow
    898   else
    899     reBoil.Color := ReadOnlyColor;
     909  UpdateReadOnlyColorScheme(reBoil, not ok);
    900910  lblLink.Enabled := ok;
    901911  cbxLink.Enabled := ok;
    … …  
    937947end;
    938948
     949procedure TfrmTemplateEditor.ShowGroupBoilerplate(Visible: boolean);
     950begin
     951  pnlGroupBP.Visible := Visible;
     952  splBoil.Visible := Visible;
     953  if Visible then
     954  begin
     955    reBoil.Align := alTop;
     956    pnlGroupBP.Align := alClient;
     957    reBoil.Height := tmplEditorSplitterBoil;
     958    splBoil.Top := pnlGroupBP.Top - splBoil.Height;
     959  end
     960  else
     961  begin
     962    pnlGroupBP.Align := alBottom;
     963    reBoil.Align := alClient;
     964  end;
     965end;
     966
    939967procedure TfrmTemplateEditor.ShowInfo(Node: TTreeNode);
    940968var
    … …  
    942970  Idx: TTypeIndex;
    943971  CanDoCOM: boolean;
    944   LinkTemplate: TTemplate;
    945972  lt: TTemplateLinkType;
    946973  lts: string;
    947   i: integer;
    948974
    949975begin
    … …  
    9801006            begin
    9811007              FConsultServices := TStringList.Create;
    982               FConsultServices.Assign(LoadServiceListWithSynonyms(1));
     1008              FastAssign(LoadServiceListWithSynonyms(1), FConsultServices);
    9831009              SortByPiece(FConsultServices, U, 2);
    9841010            end;
    985             for i := 0 to FConsultServices.Count-1 do
    986             begin
    987               LinkTemplate := GetLinkedTemplate(piece(FConsultServices[i],U,1), ltConsult);
    988               if (not assigned(LinkTemplate)) or (LinkTemplate = FShowingTemplate) then
    989                 cbxLink.Items.Add(FConsultServices[i]);
    990             end;
     1011            FastAssign(FConsultServices, cbxLink.Items);
    9911012          end
    9921013          else
    … …  
    11711192      edtGap.Text := '0';
    11721193      reBoil.Clear;
    1173       pnlGroupBP.Visible := FALSE;
    1174       splBoil.Visible := FALSE;
     1194      ShowGroupBoilerplate(False);
    11751195      pnlBoilerplateResize(Self);
    11761196      pnlCOM.Visible := FALSE;
    … …  
    11961216begin
    11971217  if(pnlGroupBP.Visible) and (pnlGroupBP.Height > (pnlBoilerplate.Height-29)) then
     1218  begin
    11981219    pnlGroupBP.Height := pnlBoilerplate.Height-29;
     1220  end;
    11991221  if cbLongLines.checked then
    12001222    Max := 240
    … …  
    14491471      begin
    14501472        reBoil.ReadOnly := TRUE;
    1451         reBoil.Color := ReadOnlyColor;
     1473        UpdateReadOnlyColorScheme(reBoil, TRUE);
    14521474        UpdateInsertsDialogs;
    14531475      end;
    1454       pnlGroupBP.Visible := ItemOK;
    1455       splBoil.Visible := ItemOK;
     1476      ShowGroupBoilerplate(ItemOK);
    14561477      if(not ItemOK) and (IsReminderDialog or IsCOMObject) then
    14571478        BPOK := FALSE;
    1458       if(ItemOK) then
    1459         splBoil.Top := pnlGroupBP.Top - splBoil.Height;
    14601479      pnlBoilerplateResize(Self);
    14611480      pnlBoilerplate.Visible := BPOK;
    … …  
    14821501    frmTemplateFields := nil;
    14831502  end;
    1484   KillObj(@FPersonalObjects);
     1503  //---------- CQ #8665 - RV --------
     1504  //KillObj(@FPersonalObjects);
     1505  if (assigned(uPersonalObjects)) then
     1506  begin
     1507    KillObj(@uPersonalObjects);
     1508    uPersonalObjects.Free;
     1509    uPersonalObjects := nil;
     1510  end;
     1511  // ----  end CQ #8665 -------------
    14851512  dmodShared.OnTemplateLock := nil;
    14861513  dmodShared.InEditor := FALSE;
    … …  
    20402067end;
    20412068
     2069procedure TfrmTemplateEditor.AdjustControls4FontChange;
     2070var
     2071  x: integer;
     2072
     2073  procedure Adjust(Control: TWinControl);
     2074  begin
     2075    x := x - Control.Width - 2;
     2076    Control.Left := x;
     2077  end;
     2078
     2079begin
     2080  if FCanEditShared then
     2081  begin
     2082    x := pnlSharedBottom.Width;
     2083    Adjust(sbSHDelete);
     2084    Adjust(sbSHDown);
     2085    Adjust(sbSHUp);
     2086    cbSHHide.Width := x;
     2087  end;
     2088  x := pnlBottom.Width;
     2089  Adjust(btnApply);
     2090  Adjust(btnCancel);
     2091  Adjust(btnOK);
     2092  cbEditShared.Width := TextWidthByFont(cbEditShared.Font.Handle, cbEditShared.Caption) + 25;
     2093  cbNotes.Left := cbEditShared.Left + cbEditShared.Width + 60;
     2094  cbNotes.Width := TextWidthByFont(cbNotes.Font.Handle, cbNotes.Caption) + 25;
     2095end;
     2096
    20422097function TfrmTemplateEditor.AllowMove(ADropNode, ADragNode: TTreeNode): boolean;
    20432098var
    … …  
    22052260  MoveCopyButtons;
    22062261  tvTreeChange(FCurTree, FCurTree.Selected);
     2262  if FCanEditShared then
     2263    AdjustControls4FontChange;
    22072264end;
    22082265
    … …  
    23272384procedure TfrmTemplateEditor.btnFindClick(Sender: TObject);
    23282385var
    2329   Found: boolean;
     2386  Found: TTreeNode;
    23302387  edtSearch: TEdit;
     2388  IsNext: boolean;
    23312389  FindNext: boolean;
    23322390  FindWholeWords: boolean;
    … …  
    23342392  Tree: TTreeView;
    23352393  LastFoundNode, TmpNode: TTreeNode;
    2336   S1,S2: string;
     2394//  S1,S2: string;
    23372395
    23382396begin
    … …  
    23452403    FindCase := cbShMatchCase.Checked;
    23462404    LastFoundNode := FLastFoundShNode;
    2347     if(FSharedEmptyNodeCount > 0) then
    2348     begin
    2349       FInternalHiddenExpand := TRUE;
    2350       try
    2351         tvShared.Items.GetFirstNode.Expand(TRUE);
    2352       finally
    2353         FInternalHiddenExpand := FALSE;
    2354       end;
    2355     end;
    23562405  end
    23572406  else
    … …  
    23632412    FindCase := cbPerMatchCase.Checked;
    23642413    LastFoundNode := FLastFoundPerNode;
    2365     if(FPersonalEmptyNodeCount > 0) then
    2366     begin
    2367       FInternalHiddenExpand := TRUE;
    2368       try
    2369         tvPersonal.Items.GetFirstNode.Expand(TRUE);
    2370       finally
    2371         FInternalHiddenExpand := FALSE;
    2372       end;
    2373     end;
    23742414  end;
    23752415  if(edtSearch.text <> '') then
    23762416  begin
    2377     if((FindNext) and assigned (LastFoundNode)) then
    2378       TmpNode := LastFoundNode.GetNext
     2417    IsNext := ((FindNext) and assigned (LastFoundNode));
     2418    if IsNext then
     2419   
     2420      TmpNode := LastFoundNode
    23792421    else
    23802422      TmpNode := Tree.Items.GetFirstNode;
    2381     Found := FALSE;
    2382     if(assigned(TmpNode)) then
    2383     begin
    2384       S1 := edtSearch.Text;
    2385       if(not FindCase) then
    2386         S1 := UpperCase(S1);
    2387       while (assigned(TmpNode) and (not Found)) do
    2388       begin
    2389         S2 := TmpNode.Text;
    2390         if(not FindCase) then
    2391           S2 := UpperCase(S2);
    2392         Found := SearchMatch(S1, S2, FindWholeWords);
    2393         if(not Found) then
    2394           TmpNode := TmpNode.GetNext;
    2395       end;
    2396     end;
    2397     if(Found) then
    2398     begin
     2423    FInternalHiddenExpand := TRUE;
     2424    try
     2425      Found := FindTemplate(edtSearch.Text, Tree, Self, TmpNode,
     2426                            IsNext, not FindCase, FindWholeWords);
     2427    finally
     2428      FInternalHiddenExpand := FALSE;
     2429    end;
     2430    if Assigned(Found) then
     2431    begin
     2432      Tree.Selected := Found;
    23992433      if(Tree = tvShared) then
    2400         FLastFoundShNode := TmpNode
     2434        FLastFoundShNode := Found
    24012435      else
    2402         FLastFoundPerNode := TmpNode;
     2436        FLastFoundPerNode := Found;
    24032437      SetFindNext(Tree, TRUE);
    2404       Tree.Selected := TmpNode;
    2405     end
    2406     else
    2407     begin
    2408       if(FindNext) then
    2409         S1 := ''
    2410       else
    2411         S1 := '  "' + edtSearch.Text + '" was not Found.';
    2412       SetFindNext(Tree, FALSE);
    2413       InfoBox('Search Complete.' + S1, 'Information', MB_OK or MB_ICONINFORMATION);
    24142438    end;
    24152439  end;
    … …  
    24992523    end;
    25002524    pnlBoilerplateResize(Self);
     2525    AdjustControls4FontChange;
     2526    MoveCopyButtons;
    25012527  end;
    25022528end;
    … …  
    25162542    begin
    25172543      UpdatePersonalObjects;
    2518       if FPersonalObjects.Count > 0 then
     2544      if uPersonalObjects.Count > 0 then                                                  // -------- CQ #8665 - RV ------------
    25192545      begin
    25202546        DoIt := FALSE;
    25212547        for i := 0 to dmodShared.TIUObjects.Count-1 do
    2522           if FPersonalObjects.IndexOf(Piece(dmodShared.TIUObjects[i],U,2)) >= 0 then
     2548          if uPersonalObjects.IndexOf(Piece(dmodShared.TIUObjects[i],U,2)) >= 0 then      // -------- CQ #8665 - RV ------------
    25232549            frmTemplateObjects.cboObjects.Items.Add(dmodShared.TIUObjects[i]);
    25242550      end;
    25252551    end;
    25262552    if DoIt then
    2527       frmTemplateObjects.cboObjects.Items.Assign(dmodShared.TIUObjects);
     2553      FastAssign(dmodShared.TIUObjects, frmTemplateObjects.cboObjects.Items);
    25282554    frmTemplateObjects.Font := Font;
    25292555    frmTemplateObjects.re := reBoil;
    … …  
    26332659end;
    26342660
     2661procedure TfrmTemplateEditor.FormClose(Sender: TObject;
     2662  var Action: TCloseAction);
     2663begin
     2664  SaveUserBounds(Self);
     2665end;
     2666
    26352667procedure TfrmTemplateEditor.FormCloseQuery(Sender: TObject;
    26362668  var CanClose: Boolean);
    … …  
    26662698procedure TfrmTemplateEditor.splBoilMoved(Sender: TObject);
    26672699begin
     2700  if pnlBoilerplate.Visible and pnlGroupBP.Visible then
     2701    tmplEditorSplitterBoil := reBoil.Height;
     2702  if pnlNotes.Visible then
     2703    tmplEditorSplitterNotes := pnlNotes.Height;
    26682704  pnlBoilerplateResize(Self);
    26692705end;
    … …  
    31053141procedure TfrmTemplateEditor.mbMainResize(Sender: TObject);
    31063142begin
    3107   pnlMenu.Width := mbMain.Width + 3;
     3143  pnlMenu.Width := mbMain.Width + 4;
     3144  mbMain.Width := pnlMenu.Width - 3;
    31083145end;
    31093146
    … …  
    31793216  dmodShared.LoadTIUObjects;
    31803217  UpdatePersonalObjects;
    3181   GetAutoGenText(AName, AText, FPersonalObjects);
     3218  GetAutoGenText(AName, AText, uPersonalObjects);   // -------- CQ #8665 - RV ------------
    31823219  if(AName <> '') and (AText <> '') then
    31833220  begin
    … …  
    32743311  pnlNotes.Visible := cbNotes.Checked;
    32753312  splNotes.Visible := cbNotes.Checked;
    3276   splNotes.Top := pnlNotes.Top-3;
     3313  if cbNotes.Checked then
     3314  begin
     3315    pnlNotes.Height := tmplEditorSplitterNotes;
     3316    pnlNotes.Top := pnlBottom.Top - pnlNotes.Height;
     3317    splNotes.Top := pnlNotes.Top-3;
     3318  end;
    32773319  pnlBoilerplateResize(Self);
    32783320end;
    … …  
    33973439            if (Flds.Count > 0) then begin
    33983440              ExpandEmbeddedFields(Flds);
    3399               Flds.Assign(ExportTemplateFields(Flds));
     3441              FastAssign(ExportTemplateFields(Flds), Flds);
    34003442              for i := 0 to Flds.Count-1 do
    34013443                Flds[i] := '  ' + Flds[i];
    3402               Tmpl.AddStrings(Flds);
     3444              FastAddStrings(Flds, Tmpl);
    34033445            end; {if}
    34043446            Tmpl.Add('</'+XMLHeader+'>');
    … …  
    37043746            FUpdating := FALSE;
    37053747          end;
    3706           ShowMessage('Can not assign a Reminder Dialog to a Reason for Request');
     3748          ShowMsg('Can not assign a Reminder Dialog to a Reason for Request');
    37073749        end
    37083750        else
    … …  
    37903832end;
    37913833
    3792 procedure TfrmTemplateEditor.UpdatePersonalObjects;
     3834(*procedure TfrmTemplateEditor.UpdatePersonalObjects;
    37933835var
    37943836  i: integer;
    … …  
    38033845    FPersonalObjects.Sorted := TRUE;
    38043846  end;
    3805 end;
     3847end;*)
    38063848
    38073849(*function TfrmTemplateEditor.ModifyAllowed(const Node: TTreeNode): boolean;
    … …  
    38753917begin
    38763918  Resync([TTemplate(Sender)]);
    3877   ShowMessage(Format(TemplateLockedText, [TTemplate(Sender).PrintName]));
     3919  ShowMsg(Format(TemplateLockedText, [TTemplate(Sender).PrintName]));
    38783920end;
    38793921
    … …  
    40744116  try
    40754117    case TTemplateLinkType(pnlLink.Tag) of
    4076       ltTitle:     tmpSL.Assign(SubSetOfAllTitles(StartFrom, Direction));
     4118      ltTitle:     FastAssign(SubSetOfAllTitles(StartFrom, Direction), tmpSL);
    40774119//      ltConsult:
    40784120      ltProcedure:
    40794121        begin
    4080           tmpSL.Assign(SubSetOfProcedures(StartFrom, Direction));
     4122          FastAssign(SubSetOfProcedures(StartFrom, Direction), tmpSL);
    40814123          for i := 0 to tmpSL.Count-1 do
    40824124          begin
    … …  
    40964138var
    40974139  Template,LinkTemplate: TTemplate;
     4140  update: boolean;
    40984141
    40994142begin
    … …  
    41044147    if assigned(Template) and Template.CanModify then
    41054148    begin
     4149      update := true;
    41064150      if cbxLink.ItemIEN > 0 then
    41074151      begin
    … …  
    41094153        if (assigned(LinkTemplate) and (LinkTemplate <> Template)) then
    41104154        begin
    4111           ShowMessage(GetLinkName(cbxLink.ItemID, TTemplateLinkType(pnlLink.tag)) +
     4155          ShowMsg(GetLinkName(cbxLink.ItemID, TTemplateLinkType(pnlLink.tag)) +
    41124156                      ' is already assigned to another template.');
    4113           cbxLink.ItemIndex := -1;
     4157          cbxLink.SelectByID(Template.LinkIEN);
     4158          update := False;
     4159        end
     4160        else
     4161        begin
     4162          Template.FileLink := ConvertFileLink(cbxLink.ItemID, TTemplateLinkType(pnlLink.tag));
     4163          if Template.LinkName <> '' then
     4164            edtName.Text := copy(Template.LinkName,1,edtName.MaxLength);
    41144165        end;
    4115         Template.FileLink := ConvertFileLink(cbxLink.ItemID, TTemplateLinkType(pnlLink.tag));
    4116         if Template.LinkName <> '' then
    4117           edtName.Text := copy(Template.LinkName,1,edtName.MaxLength);
    41184166      end
    41194167      else
    41204168        Template.FileLink := '';
    4121       UpdateApply(Template);
    4122     end;
    4123   end;
    4124 end;
    4125 
    4126 procedure TfrmTemplateEditor.cbxLinkSynonymCheck(Sender: TObject;
    4127   const Text: String; var IsSynonym: Boolean);
    4128 var
    4129   LinkTemplate: TTemplate;
    4130   var IEN: string;
    4131 
    4132 begin
    4133   IsSynonym := FALSE;
    4134   if pnlLink.Visible and assigned(FShowingTemplate) then
    4135   begin
    4136     IEN := Piece(Text,#9,30);
    4137     if IEN <> '' then
    4138     begin
    4139       LinkTemplate := GetLinkedTemplate(IEN, TTemplateLinkType(pnlLink.Tag));
    4140       IsSynonym := (assigned(LinkTemplate) and (LinkTemplate <> FShowingTemplate));
    4141     end
    4142     else
    4143       IsSynonym := FALSE;
     4169      if update then
     4170        UpdateApply(Template);
     4171    end;
    41444172  end;
    41454173end;

  • cprs/trunk/CPRS-Chart/Templates/fTemplateFieldEditor.dfm

    r456 r829  
    1 object frmTemplateFieldEditor: TfrmTemplateFieldEditor
     1inherited frmTemplateFieldEditor: TfrmTemplateFieldEditor
    22  Left = 294
    33  Top = 211
    4   Width = 640
    5   Height = 447
    64  BorderIcons = [biSystemMenu, biMaximize]
    75  Caption = 'Template Field Editor'
    8   Color = clBtnFace
    9   Font.Charset = DEFAULT_CHARSET
    10   Font.Color = clWindowText
    11   Font.Height = -11
    12   Font.Name = 'MS Sans Serif'
    13   Font.Style = []
    14   OldCreateOrder = False
     6  ClientHeight = 420
     7  ClientWidth = 788
    158  Position = poScreenCenter
    169  OnCloseQuery = FormCloseQuery
    … …  
    1811  OnDestroy = FormDestroy
    1912  OnResize = FormResize
     13  ExplicitWidth = 796
     14  ExplicitHeight = 454
    2015  PixelsPerInch = 96
    2116  TextHeight = 13
    22   object splLeft: TSplitter
    23     Left = 273
     17  object splLeft: TSplitter [0]
     18    Left = 429
    2419    Top = 25
    25     Width = 3
    2620    Height = 366
    27     Cursor = crHSplit
    2821    Beveled = True
     22    ExplicitLeft = 273
    2923  end
    30   object pnlBottom: TPanel
     24  object pnlBottom: TPanel [1]
    3125    Left = 0
    3226    Top = 391
    33     Width = 632
     27    Width = 788
    3428    Height = 29
    3529    Align = alBottom
    3630    TabOrder = 2
    3731    DesignSize = (
    38       632
     32      788
    3933      29)
    4034    object lblReq: TStaticText
    … …  
    4741    end
    4842    object btnOK: TButton
    49       Left = 392
     43      Left = 548
    5044      Top = 4
    5145      Width = 75
    … …  
    5852    end
    5953    object btnCancel: TButton
    60       Left = 472
     54      Left = 628
    6155      Top = 4
    6256      Width = 75
    … …  
    7064    end
    7165    object btnApply: TButton
    72       Left = 552
     66      Left = 708
    7367      Top = 4
    7468      Width = 75
    … …  
    8074    end
    8175    object btnPreview: TButton
    82       Left = 279
     76      Left = 435
    8377      Top = 4
    8478      Width = 75
    … …  
    10296    end
    10397  end
    104   object pnlObjs: TPanel
     98  object pnlObjs: TPanel [2]
    10599    Left = 0
    106100    Top = 25
    107     Width = 273
     101    Width = 429
    108102    Height = 366
    109103    Align = alLeft
    … …  
    114108      Left = 1
    115109      Top = 1
    116       Width = 271
     110      Width = 427
    117111      Height = 13
    118112      Align = alTop
    119113      Caption = 'Template Fields'
     114      ExplicitWidth = 74
    120115    end
    121116    object cbxObjs: TORComboBox
    122117      Left = 1
    123118      Top = 14
    124       Width = 271
     119      Width = 427
    125120      Height = 351
    126121      Style = orcsSimple
    … …  
    141136      Sorted = False
    142137      SynonymChars = '<Inactive>'
    143       TabPositions = '34,45,55,65,75'
     138      TabPositions = '50,60,70,80,90'
    144139      TabOrder = 0
    145140      OnChange = cbxObjsChange
    … …  
    147142      OnNeedData = cbxObjsNeedData
    148143      OnSynonymCheck = cbxObjsSynonymCheck
     144      CharsNeedMatch = 1
    149145    end
    150146  end
    151   object pnlRight: TPanel
    152     Left = 276
     147  object pnlRight: TPanel [3]
     148    Left = 432
    153149    Top = 25
    154150    Width = 356
    … …  
    182178        Align = alTop
    183179        Caption = 'Notes:'
     180        ExplicitWidth = 31
    184181      end
    185182      object reNotes: TRichEdit
    … …  
    370367        TabOrder = 1
    371368        OnChange = cbxTypeChange
     369        CharsNeedMatch = 1
    372370      end
    373371      object edtTextLen: TCaptionEdit
    … …  
    389387        Anchors = [akTop, akRight]
    390388        Associate = edtTextLen
    391         Min = 0
    392389        Max = 240
    393         Position = 0
    394390        TabOrder = 5
    395         Wrap = False
    396391      end
    397392      object pnlSwap: TPanel
    … …  
    408403          Width = 300
    409404          Height = 22
     405          Align = alTop
    410406          Font.Charset = ANSI_CHARSET
    411407          Font.Color = clWindowText
    … …  
    420416          OnEnter = edtpopControlEnter
    421417          OnExit = ControlExit
    422           Align = alTop
    423418          Caption = 'Default Value'
    424419        end
    … …  
    460455            Min = -9999
    461456            Max = 9999
    462             Position = 0
    463457            TabOrder = 1
    464458            Thousands = False
    465             Wrap = False
    466459          end
    467460          object edtDefNum: TCaptionEdit
    … …  
    483476            Min = -9999
    484477            Max = 9999
    485             Position = 0
    486478            TabOrder = 3
    487479            Thousands = False
    488             Wrap = False
    489480          end
    490481          object edtMinVal: TCaptionEdit
    … …  
    508499            Position = 1
    509500            TabOrder = 7
    510             Wrap = False
    511501          end
    512502          object edtInc: TCaptionEdit
    … …  
    538528            Min = -9999
    539529            Max = 9999
    540             Position = 0
    541530            TabOrder = 5
    542531            Thousands = False
    543             Wrap = False
    544532          end
    545533        end
    … …  
    549537          Width = 300
    550538          Height = 22
     539          Align = alTop
    551540          Font.Charset = ANSI_CHARSET
    552541          Font.Color = clWindowText
    … …  
    560549          OnChange = edtURLChange
    561550          OnEnter = edtpopControlEnter
    562           Align = alTop
    563551          Caption = 'URL'
    564552        end
    … …  
    615603          TabStop = True
    616604          OnChange = cbxDefaultChange
     605          CharsNeedMatch = 1
    617606        end
    618607        object pnlDate: TPanel
    … …  
    678667            TabOrder = 1
    679668            OnChange = cbxDateTypeChange
     669            CharsNeedMatch = 1
    680670          end
    681671        end
    … …  
    703693        Position = 1
    704694        TabOrder = 3
    705         Wrap = False
    706695      end
    707696      object gbIndent: TGroupBox
    … …  
    743732          Height = 21
    744733          Associate = edtIndent
    745           Min = 0
    746734          Max = 30
    747           Position = 0
    748735          TabOrder = 1
    749736          Thousands = False
    750           Wrap = False
    751737        end
    752738        object udPad: TUpDown
    … …  
    756742          Height = 21
    757743          Associate = edtPad
    758           Min = 0
    759744          Max = 30
    760           Position = 0
    761745          TabOrder = 2
    762746          Thousands = False
    763           Wrap = False
    764747        end
    765748        object edtPad: TCaptionEdit
    … …  
    823806    end
    824807  end
    825   object pnlTop: TPanel
     808  object pnlTop: TPanel [4]
    826809    Left = 0
    827810    Top = 0
    828     Width = 632
     811    Width = 788
    829812    Height = 25
    830813    Align = alTop
    … …  
    832815    TabOrder = 3
    833816    DesignSize = (
    834       632
     817      788
    835818      25)
    836819    object MenuBar1: TMenuBar
    837820      Left = 0
    838821      Top = 0
    839       Width = 23
     822      Width = 41
    840823      Height = 25
    841824      Align = alLeft
    … …  
    844827      ButtonWidth = 43
    845828      Caption = 'MenuBar1'
    846       Flat = True
    847829      Menu = mnuMain
    848830      ShowCaptions = True
    … …  
    850832    end
    851833    object btnNew: TButton
    852       Left = 557
     834      Left = 711
    853835      Top = 2
    854836      Width = 75
    … …  
    860842    end
    861843    object btnCopy: TButton
    862       Left = 478
     844      Left = 632
    863845      Top = 2
    864846      Width = 75
    … …  
    871853    end
    872854    object btnDelete: TButton
    873       Left = 399
     855      Left = 553
    874856      Top = 2
    875857      Width = 75
    … …  
    881863      OnClick = mnuDeleteClick
    882864    end
     865  end
     866  inherited amgrMain: TVA508AccessibilityManager
     867    Data = (
     868      (
     869        'Component = pnlBottom'
     870        'Status = stsDefault')
     871      (
     872        'Component = lblReq'
     873        'Status = stsDefault')
     874      (
     875        'Component = btnOK'
     876        'Status = stsDefault')
     877      (
     878        'Component = btnCancel'
     879        'Status = stsDefault')
     880      (
     881        'Component = btnApply'
     882        'Status = stsDefault')
     883      (
     884        'Component = btnPreview'
     885        'Status = stsDefault')
     886      (
     887        'Component = cbHide'
     888        'Status = stsDefault')
     889      (
     890        'Component = pnlObjs'
     891        'Status = stsDefault')
     892      (
     893        'Component = cbxObjs'
     894        'Status = stsDefault')
     895      (
     896        'Component = pnlRight'
     897        'Status = stsDefault')
     898      (
     899        'Component = pnlPreview'
     900        'Status = stsDefault')
     901      (
     902        'Component = reNotes'
     903        'Status = stsDefault')
     904      (
     905        'Component = pnlObjInfo'
     906        'Status = stsDefault')
     907      (
     908        'Component = edtName'
     909        'Status = stsDefault')
     910      (
     911        'Component = edtLMText'
     912        'Status = stsDefault')
     913      (
     914        'Component = cbxType'
     915        'Status = stsDefault')
     916      (
     917        'Component = edtTextLen'
     918        'Status = stsDefault')
     919      (
     920        'Component = udTextLen'
     921        'Status = stsDefault')
     922      (
     923        'Component = pnlSwap'
     924        'Status = stsDefault')
     925      (
     926        'Component = edtDefault'
     927        'Status = stsDefault')
     928      (
     929        'Component = pnlNum'
     930        'Status = stsDefault')
     931      (
     932        'Component = udDefNum'
     933        'Status = stsDefault')
     934      (
     935        'Component = edtDefNum'
     936        'Status = stsDefault')
     937      (
     938        'Component = udMinVal'
     939        'Status = stsDefault')
     940      (
     941        'Component = edtMinVal'
     942        'Status = stsDefault')
     943      (
     944        'Component = udInc'
     945        'Status = stsDefault')
     946      (
     947        'Component = edtInc'
     948        'Status = stsDefault')
     949      (
     950        'Component = edtMaxVal'
     951        'Status = stsDefault')
     952      (
     953        'Component = udMaxVal'
     954        'Status = stsDefault')
     955      (
     956        'Component = edtURL'
     957        'Status = stsDefault')
     958      (
     959        'Component = reItems'
     960        'Status = stsDefault')
     961      (
     962        'Component = cbxDefault'
     963        'Status = stsDefault')
     964      (
     965        'Component = pnlDate'
     966        'Status = stsDefault')
     967      (
     968        'Component = edtDateDef'
     969        'Status = stsDefault')
     970      (
     971        'Component = cbxDateType'
     972        'Status = stsDefault')
     973      (
     974        'Component = edtLen'
     975        'Status = stsDefault')
     976      (
     977        'Component = udLen'
     978        'Status = stsDefault')
     979      (
     980        'Component = gbIndent'
     981        'Status = stsDefault')
     982      (
     983        'Component = edtIndent'
     984        'Status = stsDefault')
     985      (
     986        'Component = udIndent'
     987        'Status = stsDefault')
     988      (
     989        'Component = udPad'
     990        'Status = stsDefault')
     991      (
     992        'Component = edtPad'
     993        'Status = stsDefault')
     994      (
     995        'Component = gbMisc'
     996        'Status = stsDefault')
     997      (
     998        'Component = cbActive'
     999        'Status = stsDefault')
     1000      (
     1001        'Component = cbRequired'
     1002        'Status = stsDefault')
     1003      (
     1004        'Component = cbSepLines'
     1005        'Status = stsDefault')
     1006      (
     1007        'Component = cbExclude'
     1008        'Status = stsDefault')
     1009      (
     1010        'Component = pnlTop'
     1011        'Status = stsDefault')
     1012      (
     1013        'Component = MenuBar1'
     1014        'Status = stsDefault')
     1015      (
     1016        'Component = btnNew'
     1017        'Status = stsDefault')
     1018      (
     1019        'Component = btnCopy'
     1020        'Status = stsDefault')
     1021      (
     1022        'Component = btnDelete'
     1023        'Status = stsDefault')
     1024      (
     1025        'Component = frmTemplateFieldEditor'
     1026        'Status = stsDefault'))
    8831027  end
    8841028  object mnuMain: TMainMenu

  • cprs/trunk/CPRS-Chart/Templates/fTemplateFieldEditor.pas

    r456 r829  
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    77  ORCtrls, StdCtrls, ExtCtrls, Menus, ComCtrls, uTemplateFields, ORFn,
    8   ToolWin, MenuBar, ORClasses, ORDtTm;
     8  ToolWin, MenuBar, ORClasses, ORDtTm, fBase508Form, VA508AccessibilityManager;
    99
    1010type
    11   TfrmTemplateFieldEditor = class(TForm)
     11  TfrmTemplateFieldEditor = class(TfrmBase508Form)
    1212    pnlBottom: TPanel;
    1313    btnOK: TButton;
    … …  
    184184
    185185uses rTemplates, fTemplateDialog, Clipbrd, uSpell, uConst,
    186      fTemplateFields;
     186     fTemplateFields, VAUtils;
    187187
    188188{$R *.DFM}
    … …  
    470470  FUpdating := TRUE;
    471471  try
    472     cbxDefault.Items.Assign(reItems.Lines);
     472    QuickCopy(reItems, cbxDefault);
    473473    idx := -1;
    474474    if(assigned(FFld)) and reItems.Visible and cbxDefault.Visible then
    … …  
    509509  tmp := TORStringList.Create;
    510510  try
    511     tmp.Assign(SubSetOfTemplateFields(StartFrom, Direction));
     511    FastAssign(SubSetOfTemplateFields(StartFrom, Direction), tmp);
    512512    for i := 0 to FDeleted.Count-1 do
    513513    begin
    … …  
    516516        tmp.delete(idx);
    517517    end;
    518     ConvertCodes2Text(tmp, TRUE);
     518    ConvertCodes2Text(tmp, FALSE);
    519519    cbxObjs.ForDataUse(tmp);
    520520  finally
    … …  
    815815    if FDeleted.IndexOfPiece(FFld.FldName, U, 2) >= 0 then
    816816    begin
    817       ShowMessage('Template field can not be named the same as a deleted' + CRLF +
     817      ShowMsg('Template field can not be named the same as a deleted' + CRLF +
    818818                  'field until OK or Apply has been pressed.');
    819819      bad := TRUE;

  • cprs/trunk/CPRS-Chart/Templates/fTemplateFields.dfm

    r456 r829  
    1 object frmTemplateFields: TfrmTemplateFields
     1inherited frmTemplateFields: TfrmTemplateFields
    22  Left = 212
    33  Top = 155
    4   Width = 418
    5   Height = 300
    64  Caption = 'Insert Template Field'
    7   Color = clBtnFace
    8   Font.Charset = DEFAULT_CHARSET
    9   Font.Color = clWindowText
    10   Font.Height = -11
    11   Font.Name = 'MS Sans Serif'
    12   Font.Style = []
     5  ClientHeight = 319
     6  ClientWidth = 450
    137  FormStyle = fsStayOnTop
    14   OldCreateOrder = False
    158  Position = poOwnerFormCenter
    169  OnClose = FormClose
    1710  OnCreate = FormCreate
    1811  OnShow = FormShow
     12  ExplicitWidth = 458
     13  ExplicitHeight = 346
    1914  PixelsPerInch = 96
    2015  TextHeight = 13
    21   object pnlBottom: TPanel
     16  object pnlBottom: TPanel [0]
    2217    Left = 0
    23     Top = 246
    24     Width = 410
    25     Height = 27
     18    Top = 226
     19    Width = 450
     20    Height = 28
    2621    Align = alBottom
    2722    BevelOuter = bvNone
    28     TabOrder = 0
     23    TabOrder = 1
    2924    DesignSize = (
    30       410
    31       27)
    32     object lblReq: TStaticText
    33       Left = 21
    34       Top = 8
    35       Width = 134
    36       Height = 17
    37       Caption = '* Indicates a Required Field'
    38       TabOrder = 3
    39     end
     25      450
     26      28)
    4027    object btnCancel: TButton
    41       Left = 335
     28      Left = 371
    4229      Top = 4
    4330      Width = 75
    … …  
    4734      Caption = '&Done'
    4835      ModalResult = 2
    49       TabOrder = 2
     36      TabOrder = 3
    5037      OnClick = btnCancelClick
    5138    end
    5239    object btnInsert: TButton
    53       Left = 255
     40      Left = 291
    5441      Top = 4
    5542      Width = 75
    … …  
    5946      Default = True
    6047      ModalResult = 4
    61       TabOrder = 1
     48      TabOrder = 2
    6249      OnClick = btnInsertClick
    6350    end
    6451    object btnPreview: TButton
    65       Left = 175
     52      Left = 211
    6653      Top = 4
    6754      Width = 75
    6855      Height = 21
     56      Anchors = [akTop, akRight]
    6957      Caption = '&Preview'
    7058      Enabled = False
     59      TabOrder = 1
     60      OnClick = btnPreviewClick
     61    end
     62    object lblReq: TVA508StaticText
     63      Name = 'lblReq'
     64      AlignWithMargins = True
     65      Left = 10
     66      Top = 12
     67      Width = 132
     68      Height = 15
     69      Alignment = taLeftJustify
     70      Anchors = [akLeft, akBottom]
     71      Caption = '* Indicates a Required Field'
    7172      TabOrder = 0
    72       OnClick = btnPreviewClick
    73     end
    74   end
    75   object cboObjects: TORComboBox
     73      ShowAccelChar = True
     74    end
     75  end
     76  object cboObjects: TORComboBox [1]
    7677    Left = 0
    7778    Top = 0
    78     Width = 410
    79     Height = 246
     79    Width = 450
     80    Height = 226
    8081    Style = orcsSimple
    8182    Align = alClient
    … …  
    8990    ListItemsOnly = True
    9091    LongList = True
     92    LookupPiece = 0
    9193    MaxLength = 0
    9294    Pieces = '2,3'
    … …  
    9597    SynonymChars = '<Inactive>'
    9698    TabPositions = '50,60,70,80,90'
    97     TabOrder = 1
     99    TabOrder = 0
     100    TabStop = True
    98101    OnChange = cboObjectsChange
    99102    OnDblClick = cboObjectsDblClick
    100103    OnNeedData = cboObjectsNeedData
     104    CharsNeedMatch = 1
     105  end
     106  object pnlBottomSR: TPanel [2]
     107    Left = 0
     108    Top = 254
     109    Width = 450
     110    Height = 65
     111    Align = alBottom
     112    BevelOuter = bvNone
     113    TabOrder = 2
     114    object lblSRCont2: TVA508StaticText
     115      Name = 'lblSRCont2'
     116      AlignWithMargins = True
     117      Left = 24
     118      Top = 45
     119      Width = 423
     120      Height = 15
     121      Margins.Left = 24
     122      Margins.Top = 0
     123      Margins.Bottom = 0
     124      Align = alTop
     125      Alignment = taLeftJustify
     126      Caption =
     127        'speaking text that follows the template field, when the field re' +
     128        'ceives focus.'
     129      TabOrder = 3
     130      ShowAccelChar = True
     131    end
     132    object lblSRCont1: TVA508StaticText
     133      Name = 'lblSRCont1'
     134      AlignWithMargins = True
     135      Left = 10
     136      Top = 30
     137      Width = 437
     138      Height = 15
     139      Margins.Left = 10
     140      Margins.Top = 0
     141      Margins.Bottom = 0
     142      Align = alTop
     143      Alignment = taLeftJustify
     144      Caption =
     145        '*** Place this code after a template field to allow the screen r' +
     146        'eader to continue'
     147      TabOrder = 2
     148      ShowAccelChar = True
     149    end
     150    object lblSRStop: TVA508StaticText
     151      Name = 'lblSRStop'
     152      AlignWithMargins = True
     153      Left = 10
     154      Top = 15
     155      Width = 437
     156      Height = 15
     157      Margins.Left = 10
     158      Margins.Top = 0
     159      Margins.Bottom = 0
     160      Align = alTop
     161      Alignment = taLeftJustify
     162      Caption = '** Screen reader will stop speaking at this point'
     163      TabOrder = 1
     164      ShowAccelChar = True
     165    end
     166    object pnlSRIntro: TPanel
     167      Left = 0
     168      Top = 0
     169      Width = 450
     170      Height = 15
     171      Align = alTop
     172      BevelOuter = bvNone
     173      TabOrder = 0
     174      object lblSRIntro1: TVA508StaticText
     175        Name = 'lblSRIntro1'
     176        AlignWithMargins = True
     177        Left = 10
     178        Top = 0
     179        Width = 127
     180        Height = 15
     181        Margins.Left = 10
     182        Margins.Top = 0
     183        Margins.Bottom = 0
     184        Align = alLeft
     185        Alignment = taLeftJustify
     186        Caption = 'Screen Reader Codes'
     187        Font.Charset = DEFAULT_CHARSET
     188        Font.Color = clWindowText
     189        Font.Height = -11
     190        Font.Name = 'MS Sans Serif'
     191        Font.Style = [fsBold]
     192        ParentFont = False
     193        TabOrder = 0
     194        ShowAccelChar = True
     195      end
     196      object lblSRIntro2: TVA508StaticText
     197        Name = 'lblSRIntro2'
     198        Left = 140
     199        Top = 0
     200        Width = 310
     201        Height = 15
     202        Align = alClient
     203        Alignment = taLeftJustify
     204        Caption = '(make templates user friendly for those using screen readers)'
     205        TabOrder = 1
     206        ShowAccelChar = True
     207      end
     208    end
     209  end
     210  inherited amgrMain: TVA508AccessibilityManager
     211    Data = (
     212      (
     213        'Component = pnlBottom'
     214        'Status = stsDefault')
     215      (
     216        'Component = btnCancel'
     217        'Status = stsDefault')
     218      (
     219        'Component = btnInsert'
     220        'Status = stsDefault')
     221      (
     222        'Component = btnPreview'
     223        'Status = stsDefault')
     224      (
     225        'Component = cboObjects'
     226        'Status = stsDefault')
     227      (
     228        'Component = frmTemplateFields'
     229        'Status = stsDefault')
     230      (
     231        'Component = lblReq'
     232        'Status = stsDefault')
     233      (
     234        'Component = pnlBottomSR'
     235        'Status = stsDefault')
     236      (
     237        'Component = lblSRCont2'
     238        'Status = stsDefault')
     239      (
     240        'Component = lblSRCont1'
     241        'Status = stsDefault')
     242      (
     243        'Component = lblSRStop'
     244        'Status = stsDefault')
     245      (
     246        'Component = pnlSRIntro'
     247        'Status = stsDefault')
     248      (
     249        'Component = lblSRIntro1'
     250        'Status = stsDefault')
     251      (
     252        'Component = lblSRIntro2'
     253        'Status = stsDefault'))
    101254  end
    102255end

  • cprs/trunk/CPRS-Chart/Templates/fTemplateFields.pas

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   ORCtrls, ComCtrls, StdCtrls, ExtCtrls;
     7  ORCtrls, ComCtrls, StdCtrls, ExtCtrls, fBase508Form, VA508AccessibilityManager;
    88
    99type
    10   TfrmTemplateFields = class(TForm)
     10  TfrmTemplateFields = class(TfrmBase508Form)
    1111    pnlBottom: TPanel;
    1212    btnCancel: TButton;
    1313    cboObjects: TORComboBox;
    1414    btnInsert: TButton;
    15     lblReq: TStaticText;
    1615    btnPreview: TButton;
     16    lblReq: TVA508StaticText;
     17    pnlBottomSR: TPanel;
     18    lblSRCont2: TVA508StaticText;
     19    lblSRCont1: TVA508StaticText;
     20    lblSRStop: TVA508StaticText;
     21    pnlSRIntro: TPanel;
     22    lblSRIntro1: TVA508StaticText;
     23    lblSRIntro2: TVA508StaticText;
    1724    procedure FormShow(Sender: TObject);
    1825    procedure FormCreate(Sender: TObject);
    … …  
    2835{    Fre: TRichEdit;}
    2936    Fre: TCustomEdit;
     37    FInsertAllowed: boolean;
     38    FInitialized: boolean;
    3039    FAutoLongLines: TNotifyEvent;
    3140    procedure InsertField;
    3241{    procedure Setre(const Value: TRichEdit);}
    3342    procedure Setre(const Value: TCustomEdit);
     43    function ValidPreview: boolean;
     44    function ValidInsert: boolean;
    3445  public
    3546    procedure UpdateStatus;
    … …  
    4758
    4859procedure TfrmTemplateFields.FormShow(Sender: TObject);
    49 begin
     60var
     61  i: integer;
     62begin
     63  if not FInitialized then
     64  begin
     65    with cboObjects do
     66    begin
     67      for i := low(ScreenReaderCodeLines) to high(ScreenReaderCodeLines) do
     68        Items.Add(ScreenReaderCodeLines[i]);
     69      InsertSeparator;
     70      InitLongList('');
     71    end;
     72    FInitialized := TRUE;
     73  end;
    5074  cboObjects.SelectAll;
    5175  cboObjects.SetFocus;
    … …  
    5478procedure TfrmTemplateFields.FormCreate(Sender: TObject);
    5579begin
    56   cboObjects.InitLongList('');
    57   cboObjects.ItemHeight := 15;
    58   ResizeAnchoredFormToFont(self);
    59   //ResizeAnchoredFormToFont doesn't work right on the button positions for some reason.
    60   btnCancel.Left := pnlBottom.ClientWidth - btnCancel.Width;
    61   btnInsert.Left := btnCancel.Left - btnInsert.Width - 8;
     80  ResizeFormToFont(self);
     81  cboObjects.ItemHeight := lblReq.Height - 1;
     82  FInsertAllowed := TRUE;
     83  lblReq.Top := (pnlBottom.Height - lblReq.Height);
     84  pnlSRIntro.Height := lblSRStop.Height;
     85  pnlBottomSR.Height := lblSRCont1.Height * 4 + 5;
    6286end;
    6387
    … …  
    76100var
    77101  cnt: integer;
    78 
    79 begin
     102  p1, p2: string;
     103  check: boolean;
     104  i: integer;
     105
     106begin
     107  p1 := Piece(cboObjects.Items[cboObjects.ItemIndex],U,1);
     108  if p1 = '' then exit;
    80109  if assigned(Fre) and (not TORExposedCustomEdit(Fre).ReadOnly) and (cboObjects.ItemIndex >= 0) then
    81110  begin
    … …  
    83112      cnt := TRichEdit(FRe).Lines.Count
    84113    else
    85       cnt :=0;
    86     Fre.SelText := TemplateFieldBeginSignature +
    87                    Piece(cboObjects.Items[cboObjects.ItemIndex],U,2)+
    88                    TemplateFieldEndSignature;
     114      cnt := 0;
     115    if StrToIntDef(p1, 0) < 0 then
     116    begin
     117      check := true;
     118      for i := low(ScreenReaderCodeIDs) to high(ScreenReaderCodeIDs) do
     119      begin
     120        if p1 = ScreenReaderCodeIDs[i] then
     121        begin
     122          p2 := ScreenReaderCodes[i];
     123          check := FALSE;
     124          break;
     125        end;
     126      end;
     127    end
     128    else
     129      check := TRUE;
     130    if check then
     131      p2 := TemplateFieldBeginSignature + Piece(cboObjects.Items[cboObjects.ItemIndex],U,2) +
     132            TemplateFieldEndSignature;
     133    Fre.SelText := p2;
    89134    if Fre is TRichEdit then
    90135      if(assigned(FAutoLongLines) and (cnt <> TRichEdit(FRe).Lines.Count)) then
    … …  
    95140procedure TfrmTemplateFields.cboObjectsDblClick(Sender: TObject);
    96141begin
    97   if btnInsert.Enabled then
     142  if ValidInsert then
    98143    InsertField;
    99144end;
    … …  
    118163procedure TfrmTemplateFields.UpdateStatus;
    119164begin
    120   btnInsert.Enabled := (not TORExposedCustomEdit(re).ReadOnly);
     165  FInsertAllowed := (not TORExposedCustomEdit(re).ReadOnly);
     166  btnInsert.Enabled := ValidInsert and FInsertAllowed;
     167end;
     168
     169function TfrmTemplateFields.ValidInsert: boolean;
     170begin
     171  Result := (cboObjects.ItemIndex >= 0);
     172  if Result then
     173    Result := (Piece(cboObjects.Items[cboObjects.ItemIndex],U,1) <> '');
     174end;
     175
     176function TfrmTemplateFields.ValidPreview: boolean;
     177var
     178  i: integer;
     179  code: string;
     180begin
     181  Result := ValidInsert;
     182  if Result then
     183  begin
     184    code := Piece(cboObjects.Items[cboObjects.ItemIndex],U,1);
     185    for I := low(ScreenReaderCodeIDs) to high(ScreenReaderCodeIDs) do
     186    begin
     187      if code = ScreenReaderCodeIDs[i] then
     188      begin
     189        Result := FALSE;
     190        break;
     191      end;
     192    end;
     193  end;
    121194end;
    122195
    123196procedure TfrmTemplateFields.btnInsertClick(Sender: TObject);
    124197begin
    125   InsertField;
     198  if ValidInsert then
     199    InsertField;
    126200end;
    127201
    … …  
    147221procedure TfrmTemplateFields.cboObjectsChange(Sender: TObject);
    148222begin
    149   btnPreview.Enabled := (cboObjects.ItemIndex >= 0)
     223  btnPreview.Enabled := ValidPreview;
     224  btnInsert.Enabled := ValidInsert and FInsertAllowed;
    150225end;
    151226

  • cprs/trunk/CPRS-Chart/Templates/fTemplateImport.dfm

    r456 r829  
    1 object frmTemplateImport: TfrmTemplateImport
     1inherited frmTemplateImport: TfrmTemplateImport
    22  Left = 273
    33  Top = 195
    … …  
    77  ClientHeight = 132
    88  ClientWidth = 288
    9   Color = clBtnFace
    10   Font.Charset = DEFAULT_CHARSET
    11   Font.Color = clWindowText
    12   Font.Height = -11
    13   Font.Name = 'MS Sans Serif'
    14   Font.Style = []
    159  FormStyle = fsStayOnTop
    16   OldCreateOrder = False
    1710  Position = poScreenCenter
    1811  PixelsPerInch = 96
    1912  TextHeight = 13
    20   object gaugeImport: TGauge
     13  object gaugeImport: TGauge [0]
    2114    Left = 8
    2215    Top = 82
    2316    Width = 272
    2417    Height = 21
    25     ForeColor = clNavy
     18    BackColor = clHighlightText
     19    ForeColor = clHighlight
     20    Font.Charset = DEFAULT_CHARSET
     21    Font.Color = clCaptionText
     22    Font.Height = -11
     23    Font.Name = 'MS Sans Serif'
     24    Font.Style = []
     25    ParentFont = False
    2626    Progress = 0
    2727  end
    28   object lblImporting: TStaticText
     28  object lblImporting: TStaticText [1]
    2929    Left = 8
    3030    Top = 4
    … …  
    3737    TabOrder = 0
    3838  end
    39   object animImport: TAnimate
     39  object animImport: TAnimate [2]
    4040    Left = 8
    4141    Top = 20
    … …  
    4444    Active = True
    4545    CommonAVI = aviCopyFile
    46     StopFrame = 26
     46    StopFrame = 20
    4747  end
    48   object btnCancel: TButton
     48  object btnCancel: TButton [3]
    4949    Left = 106
    5050    Top = 106
    … …  
    5757    OnClick = btnCancelClick
    5858  end
     59  inherited amgrMain: TVA508AccessibilityManager
     60    Data = (
     61      (
     62        'Component = lblImporting'
     63        'Status = stsDefault')
     64      (
     65        'Component = animImport'
     66        'Status = stsDefault')
     67      (
     68        'Component = btnCancel'
     69        'Status = stsDefault')
     70      (
     71        'Component = frmTemplateImport'
     72        'Status = stsDefault'))
     73  end
    5974end

  • cprs/trunk/CPRS-Chart/Templates/fTemplateImport.pas

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   Gauges, StdCtrls, ComCtrls;
     7  Gauges, StdCtrls, ComCtrls, fBase508Form, VA508AccessibilityManager;
    88
    99type
    10   TfrmTemplateImport = class(TForm)
     10  TfrmTemplateImport = class(TfrmBase508Form)
    1111    animImport: TAnimate;
    1212    btnCancel: TButton;

  • cprs/trunk/CPRS-Chart/Templates/fTemplateObjects.dfm

    r456 r829  
    1 object frmTemplateObjects: TfrmTemplateObjects
     1inherited frmTemplateObjects: TfrmTemplateObjects
    22  Left = 215
    33  Top = 343
    4   Width = 247
    5   Height = 300
    64  ActiveControl = cboObjects
    75  Caption = 'Insert Patient Data (Object)'
    8   Color = clBtnFace
    9   Font.Charset = DEFAULT_CHARSET
    10   Font.Color = clWindowText
    11   Font.Height = -11
    12   Font.Name = 'MS Sans Serif'
    13   Font.Style = []
     6  ClientHeight = 273
     7  ClientWidth = 239
    148  FormStyle = fsStayOnTop
    15   OldCreateOrder = False
    169  Position = poOwnerFormCenter
    1710  OnClose = FormClose
    1811  OnShow = FormShow
     12  ExplicitWidth = 247
     13  ExplicitHeight = 300
    1914  PixelsPerInch = 96
    2015  TextHeight = 13
    21   object cboObjects: TORComboBox
     16  object cboObjects: TORComboBox [0]
    2217    Left = 0
    2318    Top = 0
    … …  
    4237    TabOrder = 0
    4338    OnDblClick = cboObjectsDblClick
     39    CharsNeedMatch = 1
    4440  end
    45   object pnlBottom: TPanel
     41  object pnlBottom: TPanel [1]
    4642    Left = 0
    4743    Top = 246
    … …  
    9187    end
    9288  end
     89  inherited amgrMain: TVA508AccessibilityManager
     90    Data = (
     91      (
     92        'Component = cboObjects'
     93        'Status = stsDefault')
     94      (
     95        'Component = pnlBottom'
     96        'Status = stsDefault')
     97      (
     98        'Component = btnCancel'
     99        'Status = stsDefault')
     100      (
     101        'Component = btnInsert'
     102        'Status = stsDefault')
     103      (
     104        'Component = btnRefresh'
     105        'Status = stsDefault')
     106      (
     107        'Component = frmTemplateObjects'
     108        'Status = stsDefault'))
     109  end
    93110end

  • cprs/trunk/CPRS-Chart/Templates/fTemplateObjects.pas

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   ORCtrls, StdCtrls, ExtCtrls, ComCtrls, ORFn, dShared;
     7  ORCtrls, StdCtrls, ExtCtrls, ComCtrls, ORFn, dShared, uTemplates, fBase508Form,
     8  VA508AccessibilityManager;
    89
    910type
    10   TfrmTemplateObjects = class(TForm)
     11  TfrmTemplateObjects = class(TfrmBase508Form)
    1112    cboObjects: TORComboBox;
    1213    pnlBottom: TPanel;
    … …  
    9394
    9495procedure TfrmTemplateObjects.btnRefreshClick(Sender: TObject);
     96var
     97  i: integer;
     98  DoIt: boolean;
    9599begin
    96 cboObjects.SelectAll;
    97 cboObjects.Clear;
    98 dmodShared.RefreshObject := true;
    99 dmodShared.LoadTIUObjects;
    100 CboOBJECTS.Items.AddStrings(dmodShared.TIUObjects);
     100  cboObjects.Clear;
     101  dmodShared.RefreshObject := true;
     102  dmodShared.LoadTIUObjects;
     103  //---------- CQ #8665 - RV ----------------
     104  DoIt := TRUE;
     105  UpdatePersonalObjects;
     106  if uPersonalObjects.Count > 0 then
     107  begin
     108    DoIt := FALSE;
     109    for i := 0 to dmodShared.TIUObjects.Count-1 do
     110      if uPersonalObjects.IndexOf(Piece(dmodShared.TIUObjects[i],U,2)) >= 0 then
     111        cboObjects.Items.Add(dmodShared.TIUObjects[i]);
     112  end;
     113  if DoIt then
     114  //---------- end CQ #8665 ------------------
     115    cboObjects.Items.Assign(dmodShared.TIUObjects);
    101116end;
    102117
    103118end.
     119

  • cprs/trunk/CPRS-Chart/Templates/fTemplateView.dfm

    r456 r829  
    1 object frmTemplateView: TfrmTemplateView
     1inherited frmTemplateView: TfrmTemplateView
    22  Left = 257
    33  Top = 105
    4   Width = 578
    5   Height = 372
    64  Caption = 'View Template'
    7   Color = clBtnFace
    8   Font.Charset = DEFAULT_CHARSET
    9   Font.Color = clWindowText
    10   Font.Height = -11
    11   Font.Name = 'MS Sans Serif'
    12   Font.Style = []
    13   OldCreateOrder = False
     5  ClientHeight = 343
     6  ClientWidth = 568
    147  Position = poScreenCenter
    158  OnClose = FormClose
    169  OnCreate = FormCreate
    1710  OnDestroy = FormDestroy
    18   OnShow = FormShow
     11  ExplicitWidth = 576
     12  ExplicitHeight = 370
    1913  PixelsPerInch = 96
    2014  TextHeight = 13
    21   object pnlBottom: TPanel
     15  object pnlBottom: TPanel [0]
    2216    Left = 0
    23     Top = 315
    24     Width = 570
     17    Top = 313
     18    Width = 568
    2519    Height = 30
    2620    Align = alBottom
    … …  
    2822    TabOrder = 1
    2923    DesignSize = (
    30       570
     24      568
    3125      30)
    3226    object btnClose: TButton
    33       Left = 494
     27      Left = 492
    3428      Top = 6
    3529      Width = 75
    … …  
    5246    end
    5347    object btnPrint: TButton
    54       Left = 414
     48      Left = 412
    5549      Top = 6
    5650      Width = 75
    … …  
    6256    end
    6357  end
    64   object reMain: TRichEdit
     58  object reMain: TRichEdit [1]
    6559    Left = 0
    6660    Top = 0
    67     Width = 570
    68     Height = 315
     61    Width = 568
     62    Height = 313
    6963    Align = alClient
    7064    Color = clCream
    … …  
    8276    WantReturns = False
    8377    WordWrap = False
     78  end
     79  inherited amgrMain: TVA508AccessibilityManager
     80    Data = (
     81      (
     82        'Component = pnlBottom'
     83        'Status = stsDefault')
     84      (
     85        'Component = btnClose'
     86        'Status = stsDefault')
     87      (
     88        'Component = cbStayOnTop'
     89        'Status = stsDefault')
     90      (
     91        'Component = btnPrint'
     92        'Status = stsDefault')
     93      (
     94        'Component = reMain'
     95        'Status = stsDefault')
     96      (
     97        'Component = frmTemplateView'
     98        'Status = stsDefault'))
    8499  end
    85100  object popView: TPopupMenu

  • cprs/trunk/CPRS-Chart/Templates/fTemplateView.pas

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   StdCtrls, ComCtrls, ExtCtrls, Menus, ORFn;
     7  StdCtrls, ComCtrls, ExtCtrls, Menus, ORFn, fBase508Form,
     8  VA508AccessibilityManager;
    89
    910type
    10   TfrmTemplateView = class(TForm)
     11  TfrmTemplateView = class(TfrmBase508Form)
    1112    pnlBottom: TPanel;
    1213    reMain: TRichEdit;
    … …  
    2627    procedure SelectAll1Click(Sender: TObject);
    2728    procedure btnPrintClick(Sender: TObject);
     29    procedure AlignButtons();
    2830    procedure FormCreate(Sender: TObject);
    29     procedure FormShow(Sender: TObject);
    3031  private
    3132  end;
    … …  
    5253  if(not assigned(frmTemplateView)) then
    5354    frmTemplateView := TfrmTemplateView.Create(Application);
    54   ResizeAnchoredFormToFont(frmTemplateView);
     55  //Quick fix to work around glich in resize algorithm
     56  frmTemplateView.AlignButtons();
    5557  frmTemplateView.reMain.Lines.Clear;
    5658  frmTemplateView.Caption := 'Template: ' + Title;
    … …  
    8082  SaveUserBounds(frmTemplateView);
    8183  Action := caFree;
     84end;
     85
     86procedure TfrmTemplateView.FormCreate(Sender: TObject);
     87begin
     88  inherited;
     89  ResizeAnchoredFormToFont(Self);
     90  SetFormPosition(Self);
    8291end;
    8392
    … …  
    118127end;
    119128
    120 procedure TfrmTemplateView.FormCreate(Sender: TObject);
     129procedure TfrmTemplateView.AlignButtons;
     130Const
     131  BtnSpace = 8;
    121132begin
    122   reMain.Color := ReadOnlyColor;
    123 end;
    124 
    125 procedure TfrmTemplateView.FormShow(Sender: TObject);
    126 begin
    127   SetFormPosition(frmTemplateView);
     133  btnClose.Left := frmTemplateView.Width - btnClose.Width - BtnSpace;
     134  btnPrint.Left := btnClose.Left - BtnSpace - btnPrint.Width;
    128135end;
    129136

  • cprs/trunk/CPRS-Chart/Templates/mTemplateFieldButton.dfm

    r456 r829  
    22  Left = 0
    33  Top = 0
    4   Width = 109
     4  Width = 136
    55  Height = 14
     6  AutoScroll = True
    67  Font.Charset = ANSI_CHARSET
    78  Font.Color = clWindowText
    … …  
    1213  TabOrder = 0
    1314  TabStop = True
    14   OnEnter = pnlBtnEnter
    15   OnExit = pnlBtnExit
     15  OnEnter = FrameEnter
     16  OnExit = FrameExit
    1617  object pnlBtn: TPanel
    1718    Left = 0
    1819    Top = 0
    19     Width = 109
     20    Width = 136
    2021    Height = 14
    2122    Align = alClient
    2223    TabOrder = 0
     24    OnExit = FrameExit
    2325    OnMouseDown = pnlBtnMouseDown
    2426    OnMouseUp = pnlBtnMouseUp
     27    DesignSize = (
     28      136
     29      14)
    2530    object lblText: TLabel
    2631      Left = 2
    2732      Top = -1
    28       Width = 105
     33      Width = 132
    2934      Height = 14
    3035      Alignment = taCenter
    … …  
    3540      OnMouseDown = pnlBtnMouseDown
    3641      OnMouseUp = pnlBtnMouseUp
     42      ExplicitWidth = 105
    3743    end
    3844    object pbFocus: TPaintBox
    3945      Left = 1
    4046      Top = 1
    41       Width = 107
     47      Width = 134
    4248      Height = 12
    4349      Align = alClient
    … …  
    4551      OnMouseUp = pnlBtnMouseUp
    4652      OnPaint = pbFocusPaint
     53      ExplicitWidth = 107
    4754    end
    4855  end

  • cprs/trunk/CPRS-Chart/Templates/mTemplateFieldButton.pas

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   StdCtrls, ExtCtrls;
     7  StdCtrls, ExtCtrls, uDlgComponents, VA508AccessibilityManager;
    88
    99type
    10   TfraTemplateFieldButton = class(TFrame)
     10  TfraTemplateFieldButton = class(TFrame, ICPRSDialogComponent)
    1111    pnlBtn: TPanel;
    1212    lblText: TLabel;
    … …  
    1616    procedure pnlBtnMouseUp(Sender: TObject; Button: TMouseButton;
    1717      Shift: TShiftState; X, Y: Integer);
    18     procedure pnlBtnEnter(Sender: TObject);
    19     procedure pnlBtnExit(Sender: TObject);
     18    procedure FrameEnter(Sender: TObject);
     19    procedure FrameExit(Sender: TObject);
    2020    procedure pbFocusPaint(Sender: TObject);
    2121  private
     22    FCPRSDialogData: ICPRSDialogComponent;
    2223    FBtnDown: boolean;
    2324    FItems: TStringList;
    … …  
    3334    property Items: TStringList read FItems;
    3435    property OnChange: TNotifyEvent read FOnChange write FOnChange;
     36    property CPRSDialogData: ICPRSDialogComponent read FCPRSDialogData implements ICPRSDialogComponent;
    3537  end;
    3638
    … …  
    4042
    4143uses
    42   ORFn;
    43  
     44  ORFn, VA508AccessibilityRouter;
     45
    4446procedure TfraTemplateFieldButton.pnlBtnMouseDown(Sender: TObject; Button: TMouseButton;
    4547  Shift: TShiftState; X, Y: Integer);
    … …  
    6971        idx := 0;
    7072      ButtonText := FItems[idx];
     73      if ScreenReaderSystemActive then
     74      begin
     75        txt := FItems[idx];
     76        if Trim(txt) = '' then
     77          txt := 'blank';
     78        GetScreenReader.Speak(txt);
     79      end;
    7180      if assigned(FOnChange) then
    7281        FOnChange(Self);
    … …  
    8695end;
    8796
    88 procedure TfraTemplateFieldButton.pnlBtnEnter(Sender: TObject);
     97type
     98  TWinControlFriend = class(TWinControl);
     99 
     100procedure TfraTemplateFieldButton.FrameEnter(Sender: TObject);
    89101begin
    90102  pbFocus.Invalidate;
    91103end;
    92104
    93 procedure TfraTemplateFieldButton.pnlBtnExit(Sender: TObject);
     105procedure TfraTemplateFieldButton.FrameExit(Sender: TObject);
    94106begin
    95107  pbFocus.Invalidate;
    … …  
    98110constructor TfraTemplateFieldButton.Create(AOwner: TComponent);
    99111begin
    100   inherited;
     112  inherited Create(AOwner);
     113  TabStop := TRUE;
    101114  FItems := TStringList.Create;
    102115  OnKeyDown := ButtonKeyDown;
    103116  OnKeyUp := ButtonKeyUp;
    104117  Font.Size := MainFontSize;
     118  FCPRSDialogData := TCPRSDialogComponent.Create(Self, 'multi value button');
    105119end;
    106120
    … …  
    142156begin
    143157  FItems.Free;
     158  FCPRSDialogData := nil;
    144159  inherited;
    145160end;
    146161
     162initialization
     163  SpecifyFormIsNotADialog(TfraTemplateFieldButton);
     164
    147165end.

  • cprs/trunk/CPRS-Chart/Templates/rTemplates.pas

    r456 r829  
    105105    CallBroker;
    106106    RPCBrokerV.Results.Delete(0);
    107     BoilerPlate.Assign(RPCBrokerV.Results);
     107    FastAssign(RPCBrokerV.Results, BoilerPlate);
    108108    RPCBrokerV.Results.Clear;
    109109  end;
    … …  
    260260  TmpList := TStringList.Create;
    261261  try
    262     TmpList.Assign(RPCBrokerV.Results);
     262    FastAssign(RPCBrokerV.Results, TmpList);
    263263    SortByPiece(TmpList, U, 2);
    264264    MixedCaseList(TmpList);
    265     RPCBrokerV.Results.Assign(TmpList);
     265    FastAssign(TmpList, RPCBrokerV.Results);
    266266  finally
    267267    TmpList.Free;
    … …  
    377377begin
    378378  CallV('TIU FIELD CHECK',[nil]);
    379   ResultString.Assign(RPCBrokerV.Results);
     379  FastAssign(RPCBrokerV.Results, ResultString);
    380380end;
    381381
    … …  
    398398    CallBroker;
    399399  end;
    400   Text.Assign(RPCBrokerV.Results);
     400  FastAssign(RPCBrokerV.Results, Text);
    401401end;
    402402
    … …  
    449449  Result := TRUE;
    450450  CallV('TIU FIELD LIST IMPORT',[nil]);
    451   ResultSet.Assign(RPCBrokerV.Results);
     451  FastAssign(RPCBrokerV.Results, ResultSet);
    452452  if ResultSet.Count < 1 then
    453453    Result := FALSE;

  • cprs/trunk/CPRS-Chart/Templates/uTemplateFields.pas

    r456 r829  
    55uses
    66  Forms, SysUtils, Classes, Dialogs, StdCtrls, ExtCtrls, Controls, Contnrs,
    7   Graphics, ORClasses, ComCtrls, ORDtTm;
     7  Graphics, ORClasses, ComCtrls, ORDtTm, uDlgComponents, TypInfo, ORFn, StrUtils;
    88
    99type
    1010  TTemplateFieldType = (dftUnknown, dftEditBox, dftComboBox, dftButton, dftCheckBoxes,
    11                         dftRadioButtons, dftDate, dftNumber, dftHyperlink, dftWP, dftText);
     11    dftRadioButtons, dftDate, dftNumber, dftHyperlink, dftWP, dftText,
     12// keep dftScreenReader as last entry - users can not create this type of field
     13    dftScreenReader);
    1214
    1315  TTmplFldDateType = (dtUnknown, dtDate, dtDateTime, dtDateReqTime,
    … …  
    3032    FID: string;
    3133    FFont: TFont;
    32     FPanel: TPanel;
     34    FPanel: TDlgFieldPanel;
    3335    FControls: TStringList;
    3436    FIndents: TStringList;
    … …  
    4749    procedure SetFieldValues(const Value: string);
    4850    procedure SetAutoDestroyOnPanelFree(const Value: boolean);
     51    function StripCode(var txt: string; code: char): boolean;
    4952  protected
    5053    procedure UpDownChange(Sender: TObject);
    … …  
    5760    constructor Create(AParent: TWinControl; AID, Text: string);
    5861    destructor Destroy; override;
    59     function GetPanel(MaxLen: integer; AParent: TWinControl): TPanel;
     62    function GetPanel(MaxLen: integer; AParent: TWinControl;
     63                      OwningCheckBox: TCPRSDialogParentCheckBox): TDlgFieldPanel;
    6064    function GetText: string;
    6165    property Text: string read FText write FText;
    … …  
    174178procedure ConvertCodes2Text(sl: TStrings; Short: boolean);
    175179function StripEmbedded(iItems: string): string;
     180procedure StripScreenReaderCodes(var Text: string); overload;
     181procedure StripScreenReaderCodes(SL: TStrings); overload;
     182function HasScreenReaderBreakCodes(SL: TStrings): boolean;
    176183
    177184const
    178   TemplateFieldBeginSignature = '{FLD:';
     185  TemplateFieldSignature = '{FLD';
     186  TemplateFieldBeginSignature = TemplateFieldSignature + ':';
    179187  TemplateFieldEndSignature = '}';
     188  ScreenReaderCodeSignature = '{SR-';
     189  ScreenReaderCodeType = '  Screen Reader Code';
     190  ScreenReaderCodeCount = 2;
     191  ScreenReaderShownCount = 1;
     192  ScreenReaderStopCode = ScreenReaderCodeSignature + 'STOP' + TemplateFieldEndSignature;
     193  ScreenReaderStopCodeLen = Length(ScreenReaderStopCode);
     194  ScreenReaderStopCodeID = '-43';
     195  ScreenReaderStopName = 'SCREEN READER STOP CODE **';
     196  ScreenReaderStopCodeLine = ScreenReaderStopCodeID + U + ScreenReaderStopName + U + ScreenReaderCodeType;
     197  ScreenReaderContinueCode = ScreenReaderCodeSignature + 'CONT' + TemplateFieldEndSignature;
     198  ScreenReaderContinueCodeLen = Length(ScreenReaderContinueCode);
     199  ScreenReaderContinueCodeOld = ScreenReaderCodeSignature + 'CONTINUE' + TemplateFieldEndSignature;
     200  ScreenReaderContinueCodeOldLen = Length(ScreenReaderContinueCodeOld);
     201  ScreenReaderContinueCodeID = '-44';
     202  ScreenReaderContinueCodeName = 'SCREEN READER CONTINUE CODE ***';
     203  ScreenReaderContinueCodeLine = ScreenReaderContinueCodeID + U + ScreenReaderContinueCodeName + U + ScreenReaderCodeType;
    180204  MissingFieldsTxt = 'One or more required fields must still be entered.';
     205
     206  ScreenReaderCodes:     array[0..ScreenReaderCodeCount] of string  =
     207      (ScreenReaderStopCode, ScreenReaderContinueCode, ScreenReaderContinueCodeOld);
     208  ScreenReaderCodeLens:  array[0..ScreenReaderCodeCount] of integer =
     209      (ScreenReaderStopCodeLen, ScreenReaderContinueCodeLen, ScreenReaderContinueCodeOldLen);
     210  ScreenReaderCodeIDs:   array[0..ScreenReaderShownCount] of string  =
     211      (ScreenReaderStopCodeID, ScreenReaderContinueCodeID);
     212  ScreenReaderCodeLines: array[0..ScreenReaderShownCount] of string  =
     213      (ScreenReaderStopCodeLine, ScreenReaderContinueCodeLine);
    181214
    182215  TemplateFieldTypeCodes: array[TTemplateFieldType] of string[1] =
    … …  
    191224                         {  dftHyperlink    }  'H',
    192225                         {  dftWP           }  'W',
    193                          {  dftText         }  'T');
     226                         {  dftText         }  'T',
     227                         {  dftScreenReader }  'S');
    194228
    195229  TemplateFieldTypeDesc: array[TTemplateFieldType, boolean] of string =
    196230                         {  dftUnknown      } (('',''),
    197                          {  dftEditBox      }  ('Edit Box',       'Edit'),
    198                          {  dftComboBox     }  ('Combo Box',      'Combo'),
    199                          {  dftButton       }  ('Button',         'Button'),
    200                          {  dftCheckBoxes   }  ('Check Boxes',    'Check'),
    201                          {  dftRadioButtons }  ('Radio Buttons',  'Radio'),
    202                          {  dftDate         }  ('Date',           'Date'),
    203                          {  dftNumber       }  ('Number',         'Num'),
    204                          {  dftHyperlink    }  ('Hyperlink',      'Link'),
    205                          {  dftWP           }  ('Word Processing','WP'),
    206                          {  dftWP           }  ('Display Text',   'Text'));
     231                         {  dftEditBox      }  ('Edit Box',           'Edit'),
     232                         {  dftComboBox     }  ('Combo Box',          'Combo'),
     233                         {  dftButton       }  ('Button',             'Button'),
     234                         {  dftCheckBoxes   }  ('Check Boxes',        'Check'),
     235                         {  dftRadioButtons }  ('Radio Buttons',      'Radio'),
     236                         {  dftDate         }  ('Date',               'Date'),
     237                         {  dftNumber       }  ('Number',             'Num'),
     238                         {  dftHyperlink    }  ('Hyperlink',          'Link'),
     239                         {  dftWP           }  ('Word Processing',    'WP'),
     240                         {  dftText         }  ('Display Text',       'Text'),
     241                         {  dftScreenReader }  ('Screen Reader Stop', 'SRStop'));
    207242
    208243  TemplateDateTypeDesc: array[TTmplFldDateType, boolean] of string =
    … …  
    226261                   { dftHyperlink    }  'LINK',
    227262                   { dftWP           }  'WRDP',
    228                    { dftTExt         }  'TEXT');
     263                   { dftTExt         }  'TEXT',
     264                   { dftScreenReader }  'SRST');
    229265
    230266  TemplateFieldDateCodes: array[TTmplFldDateType] of string[1] =
    … …  
    239275  MaxTFWPLines = 20;
    240276  MaxTFEdtLen = 70;
    241 
    242 type
    243   TFieldPanel = class(TPanel)  {This is the panel associated with the child}
    244   private                      {dialog checkboxes in reminders dialogs}
    245     FOnDestroy: TNotifyEvent;
    246     FCanvas: TControlCanvas;    {used to draw focus rect}
    247     function GetFocus: boolean;
    248     procedure SetTheFocus(const Value: boolean);
    249   protected                     {used to draw focus rect}
    250     procedure Paint; override;  {used to draw focus rect}
    251   public
    252     destructor Destroy; override;
    253     property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
    254     property Focus:  boolean read GetFocus write SetTheFocus; {to draw focus rect}
    255     property OnKeyPress;        {to click the checkbox when spacebar is pressed}
    256   end;
    257 
     277 
    258278implementation
    259279
    260280uses
    261   ORFn, rTemplates, ORCtrls, mTemplateFieldButton, dShared, uConst, uCore, rCore, Windows;
     281  rTemplates, ORCtrls, mTemplateFieldButton, dShared, uConst, uCore, rCore, Windows,
     282  VAUtils, VA508AccessibilityManager, VA508AccessibilityRouter;
    262283
    263284const
    … …  
    279300  FieldIDLen = 6;
    280301  NewLine = 'NL';
    281 
    282 type
    283   TFieldLabel = class(TLabel)
    284   private
    285     FExclude: boolean;
    286   public
    287     property Exclude: boolean read FExclude;
    288   end;
    289  
    290   TWebLabel = class(TFieldLabel)
    291   private
    292     FAddr: string;
    293     procedure Clicked(Sender: TObject);
    294   public
    295     procedure Init(Addr: string);
    296   end;
    297302
    298303function GetNewFieldID: string;
    … …  
    694699  Result := (msg <> '');
    695700  if(Result) then
    696     ShowMessage(msg);
     701    ShowMsg(msg);
    697702end;
    698703
    … …  
    861866          AList.Add('');
    862867        AList.Add('The following inactive template fields were found:');
    863         AList.AddStrings(InactiveList);
     868        FastAddStrings(InactiveList, AList);
    864869      end;
    865870      if(AList.Count > 0) then
    … …  
    10791084  dbox: TORDateBox;
    10801085  dcbo: TORDateCombo;
    1081   lbl: TFieldLabel;
     1086  lbl: TCPRSTemplateFieldLabel;
    10821087  re: TRichEdit;
    1083   pnl: TPanel;
    1084   ud: TUpDown;
     1088  pnl: TCPRSDialogNumber;
    10851089  DefDate: TFMDateTime;
    10861090  ctrl: TControl;
    … …  
    11231127      dftEditBox:
    11241128        begin
    1125           edt := TEdit.Create(nil);
     1129          edt := TCPRSDialogFieldEdit.Create(nil);
     1130          (edt as ICPRSDialogComponent).RequiredField := Required;
    11261131          edt.Parent := Entry.FPanel;
    11271132          edt.BorderStyle := bsNone;
    … …  
    11351140          edt.Tag := CtrlID;
    11361141          edt.OnChange := Entry.DoChange;
     1142          UpdateColorsFor508Compliance(edt, TRUE);
    11371143          ctrl := edt;
    11381144        end;
    … …  
    11401146      dftComboBox:
    11411147        begin
    1142           cbo := TORComboBox.Create(nil);
     1148          cbo := TCPRSDialogComboBox.Create(nil);
     1149          (cbo as ICPRSDialogComponent).RequiredField := Required;
    11431150          cbo.Parent := Entry.FPanel;
    11441151          cbo.TemplateField := TRUE;
    … …  
    11651172            cbo.DropDownCount := cbo.Items.Count;
    11661173          end;
     1174          UpdateColorsFor508Compliance(cbo, TRUE);
    11671175          ctrl := cbo;
    11681176        end;
    … …  
    11711179        begin
    11721180          btn := TfraTemplateFieldButton.Create(nil);
     1181          (btn as ICPRSDialogComponent).RequiredField := Required;
    11731182          btn.Parent := Entry.FPanel;
    11741183          {Clear out embedded fields}
    … …  
    11791188          btn.Tag := CtrlID;
    11801189          btn.OnChange := Entry.DoChange;
     1190          UpdateColorsFor508Compliance(btn);
    11811191          ctrl := btn;
    11821192        end;
    … …  
    11921202            for i := 0 to TmpSL.Count-1 do
    11931203            begin
    1194               cb := TORCheckBox.Create(nil);
     1204              cb := TCPRSDialogCheckBox.Create(nil);
     1205              if i = 0 then
     1206                (cb as ICPRSDialogComponent).RequiredField := Required;
    11951207              cb.Parent := Entry.FPanel;
    11961208              cb.Caption := TmpSL[i];
    … …  
    12101222                cb.StringData := NewLine;
    12111223              cb.OnClick := Entry.DoChange;
     1224              UpdateColorsFor508Compliance(cb);
    12121225              inc(Index);
    12131226              Entry.FControls.InsertObject(Index, '', cb);
    … …  
    12281241          if FDateType in DateComboTypes then
    12291242          begin
    1230             dcbo := TORDateCombo.Create(nil);
     1243            dcbo := TCPRSDialogDateCombo.Create(nil);
     1244            (dcbo as ICPRSDialogComponent).RequiredField := Required;
    12311245            dcbo.Parent := Entry.FPanel;
    12321246            dcbo.Tag := CtrlID;
    … …  
    12371251            dcbo.TemplateField := TRUE;
    12381252            dcbo.OnChange := Entry.DoChange;
     1253            UpdateColorsFor508Compliance(dcbo, TRUE);
    12391254            ctrl := dcbo;
    12401255          end
    12411256          else
    12421257          begin
    1243             dbox := TORDateBox.Create(nil);
     1258            dbox := TCPRSDialogDateBox.Create(nil);
     1259            (dbox as ICPRSDialogComponent).RequiredField := Required;
    12441260            dbox.Parent := Entry.FPanel;
    12451261            dbox.Tag := CtrlID;
    … …  
    12541270            dbox.Width := (wdth * tmp) + 18;
    12551271            dbox.OnChange := Entry.DoChange;
     1272            UpdateColorsFor508Compliance(dbox, TRUE);
    12561273            ctrl := dbox;
    12571274          end;
    … …  
    12601277      dftNumber:
    12611278        begin
    1262           pnl := TPanel.Create(nil);
     1279          pnl := TCPRSDialogNumber.CreatePanel(nil);
     1280          (pnl as ICPRSDialogComponent).RequiredField := Required;
    12631281          pnl.Parent := Entry.FPanel;
    12641282          pnl.BevelOuter := bvNone;
    12651283          pnl.Tag := CtrlID;
    1266           edt := TEdit.Create(pnl);
    1267           edt.Parent := pnl;
    1268           edt.BorderStyle := bsNone;
    1269           edt.Height := ht;
    1270           edt.Width := (wdth * 5 + 4);
    1271           edt.Top := 0;
    1272           edt.Left := 0;
    1273           edt.AutoSelect := True;
    1274           ud := TUpDown.Create(pnl);
    1275           ud.Parent := pnl;
    1276           ud.Associate := edt;
    1277           ud.Min := MinVal;
    1278           ud.Max := MaxVal;
    1279           ud.Min := MinVal; // Both ud.Min settings are needeed!
     1284          pnl.Edit.Height := ht;
     1285          pnl.Edit.Width := (wdth * 5 + 4);
     1286          pnl.UpDown.Min := MinVal;
     1287          pnl.UpDown.Max := MaxVal;
     1288          pnl.UpDown.Min := MinVal; // Both ud.Min settings are needeed!
    12801289          i := Increment;
    12811290          if i < 1 then i := 1;
    1282           ud.Increment := i;
    1283           ud.Thousands := FALSE;
    1284           ud.Position := StrToIntDef(EditDefault, 0);
    1285           edt.Tag := Integer(ud);
    1286           edt.OnChange := Entry.UpDownChange;
    1287           pnl.Height := edt.Height;
    1288           pnl.Width := edt.Width + ud.Width;
     1291          pnl.UpDown.Increment := i;
     1292          pnl.UpDown.Position := StrToIntDef(EditDefault, 0);
     1293          pnl.Edit.OnChange := Entry.UpDownChange;
     1294          pnl.Height := pnl.Edit.Height;
     1295          pnl.Width := pnl.Edit.Width + pnl.UpDown.Width;
     1296          UpdateColorsFor508Compliance(pnl, TRUE);
    12891297          ctrl := pnl;
    12901298        end;
    … …  
    12931301        begin
    12941302          if (FFldType = dftHyperlink) and User.WebAccess then
    1295             lbl := TWebLabel.Create(nil)
     1303            lbl := TCPRSDialogHyperlinkLabel.Create(nil)
    12961304          else
    1297             lbl := TFieldLabel.Create(nil);
     1305            lbl := TCPRSTemplateFieldLabel.Create(nil);
    12981306          lbl.Parent := Entry.FPanel;
    12991307          lbl.ShowAccelChar := FALSE;
    1300           lbl.FExclude := FSepLines;
     1308          lbl.Exclude := FSepLines;
    13011309          if (FFldType = dftHyperlink) then
    13021310          begin
    … …  
    13131321            lbl.Caption := STmp;
    13141322          end;
    1315           if lbl is TWebLabel then
    1316             TWebLabel(lbl).Init(FURL);
     1323          if lbl is TCPRSDialogHyperlinkLabel then
     1324            TCPRSDialogHyperlinkLabel(lbl).Init(FURL);
    13171325          lbl.Tag := CtrlID;
     1326          UpdateColorsFor508Compliance(lbl);
    13181327          ctrl := lbl;
    13191328        end;
    … …  
    13211330      dftWP:
    13221331        begin
    1323           re := TRichEdit.Create(nil);
     1332          re := TCPRSDialogRichEdit.Create(nil);
     1333          (re as ICPRSDialogComponent).RequiredField := Required;
    13241334          re.Parent := Entry.FPanel;
    13251335          re.Tag := CtrlID;
    … …  
    13391349          re.Lines.Text := Items;
    13401350          re.OnChange := Entry.DoChange;
     1351          UpdateColorsFor508Compliance(re, TRUE);
    13411352          ctrl := re;
    13421353        end;
    … …  
    13581369    Result := FLocked;
    13591370    if(not FLocked) then
    1360       ShowMessage('Template Field ' + FFldName + ' is currently being edited by another user.');
     1371      ShowMsg('Template Field ' + FFldName + ' is currently being edited by another user.');
    13611372  end
    13621373  else
    … …  
    17071718const
    17081719  EOL_MARKER = #182;
     1720  SR_BREAK   = #186;
    17091721
    17101722procedure PanelDestroy(AData: Pointer; Sender: TObject);
    … …  
    17371749  FControls.Text := Text;
    17381750  if(FControls.Count > 1) then
     1751  begin
    17391752    for i := 1 to FControls.Count-1 do
    17401753      FControls[i] := EOL_MARKER + FControls[i];
     1754    if not ScreenReaderSystemActive then
     1755      StripScreenReaderCodes(FControls);
     1756  end;
    17411757  FFirstBuild := TRUE;
    1742   FPanel := TFieldPanel.Create(AParent.Owner);
     1758  FPanel := TDlgFieldPanel.Create(AParent.Owner);
    17431759  FPanel.Parent := AParent;
    17441760  FPanel.BevelOuter := bvNone;
    17451761  FPanel.Caption := '';
    17461762  FPanel.Font.Assign(FFont);
     1763  UpdateColorsFor508Compliance(FPanel, TRUE);
    17471764  idx := 0;
    17481765  while (idx < FControls.Count) do
    … …  
    17711788          FControls[idx] := copy(txt,1,i-1);
    17721789          if(Fld.Required) then
     1790          begin
     1791            if ScreenReaderSystemActive then
     1792            begin
     1793              if Fld.FFldType in [dftCheckBoxes, dftRadioButtons] then
     1794                FControls[idx] := FControls[idx] + ScreenReaderStopCode;
     1795            end;
    17731796            FControls[idx] := FControls[idx] + '*';
     1797          end;
    17741798          Fld.CreateDialogControls(Self, idx, CtrlID);
    17751799          FControls.Insert(idx+1,copy(txt,i,MaxInt));
    … …  
    17891813    end;
    17901814    inc(idx);
     1815  end;
     1816  if ScreenReaderSystemActive then
     1817  begin
     1818    idx := 0;
     1819    while (idx < FControls.Count) do
     1820    begin
     1821      txt := FControls[idx];
     1822      i := pos(ScreenReaderStopCode, txt);
     1823      if i > 0 then
     1824      begin
     1825        FControls[idx] := copy(txt, 1, i-1);
     1826        txt := copy(txt, i + ScreenReaderStopCodeLen, MaxInt);
     1827        FControls.Insert(idx+1, SR_BREAK + txt);
     1828      end;
     1829      inc(idx);
     1830    end;
    17911831  end;
    17921832end;
    … …  
    18671907          ind := 0;
    18681908      end;
    1869       if(Ctrl is TFieldLabel) then
    1870       begin
    1871         if not TFieldLabel(Ctrl).Exclude then begin
     1909      if(Ctrl is TCPRSTemplateFieldLabel) then
     1910      begin
     1911        if not TCPRSTemplateFieldLabel(Ctrl).Exclude then begin
    18721912          if emField <> '' then begin
    18731913            iField := GetTemplateField(emField,FALSE);
    … …  
    18841924                            end;
    18851925            else {case}
    1886               Result := TFieldLabel(Ctrl).Caption
     1926              Result := TCPRSTemplateFieldLabel(Ctrl).Caption
    18871927            end; {case iField.FldType}
    18881928            end {if emField}
    18891929          else
    1890             Result := TFieldLabel(Ctrl).Caption;
     1930            Result := TCPRSTemplateFieldLabel(Ctrl).Caption;
    18911931        end;
    18921932      end
    … …  
    20142054end;
    20152055
    2016 function TTemplateDialogEntry.GetPanel(MaxLen: integer; AParent: TWinControl): TPanel;
    2017 var
    2018   i, x, y, cnt, idx, ind, yinc, ybase, MaxX: integer;
     2056function TTemplateDialogEntry.GetPanel(MaxLen: integer; AParent: TWinControl;
     2057                                       OwningCheckBox: TCPRSDialogParentCheckBox): TDlgFieldPanel;
     2058var
     2059  i, x, y, cnt, idx, ind, yinc, ybase, MaxX: integer;
    20192060  MaxTextLen: integer;  {Max num of chars per line in pixels}
    20202061  MaxChars: integer;    {Max num of chars per line}
    … …  
    20222063  ctrl: TControl;
    20232064  LastLineBlank: boolean;
     2065  sLbl: TCPRSDialogStaticLabel;
     2066  nLbl: TVA508ChainedLabel;
     2067  sLblHeight: integer;
     2068  TabOrdr: integer;
     2069
    20242070const
    20252071  FOCUS_RECT_MARGIN = 2; {The margin around the panel so the label won't
    20262072                        overlay the focus rect on its parent panel.}
     2073
     2074  procedure Add2TabOrder(ctrl: TWinControl);
     2075  begin
     2076    ctrl.TabOrder := TabOrdr;
     2077    inc(TabOrdr);
     2078  end;
     2079
     2080  function StripSRCode(var txt: string; code: string; len: integer): integer;
     2081  begin
     2082    Result := pos(code, txt);
     2083    if Result > 0 then
     2084    begin
     2085      delete(txt,Result,len);
     2086      dec(Result);
     2087    end
     2088    else
     2089      Result := -1;
     2090  end;
     2091
    20272092  procedure DoLabel(Atxt: string);
    20282093  var
    2029     lbl: TLabel;
    2030 
    2031   begin
    2032     lbl := TLabel.Create(nil);
    2033     lbl.Parent := FPanel;
    2034     lbl.ShowAccelChar := FALSE;
    2035     lbl.Caption := Atxt;
    2036     lbl.Left := x;
    2037     lbl.Top := y;
    2038     inc(x, lbl.Width);
    2039   end;
    2040 
    2041   procedure NextLine;
    2042   begin
    2043     if(MaxX < x) then
    2044       MaxX := x;
    2045     x := FOCUS_RECT_MARGIN;  {leave two pixels on the left for the Focus Rect}
    2046     inc(y, yinc);
    2047     yinc := ybase;
    2048   end;
    2049 
    2050 begin
    2051   MaxTextLen := MaxLen - (FOCUS_RECT_MARGIN * 2);{save room for the focus rectangle on the panel}
    2052   if(FFirstBuild or (FPanel.Width <> MaxLen)) then
     2094    ctrl: TControl;
     2095    tempLbl: TVA508ChainedLabel;
     2096
     2097  begin
     2098    if ScreenReaderSystemActive then
     2099    begin
     2100      if assigned(sLbl) then
     2101      begin
     2102        tempLbl := TVA508ChainedLabel.Create(nil);
     2103        if assigned(nLbl) then
     2104          nLbl.NextLabel := tempLbl
     2105        else
     2106          sLbl.NextLabel := tempLbl;
     2107        nLbl := tempLbl;
     2108        ctrl := nLbl;
     2109      end
     2110      else
     2111      begin
     2112        sLbl := TCPRSDialogStaticLabel.Create(nil);
     2113        ctrl := sLbl;
     2114      end;
     2115    end
     2116    else
     2117      ctrl := TLabel.Create(nil);
     2118    SetOrdProp(ctrl, ShowAccelCharProperty, ord(FALSE));
     2119    SetStrProp(ctrl, CaptionProperty, Atxt);
     2120    ctrl.Parent := FPanel;
     2121    ctrl.Left := x;
     2122    ctrl.Top := y;
     2123    if ctrl = sLbl then
     2124    begin
     2125      Add2TabOrder(sLbl);
     2126      sLbl.Height := sLblHeight;
     2127      ScreenReaderSystem_CurrentLabel(sLbl);
     2128    end;
     2129    if ScreenReaderSystemActive then
     2130      ScreenReaderSystem_AddText(Atxt);
     2131    UpdateColorsFor508Compliance(ctrl);
     2132    inc(x, ctrl.Width);
     2133  end;
     2134
     2135  procedure Init;
     2136  var
     2137    lbl : TLabel;
    20532138  begin
    20542139    if(FFirstBuild) then
    … …  
    20612146    //ybase := FontHeightPixel(FFont.Handle) + 1 + (FOCUS_RECT_MARGIN * 2);  AGP commentout line for
    20622147                                                                           //reminder spacing
    2063     ybase := FontHeightPixel(FFont.Handle);
     2148    ybase := FontHeightPixel(FFont.Handle) + 2;
    20642149    yinc := ybase;
    20652150    LastLineBlank := FALSE;
     2151    sLbl := nil;
     2152    nLbl := nil;
     2153    TabOrdr := 0;
     2154    if ScreenReaderSystemActive then
     2155    begin
     2156      ScreenReaderSystem_CurrentCheckBox(OwningCheckBox);
     2157      lbl := TLabel.Create(nil);
     2158      try
     2159        lbl.Parent := FPanel;
     2160        sLblHeight := lbl.Height + 2;
     2161      finally
     2162        lbl.Free;
     2163      end;
     2164
     2165    end;
     2166  end;
     2167
     2168  procedure Text508Work;
     2169  var
     2170    ContinueCode: boolean;
     2171  begin
     2172    if StripCode(txt, SR_BREAK) then
     2173    begin
     2174      ScreenReaderSystem_Stop;
     2175      nLbl := nil;
     2176      sLbl := nil;
     2177    end;
     2178
     2179    ContinueCode := FALSE;
     2180    while StripSRCode(txt, ScreenReaderContinueCode, ScreenReaderContinueCodeLen) >= 0 do
     2181      ContinueCode := TRUE;
     2182    while StripSRCode(txt, ScreenReaderContinueCodeOld, ScreenReaderContinueCodeOldLen) >= 0 do
     2183      ContinueCode := TRUE;
     2184    if ContinueCode then
     2185      ScreenReaderSystem_Continue;
     2186  end;
     2187
     2188  procedure Ctrl508Work(ctrl: TControl);
     2189  var
     2190    lbl: TCPRSTemplateFieldLabel;
     2191  begin
     2192    if (Ctrl is TCPRSTemplateFieldLabel) and (not (Ctrl is TCPRSDialogHyperlinkLabel)) then
     2193    begin
     2194      lbl := Ctrl as TCPRSTemplateFieldLabel;
     2195      if trim(lbl.Caption) <> '' then
     2196      begin
     2197        ScreenReaderSystem_CurrentLabel(lbl);
     2198        ScreenReaderSystem_AddText(lbl.Caption);
     2199      end
     2200      else
     2201      begin
     2202        lbl.TabStop := FALSE;
     2203        ScreenReaderSystem_Stop;
     2204      end;
     2205    end
     2206    else
     2207    begin
     2208      if ctrl is TWinControl then
     2209        Add2TabOrder(TWinControl(ctrl));
     2210      if Supports(ctrl, ICPRSDialogComponent) then
     2211        ScreenReaderSystem_CurrentComponent(ctrl as ICPRSDialogComponent);
     2212    end;
     2213    sLbl := nil;
     2214    nLbl := nil;
     2215  end;
     2216
     2217  procedure NextLine;
     2218  begin
     2219    if(MaxX < x) then
     2220      MaxX := x;
     2221    x := FOCUS_RECT_MARGIN;  {leave two pixels on the left for the Focus Rect}
     2222    inc(y, yinc);
     2223    yinc := ybase;
     2224  end;
     2225
     2226begin
     2227  MaxTextLen := MaxLen - (FOCUS_RECT_MARGIN * 2);{save room for the focus rectangle on the panel}
     2228  if(FFirstBuild or (FPanel.Width <> MaxLen)) then
     2229  begin
     2230    Init;
    20662231    for i := 0 to FControls.Count-1 do
    20672232    begin
    20682233      txt := FControls[i];
    2069       if(copy(txt,1,1) = EOL_MARKER) then
     2234      if ScreenReaderSystemActive then
     2235        Text508Work;
     2236      if StripCode(txt,EOL_MARKER) then
    20702237      begin
    20712238        if((x <> 0) or LastLineBlank) then
    20722239          NextLine;
    2073         delete(txt,1,1);
    20742240        LastLineBlank := (txt = '');
    20752241      end;
    … …  
    21202286        if(assigned(ctrl)) then
    21212287        begin
     2288          if ScreenReaderSystemActive then
     2289            Ctrl508Work(ctrl);
    21222290          idx := FIndents.IndexOfObject(Ctrl);
    21232291          if idx >= 0 then
    … …  
    21372305          inc(x, Ctrl.Width + 4);
    21382306          if yinc <= Ctrl.Height then
    2139             yinc := Ctrl.Height + 1;
     2307            yinc := Ctrl.Height + 2;
    21402308          if (x < MaxLen) and ((Ctrl is TRichEdit) or
    21412309             ((Ctrl is TLabel) and (pos(CRLF, TLabel(Ctrl).Caption) > 0))) then
    … …  
    21502318  if(FFieldValues <> '') then
    21512319    SetFieldValues(FFieldValues);
     2320  if ScreenReaderSystemActive then
     2321    ScreenReaderSystem_Stop;
    21522322  Result := FPanel;
    21532323end;
    … …  
    21622332  i, idx: integer;
    21632333  obj: TObject;
     2334  max: integer;
    21642335
    21652336begin
    21662337  if(assigned(FPanel)) then
    21672338  begin
    2168     for i := FPanel.ControlCount-1 downto 0 do
    2169       if(FPanel.Controls[i] is TLabel) then
     2339    max := FPanel.ControlCount-1;
     2340    for i := max downto 0 do
     2341    begin
     2342// deleting TVA508StaticText can delete several TVA508ChainedLabel components
     2343      if i < FPanel.ControlCount then
    21702344      begin
    21712345        obj := FPanel.Controls[i];
    2172         idx := FControls.IndexOfObject(obj);
    2173         if idx < 0 then
    2174           obj.Free;
    2175       end;
     2346        if (not (obj is TVA508ChainedLabel)) and
     2347           ((obj is TLabel) or (obj is TVA508StaticText)) then
     2348        begin
     2349          idx := FControls.IndexOfObject(obj);
     2350          if idx < 0 then
     2351            obj.Free;
     2352        end;
     2353      end;
     2354    end;
    21762355  end;
    21772356end;
    … …  
    21882367    M.Data := Self;
    21892368    M.Code := @PanelDestroy;
    2190     TFieldPanel(FPanel).OnDestroy := TNotifyEvent(M);
     2369    FPanel.OnDestroy := TNotifyEvent(M);
    21912370  end
    21922371  else
    2193     TFieldPanel(FPanel).OnDestroy := nil;
     2372    FPanel.OnDestroy := nil;
    21942373end;
    21952374
    … …  
    22322411        begin
    22332412          Done := FALSE;
     2413          TORCheckBox(Ctrl).Checked := FALSE;        //<-PSI-06-170-ADDED THIS LINE - v27.23 - RV
    22342414          if(cnt = 0) then
    22352415            cnt := DelimCount(AText, '|') + 1;
    … …  
    22782458end;
    22792459
     2460function TTemplateDialogEntry.StripCode(var txt: string; code: char): boolean;
     2461var
     2462  p: integer;
     2463begin
     2464  p := pos(code, txt);
     2465  Result := (p > 0);
     2466  if Result then
     2467  begin
     2468    while p > 0 do
     2469    begin
     2470      delete(txt, p, 1);
     2471      p := pos(code, txt);
     2472    end;
     2473  end;
     2474end;
     2475
    22802476procedure TTemplateDialogEntry.UpDownChange(Sender: TObject);
    22812477begin
    22822478  EnsureText(TEdit(Sender), TUpDown(TEdit(Sender).Tag));
    22832479  DoChange(Sender);
    2284 end;
    2285 
    2286 { TFieldPanel }
    2287 
    2288 destructor TFieldPanel.Destroy;
    2289 begin
    2290   if(assigned(FOnDestroy)) then
    2291     FOnDestroy(Self);
    2292   inherited;
    2293 end;
    2294 
    2295 {intercept the paint event to draw the focus rect if FFocused is true}
    2296 function TFieldPanel.GetFocus: boolean;
    2297 begin
    2298   result := Focused;
    2299 end;
    2300 
    2301 procedure TFieldPanel.Paint;
    2302 var
    2303   DC: HDC;
    2304   R: TRect;
    2305 
    2306 begin
    2307   inherited;
    2308   if(Focused) then
    2309   begin
    2310     if(not assigned(FCanvas)) then
    2311       FCanvas := TControlCanvas.Create;
    2312     DC := GetWindowDC(Handle);
    2313     try
    2314       FCanvas.Handle := DC;
    2315       R := ClientRect;
    2316       InflateRect(R, -1, -1);
    2317       FCanvas.DrawFocusRect(R);
    2318     finally
    2319       ReleaseDC(Handle, DC);
    2320     end;
    2321   end;
    2322 end;
    2323 
    2324 procedure TFieldPanel.SetTheFocus(const Value: boolean);
    2325 begin
    2326   if Value then
    2327     SetFocus;
    2328 end;
    2329 
    2330 { TWebLabel }
    2331 
    2332 procedure TWebLabel.Clicked(Sender: TObject);
    2333 begin
    2334   GotoWebPage(FAddr);
    2335 end;
    2336 
    2337 procedure TWebLabel.Init(Addr: string);
    2338 begin
    2339   FAddr := Addr;
    2340   OnClick := Clicked;
    2341   Font.Assign(TORExposedControl(Parent).Font);
    2342   Font.Color := clActiveCaption;
    2343   Font.Style := Font.Style + [fsUnderline];
    2344   AdjustBounds; // make sure we have the right width
    2345   AutoSize := FALSE;
    2346   Height := Height + 1; // Courier New doesn't support underline unless it's higher
    2347   Cursor := crHandPoint;
    23482480end;
    23492481
    … …  
    23712503end;
    23722504
     2505procedure StripScreenReaderCodes(var Text: string);
     2506var
     2507  p, j: integer;
     2508begin
     2509  for j := low(ScreenReaderCodes) to high(ScreenReaderCodes) do
     2510  begin
     2511    p := 1;
     2512    while (p > 0) do
     2513    begin
     2514      p := posex(ScreenReaderCodes[j], Text, p);
     2515      if p > 0 then
     2516        delete(Text, p, ScreenReaderCodeLens[j]);
     2517    end;
     2518  end;
     2519end;
     2520
     2521procedure StripScreenReaderCodes(SL: TStrings);
     2522var
     2523  temp: string;
     2524  i: integer;
     2525
     2526begin
     2527  for i := 0 to SL.Count - 1 do
     2528  begin
     2529    temp := SL[i];
     2530    StripScreenReaderCodes(temp);
     2531    SL[i] := temp;
     2532  end;
     2533end;
     2534
     2535function HasScreenReaderBreakCodes(SL: TStrings): boolean;
     2536var
     2537  i: integer;
     2538
     2539begin
     2540  Result := TRUE;
     2541  for i := 0 to SL.Count - 1 do
     2542  begin
     2543    if pos(ScreenReaderCodeSignature, SL[i]) > 0 then
     2544      exit;
     2545  end;
     2546  Result := FALSE;
     2547end;
     2548
    23732549initialization
    23742550

  • cprs/trunk/CPRS-Chart/Templates/uTemplates.pas

    r456 r829  
    253253function MakeXMLParamTIU(ADCSummID: string; ADCSummRec: TEditDCSummRec): string;  overload;
    254254function GetXMLParamReturnValueTIU(DocInfo, ParamTag: string): string;
     255procedure UpdatePersonalObjects;
     256procedure SetTemplateDialogCanceled(value: Boolean);
     257function WasTemplateDialogCanceled: Boolean;
     258procedure SetTemplateBPHasObjects(value: Boolean);
     259function TemplateBPHasObjects: Boolean;
    255260
    256261const
    … …  
    278283  ConsultsTemplate: TTemplate = nil;
    279284  ProceduresTemplate: TTemplate = nil;
     285  uPersonalObjects: TStringList = nil;   // -------- CQ #8665 - RV ------------
    280286
    281287implementation
    … …  
    283289uses
    284290  Windows, rTemplates, uCore, dShared, fTemplateDialog, ActiveX, ComObj, uTemplateFields,
    285   XMLUtils, fTemplateImport, Word97, uSpell, rCore, uConst, ORCtrls, uEventHooks,
    286   fReminderDialog, rODBase;
     291  XMLUtils, fTemplateImport, uSpell, rCore, uConst, ORCtrls, uEventHooks,
     292  fReminderDialog, rODBase
     293  {$IFDEF VER140}
     294  , Word97;
     295  {$ELSE}
     296  , WordXP, VAUtils;
     297  {$ENDIF}
    287298
    288299const
    … …  
    311322  uDGroupConsults: integer = 0;
    312323  uDGroupProcedures: integer = 0;
     324  uTemplateDialogCanceled: Boolean = FALSE;
     325  uTemplateBPHasObjects: Boolean = FALSE;
    313326
    314327type
    … …  
    531544      try
    532545        GetTemplateRoots;
    533         TmpSL.Assign(RPCBrokerV.Results);
     546        FastAssign(RPCBrokerV.Results, TmpSL);
    534547        for i := 0 to TmpSL.Count-1 do
    535548          AddTemplate(TmpSL[i]);
    … …  
    559572        try
    560573          GetTemplateChildren(tmpl.FID);
    561           TmpSL.Assign(RPCBrokerV.Results);
     574          FastAssign(RPCBrokerV.Results, TmpSL);
    562575          for i := 0 to TmpSL.Count-1 do
    563576            AddTemplate(TmpSL[i], tmpl);
    … …  
    597610    TempSL := nil;
    598611  end;
     612  // -------- CQ #8665 - RV ------------
     613  if (assigned(uPersonalObjects)) then
     614  begin
     615    KillObj(@uPersonalObjects);
     616    uPersonalObjects.Free;
     617    uPersonalObjects := nil;
     618  end;
     619  // ------end CQ #8665 ------------
    599620  if(assigned(Deleted)) then
    600621  begin
    … …  
    721742begin
    722743  if(assigned(Errors)) then
    723     ShowMessage(Errors.text)
     744    ShowMsg(Errors.text)
    724745  else
    725     ShowMessage(SingleError);
     746    ShowMsg(SingleError);
    726747end;
    727748
    … …  
    865886        else
    866887          DescSL.Add('5,1=@');
    867         TempSL.AddStrings(DescSL)
     888        FastAddStrings(DescSL, TempSL)
    868889      finally
    869890        DescSL.Free;
    … …  
    11731194              WApp.Connect;
    11741195              TmpVar := AFileName;
     1196              {$IFDEF VER140}
    11751197              WDoc.ConnectTo(WApp.Documents.Add(TmpVar, EmptyParam));
     1198              {$ELSE}
     1199              WDoc.ConnectTo(WApp.Documents.Add(TmpVar, EmptyParam, EmptyParam, EmptyParam));
     1200              {$ENDIF}
    11761201              ffTotal := WDoc.FormFields.Count;
    11771202
    … …  
    13071332                            if tmp <> '' then
    13081333                              AddField(tfDefault, tmp);
    1309                             Fields.AddStrings(PendingAdd);
     1334                            FastAddStrings(PendingAdd, Fields);
    13101335                            PendingAdd.Clear;
    13111336                            AddFieldHeader(tmpType, FALSE);
    … …  
    13961421                          begin
    13971422                            Fields[0] := Fields[0] + IntToStr(Integer(FldCache.Objects[i])) + '">';
    1398                             Data.AddStrings(Fields);
     1423                            FastAddStrings(Fields, Data);
    13991424                          end;
    14001425                        end;
    … …  
    14861511
    14871512begin
     1513  SetTemplateDialogCanceled(FALSE);
     1514  SetTemplateBPHasObjects(FALSE);
    14881515  Template := GetLinkedTemplate(IntToStr(IEN), LType);
    14891516  if assigned(Template) then
    … …  
    18781905      try
    18791906        TmpSL.Text := FullBoilerPlate;
     1907        if Pos('|', TmpSL.Text) > 0 then SetTemplateBPHasObjects(TRUE);
    18801908      finally
    18811909        if(IsDialog) then
    … …  
    25502578        dmodShared.OnTemplateLock(Self)
    25512579      else
    2552         ShowMessage(Format(TemplateLockedText, [FPrintName]));
     2580        ShowMsg(Format(TemplateLockedText, [FPrintName]));
    25532581    end;
    25542582  end
    … …  
    28752903end;
    28762904
     2905// -------- CQ #8665 - RV ------------
     2906procedure UpdatePersonalObjects;
     2907var
     2908  i: integer;
     2909begin
     2910  if not assigned(uPersonalObjects) then
     2911  begin
     2912    uPersonalObjects := TStringList.Create;
     2913    GetAllowedPersonalObjects;
     2914    for i := 0 to RPCBrokerV.Results.Count-1 do
     2915      uPersonalObjects.Add(Piece(RPCBrokerV.Results[i],U,1));
     2916    uPersonalObjects.Sorted := TRUE;
     2917  end;
     2918end;
     2919// -----end CQ #8665 ------------
     2920
     2921
     2922procedure SetTemplateDialogCanceled(value: Boolean);
     2923begin
     2924  uTemplateDialogCanceled := value;
     2925end; 
     2926
     2927function WasTemplateDialogCanceled: Boolean;
     2928begin
     2929  Result := uTemplateDialogCanceled;
     2930end;
     2931
     2932procedure SetTemplateBPHasObjects(value: Boolean);
     2933begin
     2934  uTemplateBPHasObjects := value;
     2935end; 
     2936
     2937function TemplateBPHasObjects: Boolean;
     2938begin
     2939  Result := uTemplateBPHasObjects;
     2940end;
     2941
    28772942initialization
    28782943
    28792944finalization
    28802945  ReleaseTemplates;
    2881 
    28822946end.
     2947
Note: See TracChangeset for help on using the changeset viewer.