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

Upgrade to version 27

File:
1 edited

Legend:

Unmodified
Added
Removed

  • 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
Note: See TracChangeset for help on using the changeset viewer.