Index: cprs/trunk/CPRS-Chart/Templates/fFindingTemplates.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Templates/fFindingTemplates.dfm (revision 829) +++ cprs/trunk/CPRS-Chart/Templates/fFindingTemplates.dfm (revision 829) @@ -0,0 +1,67 @@ +object frmFindingTemplates: TfrmFindingTemplates + Left = 0 + Top = 0 + Cursor = crAppStart + BorderIcons = [] + Caption = 'Finding Template' + ClientHeight = 127 + ClientWidth = 229 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Tahoma' + Font.Style = [] + FormStyle = fsStayOnTop + OldCreateOrder = False + Position = poOwnerFormCenter + OnShow = FormShow + PixelsPerInch = 96 + TextHeight = 19 + object lblFind: TLabel + Left = 0 + Top = 50 + Width = 229 + Height = 23 + Align = alTop + Alignment = taCenter + Caption = 'Finding Template' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + ExplicitWidth = 146 + end + object Label2: TLabel + Left = 0 + Top = 73 + Width = 229 + Height = 19 + Align = alTop + Alignment = taCenter + Caption = '(This may take some time)' + ExplicitWidth = 190 + end + object animSearch: TAnimate + Left = 0 + Top = 0 + Width = 229 + Height = 50 + Align = alTop + CommonAVI = aviFindFolder + StopFrame = 29 + end + object btnCancel: TButton + Left = 80 + Top = 98 + Width = 75 + Height = 25 + Cancel = True + Caption = 'Cancel' + Default = True + TabOrder = 1 + OnClick = btnCancelClick + end +end Index: cprs/trunk/CPRS-Chart/Templates/fFindingTemplates.pas =================================================================== --- cprs/trunk/CPRS-Chart/Templates/fFindingTemplates.pas (revision 829) +++ cprs/trunk/CPRS-Chart/Templates/fFindingTemplates.pas (revision 829) @@ -0,0 +1,161 @@ +unit fFindingTemplates; + +interface + +uses + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, ComCtrls, DateUtils; + +type + TfrmFindingTemplates = class(TForm) + animSearch: TAnimate; + lblFind: TLabel; + Label2: TLabel; + btnCancel: TButton; + procedure FormShow(Sender: TObject); + procedure btnCancelClick(Sender: TObject); + private + FCanceled: boolean; + FSearchString: string; + FStarted: boolean; + FTree: TTreeView; + FStartNode: TTreeNode; + FCurrentNode :TTreeNode; + FIgnoreCase: boolean; + FWholeWords: boolean; + FFoundNode: TTreeNode; + FIsNext: boolean; + { Private declarations } + procedure Find; + public + end; + +function FindTemplate(SearchString: string; Tree: TTreeView; OwningForm: TForm; + StartNode: TTreeNode; IsNext, IgnoreCase, WholeWords: boolean): TTreeNode; + +implementation + +uses uTemplates, VAUtils, ORNet; + +{$R *.dfm} + +const + // search for 1 second before showing dialog - note some loading may have already + // taken place before this call. + DELAY_TIME = 1000; + MESSAGE_TIME = 0; + +function FindTemplate(SearchString: string; Tree: TTreeView; OwningForm: TForm; + StartNode: TTreeNode; IsNext, IgnoreCase, WholeWords: boolean): TTreeNode; +var + frmFindingTemplates: TfrmFindingTemplates; + msg: string; +begin + Result := nil; + if (SearchString = '') or (not assigned(Tree)) then exit; + frmFindingTemplates := TfrmFindingTemplates.Create(OwningForm); + try + with frmFindingTemplates do + begin + FSearchString := SearchString; + FTree := Tree; + FStartNode := StartNode; + FIgnoreCase := IgnoreCase; + FWholeWords := WholeWords; + FIsNext := IsNext; + if IsNext then + lblFind.Caption := 'Finding Next Template'; + Find; + if assigned(FFoundNode) then + begin + Result := FFoundNode; + end + else + begin + if FCanceled then + msg := 'Find Canceled.' + else + msg := 'Text not Found.'; + ShowMsg('Search Completed. ' + msg,'Find Template Failed', smiError); + end; + end; + finally + frmFindingTemplates.Free; + end; +end; + +procedure TfrmFindingTemplates.btnCancelClick(Sender: TObject); +begin + FCanceled := True; + btnCancel.Enabled := False; +end; + +procedure TfrmFindingTemplates.Find; +var + Found : boolean; + Text: String; + WindowList: Pointer; + NeedToShow: boolean; + StartTime: TDateTime; +begin + WindowList := nil; + NeedToShow := True; + StartTime := Now; + try + if(FIgnoreCase) then + FSearchString := UpperCase(FSearchString); + FCurrentNode := FStartNode; + Found := False; + if FIsNext and assigned(FCurrentNode) then + begin + FCurrentNode.Expand(False); + FCurrentNode := FCurrentNode.GetNext; + end; + while (not FCanceled) and (assigned(FCurrentNode) and (not Found)) do + begin + Application.ProcessMessages; + if not FCanceled then + begin + Text := FCurrentNode.Text; + if(FIgnoreCase) then + Text := UpperCase(Text); + Found := SearchMatch(FSearchString, Text, FWholeWords); + if(not Found) then + begin + FCurrentNode.Expand(False); + FCurrentNode := FCurrentNode.GetNext; + end; + if (not Found) and assigned(FCurrentNode) and NeedToShow then + begin + if MilliSecondsBetween(Now, StartTime) > DELAY_TIME then + begin + WindowList := DisableTaskWindows(0); + AppStartedCursorForm := Self; + Show; + NeedToShow := False; + end; + end; + end; + end; + if Found then + FFoundNode := FCurrentNode; + finally + if not NeedToShow then + begin + AppStartedCursorForm := nil; + EnableTaskWindows(WindowList); + Hide; + end; + end; +end; + +procedure TfrmFindingTemplates.FormShow(Sender: TObject); +begin + if not FStarted then + begin + FStarted := True; + animSearch.Active := True; + end; +end; + +end. Index: cprs/trunk/CPRS-Chart/Templates/fTemplateAutoGen.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Templates/fTemplateAutoGen.dfm (revision 456) +++ cprs/trunk/CPRS-Chart/Templates/fTemplateAutoGen.dfm (revision 829) @@ -1,3 +1,3 @@ -object frmTemplateAutoGen: TfrmTemplateAutoGen +inherited frmTemplateAutoGen: TfrmTemplateAutoGen Left = 361 Top = 230 @@ -8,16 +8,9 @@ ClientHeight = 213 ClientWidth = 415 - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - OldCreateOrder = False Position = poScreenCenter OnShow = FormShow PixelsPerInch = 96 TextHeight = 13 - object lblTop: TMemo + object lblTop: TMemo [0] Left = 256 Top = 8 @@ -35,5 +28,5 @@ TabOrder = 5 end - object lblSelect: TStaticText + object lblSelect: TStaticText [1] Left = 0 Top = 0 @@ -46,5 +39,5 @@ TabOrder = 6 end - object rgSource: TKeyClickRadioGroup + object rgSource: TKeyClickRadioGroup [2] Left = 256 Top = 88 @@ -59,5 +52,5 @@ OnClick = rgSourceClick end - object cbxObjects: TORComboBox + object cbxObjects: TORComboBox [3] Left = 0 Top = 0 @@ -74,4 +67,5 @@ ListItemsOnly = False LongList = False + LookupPiece = 0 MaxLength = 0 Pieces = '1' @@ -81,6 +75,7 @@ Visible = False OnDblClick = cbxObjectsDblClick + CharsNeedMatch = 1 end - object btnOK: TButton + object btnOK: TButton [4] Left = 257 Top = 190 @@ -92,5 +87,5 @@ TabOrder = 3 end - object btnCancel: TButton + object btnCancel: TButton [5] Left = 337 Top = 190 @@ -102,5 +97,5 @@ TabOrder = 4 end - object cbxTitles: TORComboBox + object cbxTitles: TORComboBox [6] Left = 0 Top = 0 @@ -117,4 +112,5 @@ ListItemsOnly = True LongList = True + LookupPiece = 0 MaxLength = 0 Pieces = '2' @@ -125,4 +121,32 @@ OnDblClick = cbxTitlesDblClick OnNeedData = cbxTitlesNeedData + CharsNeedMatch = 1 + end + inherited amgrMain: TVA508AccessibilityManager + Data = ( + ( + 'Component = lblTop' + 'Status = stsDefault') + ( + 'Component = lblSelect' + 'Status = stsDefault') + ( + 'Component = rgSource' + 'Status = stsDefault') + ( + 'Component = cbxObjects' + 'Status = stsDefault') + ( + 'Component = btnOK' + 'Status = stsDefault') + ( + 'Component = btnCancel' + 'Status = stsDefault') + ( + 'Component = cbxTitles' + 'Status = stsDefault') + ( + 'Component = frmTemplateAutoGen' + 'Status = stsDefault')) end end Index: cprs/trunk/CPRS-Chart/Templates/fTemplateAutoGen.pas =================================================================== --- cprs/trunk/CPRS-Chart/Templates/fTemplateAutoGen.pas (revision 456) +++ cprs/trunk/CPRS-Chart/Templates/fTemplateAutoGen.pas (revision 829) @@ -5,8 +5,8 @@ uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - StdCtrls, ORCtrls, ExtCtrls, ORFn; + StdCtrls, ORCtrls, ExtCtrls, ORFn, fBase508Form, VA508AccessibilityManager; type - TfrmTemplateAutoGen = class(TForm) + TfrmTemplateAutoGen = class(TfrmBase508Form) rgSource: TKeyClickRadioGroup; cbxObjects: TORComboBox; @@ -121,5 +121,5 @@ end; if DoIt then - cbxObjects.Items.Assign(dmodShared.TIUObjects); + FastAssign(dmodShared.TIUObjects, cbxObjects.Items); FObjectsDone := TRUE; end; Index: cprs/trunk/CPRS-Chart/Templates/fTemplateDialog.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Templates/fTemplateDialog.dfm (revision 456) +++ cprs/trunk/CPRS-Chart/Templates/fTemplateDialog.dfm (revision 829) @@ -1,16 +1,9 @@ -object frmTemplateDialog: TfrmTemplateDialog +inherited frmTemplateDialog: TfrmTemplateDialog Left = 268 Top = 155 - Width = 640 - Height = 440 BorderIcons = [biSystemMenu, biMaximize] Caption = 'Text Dialog' - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - OldCreateOrder = False + ClientHeight = 413 + ClientWidth = 632 Position = poScreenCenter OnClose = FormClose @@ -19,7 +12,10 @@ OnDestroy = FormDestroy OnPaint = FormPaint + OnShow = FormShow + ExplicitWidth = 640 + ExplicitHeight = 440 PixelsPerInch = 96 TextHeight = 13 - object sbMain: TScrollBox + object sbMain: TScrollBox [0] Left = 0 Top = 0 @@ -36,5 +32,5 @@ TabOrder = 0 end - object pnlBottom: TScrollBox + object pnlBottom: TScrollBox [1] Left = 0 Top = 375 @@ -100,3 +96,33 @@ end end + inherited amgrMain: TVA508AccessibilityManager + Data = ( + ( + 'Component = sbMain' + 'Status = stsDefault') + ( + 'Component = pnlBottom' + 'Status = stsDefault') + ( + 'Component = lblFootnote' + 'Status = stsDefault') + ( + 'Component = btnCancel' + 'Status = stsDefault') + ( + 'Component = btnOK' + 'Status = stsDefault') + ( + 'Component = btnAll' + 'Status = stsDefault') + ( + 'Component = btnNone' + 'Status = stsDefault') + ( + 'Component = btnPreview' + 'Status = stsDefault') + ( + 'Component = frmTemplateDialog' + 'Status = stsDefault')) + end end Index: cprs/trunk/CPRS-Chart/Templates/fTemplateDialog.pas =================================================================== --- cprs/trunk/CPRS-Chart/Templates/fTemplateDialog.pas (revision 456) +++ cprs/trunk/CPRS-Chart/Templates/fTemplateDialog.pas (revision 829) @@ -5,8 +5,9 @@ uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - StdCtrls, ExtCtrls, ORCtrls, ORFn, AppEvnts, uTemplates; + StdCtrls, ExtCtrls, ORCtrls, ORFn, AppEvnts, uTemplates, fBase508Form, uConst, + VA508AccessibilityManager; type - TfrmTemplateDialog = class(TForm) + TfrmTemplateDialog = class(TfrmBase508Form) sbMain: TScrollBox; pnlBottom: TScrollBox; @@ -26,5 +27,7 @@ procedure btnPreviewClick(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure FormShow(Sender: TObject); private + FFirstBuild: boolean; SL: TStrings; BuildIdx: TStringList; @@ -57,4 +60,6 @@ procedure ParentCBEnter(Sender: TObject); procedure ParentCBExit(Sender: TObject); + procedure UMScreenReaderInit(var Message: TMessage); message UM_MISC; + procedure InitScreenReaderSetup; public property Silent: boolean read FSilent write FSilent ; @@ -72,5 +77,6 @@ implementation -uses dShared, uConst, uTemplateFields, fRptBox, uInit, rMisc; +uses dShared, uTemplateFields, fRptBox, uInit, rMisc, uDlgComponents, + VA508AccessibilityRouter, VAUtils; {$R *.DFM} @@ -187,4 +193,5 @@ Result := FALSE; CancelDlg := FALSE; + SetTemplateDialogCanceled(FALSE); frmTemplateDialog := TfrmTemplateDialog.Create(Application); try @@ -272,7 +279,12 @@ end; - if not Result then + if Result then + SetTemplateDialogCanceled(TRUE) + else + begin + SetTemplateDialogCanceled(FALSE); CheckBoilerplate4Fields(SL, CaptionText, PreviewMode); - + end; + end; @@ -289,4 +301,5 @@ SL.Clear; end; + StripScreenReaderCodes(SL); end; @@ -380,4 +393,25 @@ end; +procedure TfrmTemplateDialog.InitScreenReaderSetup; +var + ctrl: TWinControl; + list: TList; +begin + if ScreenReaderSystemActive then + begin + list := TList.Create; + try + sbMain.GetTabOrderList(list); + if list.Count > 0 then + begin + ctrl := TWinControl(list[0]); + PostMessage(Handle, UM_MISC, WParam(ctrl), 0); + end; + finally + list.free; + end; + end; +end; + function TfrmTemplateDialog.IsAncestor( OldID: string; NewID: string): boolean; begin @@ -398,5 +432,6 @@ KillCtrl, doHint, dsp, noTextParent: boolean; Entry: TTemplateDialogEntry; - StringIn, StringOut: string; +// StringIn, StringOut: string; + cb: TCPRSDialogParentCheckBox; procedure NextTabCtrl(ACtrl: TControl); @@ -511,5 +546,10 @@ Entry := TTemplateDialogEntry(Entries.Objects[idx]); - pnl := Entry.GetPanel(FMaxPnlWidth, sbMain); + if(dsp or OneOnly) then + cb := nil + else + cb := TCPRSDialogParentCheckBox.Create(Self); + + pnl := Entry.GetPanel(FMaxPnlWidth, sbMain, cb); pnl.Show; if(doHint and (not pnl.ShowHint)) then @@ -521,9 +561,9 @@ Entry.OnChange := FieldChanged; end; - if(dsp or OneOnly) then + if not assigned(cb) then ctrl := pnl else begin - ctrl := TORCheckBox.Create(Self); + ctrl := cb; ctrl.Parent := sbMain; @@ -539,11 +579,13 @@ TORCheckBox(ctrl).AutoSize := false; TORCheckBox(ctrl).Associate := pnl; + pnl.Tag := Integer(ctrl); tmpID := copy(ID, 1, (pos('.', ID) - 1)); {copy the ID without the decimal place} - if Templates.IndexOf(tmpID) > -1 then - StringIn := 'Sub-Template: ' + TTemplate(Templates.Objects[Templates.IndexOf(tmpID)]).PrintName - else - StringIn := 'Sub-Template:'; - StringOut := StringReplace(StringIn, '&', '&&', [rfReplaceAll]); - TORCheckBox(ctrl).Caption := StringOut; +// if Templates.IndexOf(tmpID) > -1 then +// StringIn := 'Sub-Template: ' + TTemplate(Templates.Objects[Templates.IndexOf(tmpID)]).PrintName +// else +// StringIn := 'Sub-Template:'; +// StringOut := StringReplace(StringIn, '&', '&&', [rfReplaceAll]); +// TORCheckBox(ctrl).Caption := StringOut; + UpdateColorsFor508Compliance(ctrl); end; @@ -615,4 +657,9 @@ for i := 1 to Count do BuildCB(i, Y, FirstTime); + if ScreenReaderSystemActive then + begin + amgrMain.RefreshComponents; + Application.ProcessMessages; + end; finally FBuilding := FALSE; @@ -626,4 +673,15 @@ RepaintBuild := FALSE; BuildAllControls; + InitScreenReaderSetup; + end; +end; + +procedure TfrmTemplateDialog.FormShow(Sender: TObject); +begin + inherited; + if FFirstBuild then + begin + FFirstBuild := FALSE; + InitScreenReaderSetup; end; end; @@ -631,4 +689,5 @@ procedure TfrmTemplateDialog.FormCreate(Sender: TObject); begin + FFirstBuild := TRUE; BuildIdx := TStringList.Create; Entries := TStringList.Create; @@ -700,5 +759,5 @@ if not CanClose then begin - ShowMessage(MissingFieldsTxt); + ShowMsg(MissingFieldsTxt); break; end; @@ -719,6 +778,7 @@ TmpSL := TStringList.Create; try - TmpSL.Assign(SL); + FastAssign(SL, TmpSL); GetText(TmpSL, FALSE); {FALSE = Do not include embedded fields} + StripScreenReaderCodes(TmpSL); ReportBox(TmpSL, 'Dialog Preview', FALSE); finally @@ -755,4 +815,21 @@ end; +procedure TfrmTemplateDialog.UMScreenReaderInit(var Message: TMessage); +var + ctrl: TWinControl; + item: TVA508AccessibilityItem; +begin + ctrl := TWinControl(Message.WParam); + // Refresh the accessibility manager entry - + // fixes bug where first focusable check boxes weren't working correctly + if ctrl is TCPRSDialogParentCheckBox then + begin + item := amgrMain.AccessData.FindItem(ctrl, FALSE); + if assigned(item) then + item.free; + amgrMain.AccessData.EnsureItemExists(ctrl); + end; +end; + end. Index: cprs/trunk/CPRS-Chart/Templates/fTemplateEditor.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Templates/fTemplateEditor.dfm (revision 456) +++ cprs/trunk/CPRS-Chart/Templates/fTemplateEditor.dfm (revision 829) @@ -1,27 +1,23 @@ -object frmTemplateEditor: TfrmTemplateEditor - Left = 135 - Top = 239 - Width = 748 - Height = 470 +inherited frmTemplateEditor: TfrmTemplateEditor + Left = 321 + Top = 119 HelpContext = 10000 ActiveControl = tvPersonal BorderIcons = [biSystemMenu, biMaximize] Caption = 'Template Editor' - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - OldCreateOrder = False + ClientHeight = 450 + ClientWidth = 740 Position = poScreenCenter Scaled = False + OnClose = FormClose OnCloseQuery = FormCloseQuery OnCreate = FormCreate OnDestroy = FormDestroy OnShow = FormShow + ExplicitWidth = 748 + ExplicitHeight = 477 PixelsPerInch = 96 TextHeight = 13 - object splMain: TSplitter + object splMain: TSplitter [0] Left = 0 Top = 239 @@ -35,7 +31,7 @@ OnMoved = splMainMoved end - object splNotes: TSplitter + object splNotes: TSplitter [1] Left = 0 - Top = 371 + Top = 377 Width = 740 Height = 3 @@ -46,8 +42,9 @@ Visible = False OnMoved = splBoilMoved + ExplicitTop = 371 end - object pnlBottom: TORAutoPanel + object pnlBottom: TPanel [2] Left = 0 - Top = 416 + Top = 423 Width = 740 Height = 27 @@ -55,4 +52,5 @@ BevelOuter = bvNone TabOrder = 4 + ExplicitTop = 416 DesignSize = ( 740 @@ -130,9 +128,9 @@ end end - object pnlBoilerplate: TPanel + object pnlBoilerplate: TPanel [3] Left = 0 Top = 284 Width = 740 - Height = 87 + Height = 93 Align = alClient BevelOuter = bvNone @@ -142,19 +140,20 @@ object splBoil: TSplitter Left = 0 - Top = 43 + Top = 14 Width = 740 Height = 3 Cursor = crVSplit - Align = alBottom + Align = alTop AutoSnap = False Beveled = True Visible = False OnMoved = splBoilMoved + ExplicitTop = 43 end object reBoil: TRichEdit Left = 0 - Top = 14 + Top = 17 Width = 740 - Height = 29 + Height = 30 Align = alClient Font.Charset = ANSI_CHARSET @@ -163,4 +162,5 @@ Font.Name = 'Courier New' Font.Style = [] + Constraints.MinHeight = 30 ParentFont = False PlainText = True @@ -175,10 +175,11 @@ OnResizeRequest = reResizeRequest OnSelectionChange = reBoilSelectionChange + ExplicitTop = 14 end object pnlGroupBP: TPanel Left = 0 - Top = 46 + Top = 47 Width = 740 - Height = 41 + Height = 46 Align = alBottom BevelOuter = bvNone @@ -192,4 +193,5 @@ Align = alTop Caption = 'Group Boilerplate' + ExplicitWidth = 81 end object lblGroupRow: TLabel @@ -211,5 +213,5 @@ Top = 16 Width = 740 - Height = 25 + Height = 30 Align = alClient Color = clCream @@ -219,4 +221,5 @@ Font.Name = 'Courier New' Font.Style = [] + Constraints.MinHeight = 30 ParentFont = False PlainText = True @@ -281,5 +284,5 @@ end end - object pnlTop: TPanel + object pnlTop: TPanel [4] Left = 0 Top = 0 @@ -293,7 +296,5 @@ Left = 297 Top = 24 - Width = 3 Height = 215 - Cursor = crHSplit Align = alRight AutoSnap = False @@ -319,7 +320,5 @@ Left = 216 Top = 0 - Width = 3 Height = 215 - Cursor = crHSplit Align = alRight AutoSnap = False @@ -428,4 +427,5 @@ FocusControl = tvPersonal PopupMenu = popTemplates + ExplicitWidth = 93 end object tvPersonal: TORTreeView @@ -716,6 +716,6 @@ ShowHint = True TabOrder = 5 + WordWrap = True OnClick = cbExcludeClick - WordWrap = True AutoSize = True end @@ -760,11 +760,8 @@ 'erplate, between each item'#39's boilerplate.' Associate = edtGap - Min = 0 Max = 3 ParentShowHint = False - Position = 0 ShowHint = True TabOrder = 8 - Wrap = False end object edtName: TCaptionEdit @@ -871,6 +868,6 @@ ShowHint = True TabOrder = 4 + WordWrap = True OnClick = cbHideItemsClick - WordWrap = True AutoSize = True end @@ -913,4 +910,5 @@ TabOrder = 2 OnChange = cbxRemDlgsChange + CharsNeedMatch = 1 end object cbLock: TORCheckBox @@ -943,4 +941,5 @@ FocusControl = tvShared PopupMenu = popTemplates + ExplicitWidth = 86 end object tvShared: TORTreeView @@ -1188,4 +1187,5 @@ OnChange = cboOwnerChange OnNeedData = cboOwnerNeedData + CharsNeedMatch = 1 end object btnNew: TORAlignButton @@ -1194,8 +1194,8 @@ Width = 182 Height = 22 + Align = alRight Caption = '&New Template' TabOrder = 2 OnClick = btnNewClick - Align = alRight end object pnlMenu: TPanel @@ -1212,5 +1212,5 @@ Left = 1 Top = 1 - Width = 69 + Width = 107 Height = 20 Align = alLeft @@ -1219,5 +1219,4 @@ ButtonWidth = 43 Caption = 'mbMain' - Flat = True Menu = mnuMain ShowCaptions = True @@ -1228,9 +1227,9 @@ end end - object pnlNotes: TPanel + object pnlNotes: TPanel [5] Left = 0 - Top = 374 + Top = 380 Width = 740 - Height = 42 + Height = 43 Align = alBottom BevelOuter = bvNone @@ -1244,4 +1243,5 @@ Align = alTop Caption = 'Template Notes:' + ExplicitWidth = 78 end object reNotes: TRichEdit @@ -1249,5 +1249,5 @@ Top = 13 Width = 740 - Height = 29 + Height = 30 Align = alClient Font.Charset = ANSI_CHARSET @@ -1256,4 +1256,5 @@ Font.Name = 'Courier New' Font.Style = [] + Constraints.MinHeight = 30 ParentFont = False PlainText = True @@ -1269,5 +1270,5 @@ end end - object pnlCOM: TPanel + object pnlCOM: TPanel [6] Left = 0 Top = 263 @@ -1286,4 +1287,5 @@ Caption = ' Passed Value: ' Layout = tlCenter + ExplicitHeight = 13 end object lblCOMObj: TLabel @@ -1295,4 +1297,5 @@ Caption = ' COM Object: ' Layout = tlCenter + ExplicitHeight = 13 end object edtCOMParam: TCaptionEdit @@ -1301,7 +1304,7 @@ Width = 380 Height = 21 + Align = alClient TabOrder = 0 OnChange = edtCOMParamChange - Align = alClient Caption = 'Passed Value' end @@ -1329,7 +1332,8 @@ TabOrder = 1 OnChange = cbxCOMObjChange + CharsNeedMatch = 1 end end - object pnlLink: TPanel + object pnlLink: TPanel [7] Left = 0 Top = 242 @@ -1348,4 +1352,5 @@ Caption = ' Associated Consult Service: ' Layout = tlCenter + ExplicitHeight = 13 end object cbxLink: TORComboBox @@ -1367,5 +1372,5 @@ LookupPiece = 0 MaxLength = 0 - 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' + Pieces = '2' HideSynonyms = True Sorted = False @@ -1376,6 +1381,252 @@ OnChange = cbxLinkChange OnNeedData = cbxLinkNeedData - OnSynonymCheck = cbxLinkSynonymCheck - end + CharsNeedMatch = 1 + end + end + inherited amgrMain: TVA508AccessibilityManager + Data = ( + ( + 'Component = pnlBottom' + 'Status = stsDefault') + ( + 'Component = btnApply' + 'Status = stsDefault') + ( + 'Component = btnCancel' + 'Status = stsDefault') + ( + 'Component = btnOK' + 'Status = stsDefault') + ( + 'Component = cbEditShared' + 'Status = stsDefault') + ( + 'Component = cbNotes' + 'Status = stsDefault') + ( + 'Component = cbEditUser' + 'Status = stsDefault') + ( + 'Component = pnlBoilerplate' + 'Status = stsDefault') + ( + 'Component = reBoil' + 'Label = lblBoilerplate' + 'Status = stsOK') + ( + 'Component = pnlGroupBP' + 'Status = stsDefault') + ( + 'Component = reGroupBP' + 'Label = lblGroupBP' + 'Status = stsOK') + ( + 'Component = pnlGroupBPGap' + 'Status = stsDefault') + ( + 'Component = pnlBP' + 'Status = stsDefault') + ( + 'Component = cbLongLines' + 'Status = stsDefault') + ( + 'Component = pnlTop' + 'Status = stsDefault') + ( + 'Component = pnlRightTop' + 'Status = stsDefault') + ( + 'Component = pnlCopyBtns' + 'Status = stsDefault') + ( + 'Component = sbCopyRight' + 'Property = Hint' + 'Status = stsOK') + ( + 'Component = sbCopyLeft' + 'Property = Hint' + 'Status = stsOK') + ( + 'Component = pnlPersonal' + 'Status = stsDefault') + ( + 'Component = tvPersonal' + 'Status = stsDefault') + ( + 'Component = pnlPersonalBottom' + 'Status = stsDefault') + ( + 'Component = sbPerUp' + 'Property = Hint' + 'Status = stsOK') + ( + 'Component = sbPerDown' + 'Property = Hint' + 'Status = stsOK') + ( + 'Component = sbPerDelete' + 'Property = Hint' + 'Status = stsOK') + ( + 'Component = cbPerHide' + 'Property = Hint' + 'Status = stsOK') + ( + 'Component = pnlPersonalGap' + 'Status = stsDefault') + ( + 'Component = pnlPerSearch' + 'Status = stsDefault') + ( + 'Component = btnPerFind' + 'Text = Find Personal Template' + 'Status = stsOK') + ( + 'Component = edtPerSearch' + 'Status = stsDefault') + ( + 'Component = cbPerMatchCase' + 'Status = stsDefault') + ( + 'Component = cbPerWholeWords' + 'Status = stsDefault') + ( + 'Component = pnlProperties' + 'Status = stsDefault') + ( + 'Component = gbProperties' + 'Status = stsDefault') + ( + 'Component = cbExclude' + 'Status = stsDefault') + ( + 'Component = cbActive' + 'Status = stsDefault') + ( + 'Component = edtGap' + 'Status = stsDefault') + ( + 'Component = udGap' + 'Status = stsDefault') + ( + 'Component = edtName' + 'Status = stsDefault') + ( + 'Component = gbDialogProps' + 'Status = stsDefault') + ( + 'Component = cbDisplayOnly' + 'Status = stsDefault') + ( + 'Component = cbOneItemOnly' + 'Status = stsDefault') + ( + 'Component = cbFirstLine' + 'Status = stsDefault') + ( + 'Component = cbHideDlgItems' + 'Status = stsDefault') + ( + 'Component = cbIndent' + 'Status = stsDefault') + ( + 'Component = cbHideItems' + 'Status = stsDefault') + ( + 'Component = cbxType' + 'Status = stsDefault') + ( + 'Component = cbxRemDlgs' + 'Status = stsDefault') + ( + 'Component = cbLock' + 'Status = stsDefault') + ( + 'Component = pnlShared' + 'Status = stsDefault') + ( + 'Component = tvShared' + 'Status = stsDefault') + ( + 'Component = pnlSharedBottom' + 'Status = stsDefault') + ( + 'Component = sbShUp' + 'Property = Hint' + 'Status = stsOK') + ( + 'Component = sbShDown' + 'Property = Hint' + 'Status = stsOK') + ( + 'Component = sbShDelete' + 'Property = Hint' + 'Status = stsOK') + ( + 'Component = cbShHide' + 'Property = Hint' + 'Status = stsOK') + ( + 'Component = pnlSharedGap' + 'Status = stsDefault') + ( + 'Component = pnlShSearch' + 'Status = stsDefault') + ( + 'Component = btnShFind' + 'Text = Find Shared Template' + 'Status = stsOK') + ( + 'Component = edtShSearch' + 'Status = stsDefault') + ( + 'Component = cbShMatchCase' + 'Status = stsDefault') + ( + 'Component = cbShWholeWords' + 'Status = stsDefault') + ( + 'Component = pnlMenuBar' + 'Status = stsDefault') + ( + 'Component = cboOwner' + 'Status = stsDefault') + ( + 'Component = btnNew' + 'Status = stsDefault') + ( + 'Component = pnlMenu' + 'Status = stsDefault') + ( + 'Component = mbMain' + 'Status = stsDefault') + ( + 'Component = pnlNotes' + 'Status = stsDefault') + ( + 'Component = reNotes' + 'Label = lblNotes' + 'Status = stsOK') + ( + 'Component = pnlCOM' + 'Status = stsDefault') + ( + 'Component = edtCOMParam' + 'Label = lblCOMParam' + 'Status = stsOK') + ( + 'Component = cbxCOMObj' + 'Property = Caption' + 'Status = stsOK') + ( + 'Component = pnlLink' + 'Status = stsDefault') + ( + 'Component = cbxLink' + 'Label = lblLink' + 'Status = stsOK') + ( + 'Component = frmTemplateEditor' + 'Status = stsDefault')) end object popTemplates: TPopupMenu @@ -1750,3 +2001,16 @@ Top = 136 end + object imgLblTemplates: TVA508ImageListLabeler + Components = < + item + Component = tvPersonal + end + item + Component = tvShared + end> + Labels = <> + RemoteLabeler = dmodShared.imgLblHealthFactorLabels + Left = 104 + Top = 144 + end end Index: cprs/trunk/CPRS-Chart/Templates/fTemplateEditor.pas =================================================================== --- cprs/trunk/CPRS-Chart/Templates/fTemplateEditor.pas (revision 456) +++ cprs/trunk/CPRS-Chart/Templates/fTemplateEditor.pas (revision 829) @@ -18,5 +18,6 @@ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, ComCtrls, ORCtrls, Buttons, Mask, ORFn, ORNet, - uTemplates, Menus, ImgList, Clipbrd, ToolWin, MenuBar, TypInfo, MSXML_TLB; + uTemplates, Menus, ImgList, Clipbrd, ToolWin, MenuBar, TypInfo, MSXML_TLB, fBase508Form, + VA508AccessibilityManager, VA508ImageListLabeler; type @@ -24,7 +25,7 @@ TTemplateTreeType = (ttShared, ttPersonal); - TfrmTemplateEditor = class(TForm) + TfrmTemplateEditor = class(TfrmBase508Form) splMain: TSplitter; - pnlBottom: TORAutoPanel; + pnlBottom: TPanel; btnApply: TButton; btnCancel: TButton; @@ -209,4 +210,5 @@ cbxLink: TORComboBox; lblLink: TLabel; + imgLblTemplates: TVA508ImageListLabeler; procedure btnNewClick(Sender: TObject); procedure btnApplyClick(Sender: TObject); @@ -339,6 +341,4 @@ Direction, InsertAt: Integer); procedure cbxLinkChange(Sender: TObject); - procedure cbxLinkSynonymCheck(Sender: TObject; const Text: String; - var IsSynonym: Boolean); procedure reBoilKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); @@ -346,4 +346,5 @@ procedure reBoilKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure FormClose(Sender: TObject; var Action: TCloseAction); private FLastRect: TRect; @@ -386,5 +387,5 @@ FCanDoReminders: boolean; FCanDoCOMObjects: boolean; - FPersonalObjects: TStringList; + //FPersonalObjects: TStringList; FShowingTemplate: TTemplate; FConsultServices: TStringList; @@ -416,12 +417,25 @@ procedure UpdateInsertsDialogs; procedure AutoLongLines(Sender: TObject); - procedure UpdatePersonalObjects; + //procedure UpdatePersonalObjects; procedure UpdateApply(Template: TTemplate); procedure TemplateLocked(Sender: TObject); procedure InitTrees; + procedure AdjustControls4FontChange; + procedure ShowGroupBoilerplate(Visible: boolean); function GetLinkType(const ANode: TTreeNode): TTemplateLinkType; end; procedure EditTemplates(Form: TForm; NewTemplate: boolean = FALSE; CopiedText: string = ''; Shared: boolean = FALSE); + +const + TemplateEditorSplitters = 'frmTempEditSplitters'; + TemplateEditorSplitters2 = 'frmTempEditSplitters2'; + +var + tmplEditorSplitterMiddle: integer = 0; + tmplEditorSplitterProperties: integer = 0; + tmplEditorSplitterMain: integer = 0; + tmplEditorSplitterBoil: integer = 0; + tmplEditorSplitterNotes: integer = 0; implementation @@ -431,5 +445,6 @@ uses dShared, uCore, rTemplates, fTemplateObjects, uSpell, fTemplateView, fTemplateAutoGen, fDrawers, fTemplateFieldEditor, fTemplateFields, XMLUtils, - fIconLegend, uReminders, uConst, rCore, rEventHooks, rConsults; + fIconLegend, uReminders, uConst, rCore, rEventHooks, rConsults, VAUtils, + rMisc, fFindingTemplates; const @@ -499,6 +514,6 @@ Drawers := TFrmDrawers(Form) else - if IsPublishedProp(Form, 'Drawers') then - Drawers := TFrmDrawers(GetOrdProp(Form, 'Drawers')); + if IsPublishedProp(Form, DrawersProperty) then + Drawers := TFrmDrawers(GetOrdProp(Form, DrawersProperty)); end; @@ -724,4 +739,5 @@ BtnApply.Enabled := BackupDiffers; + SetFormPosition(Self); end; @@ -873,8 +889,5 @@ end; lblNotes.Enabled := (not reNotes.ReadOnly); - if(reNotes.ReadOnly) then - reNotes.Color := ReadOnlyColor - else - reNotes.Color := clWindow; + UpdateReadOnlyColorScheme(reNotes, reNotes.ReadOnly); cbxType.Enabled := ok; lblType.Enabled := ok; @@ -894,8 +907,5 @@ lblLines.Enabled := ok; reBoil.ReadOnly := not ok; - if(ok) then - reBoil.Color := clWindow - else - reBoil.Color := ReadOnlyColor; + UpdateReadOnlyColorScheme(reBoil, not ok); lblLink.Enabled := ok; cbxLink.Enabled := ok; @@ -937,4 +947,22 @@ end; +procedure TfrmTemplateEditor.ShowGroupBoilerplate(Visible: boolean); +begin + pnlGroupBP.Visible := Visible; + splBoil.Visible := Visible; + if Visible then + begin + reBoil.Align := alTop; + pnlGroupBP.Align := alClient; + reBoil.Height := tmplEditorSplitterBoil; + splBoil.Top := pnlGroupBP.Top - splBoil.Height; + end + else + begin + pnlGroupBP.Align := alBottom; + reBoil.Align := alClient; + end; +end; + procedure TfrmTemplateEditor.ShowInfo(Node: TTreeNode); var @@ -942,8 +970,6 @@ Idx: TTypeIndex; CanDoCOM: boolean; - LinkTemplate: TTemplate; lt: TTemplateLinkType; lts: string; - i: integer; begin @@ -980,13 +1006,8 @@ begin FConsultServices := TStringList.Create; - FConsultServices.Assign(LoadServiceListWithSynonyms(1)); + FastAssign(LoadServiceListWithSynonyms(1), FConsultServices); SortByPiece(FConsultServices, U, 2); end; - for i := 0 to FConsultServices.Count-1 do - begin - LinkTemplate := GetLinkedTemplate(piece(FConsultServices[i],U,1), ltConsult); - if (not assigned(LinkTemplate)) or (LinkTemplate = FShowingTemplate) then - cbxLink.Items.Add(FConsultServices[i]); - end; + FastAssign(FConsultServices, cbxLink.Items); end else @@ -1171,6 +1192,5 @@ edtGap.Text := '0'; reBoil.Clear; - pnlGroupBP.Visible := FALSE; - splBoil.Visible := FALSE; + ShowGroupBoilerplate(False); pnlBoilerplateResize(Self); pnlCOM.Visible := FALSE; @@ -1196,5 +1216,7 @@ begin if(pnlGroupBP.Visible) and (pnlGroupBP.Height > (pnlBoilerplate.Height-29)) then + begin pnlGroupBP.Height := pnlBoilerplate.Height-29; + end; if cbLongLines.checked then Max := 240 @@ -1449,13 +1471,10 @@ begin reBoil.ReadOnly := TRUE; - reBoil.Color := ReadOnlyColor; + UpdateReadOnlyColorScheme(reBoil, TRUE); UpdateInsertsDialogs; end; - pnlGroupBP.Visible := ItemOK; - splBoil.Visible := ItemOK; + ShowGroupBoilerplate(ItemOK); if(not ItemOK) and (IsReminderDialog or IsCOMObject) then BPOK := FALSE; - if(ItemOK) then - splBoil.Top := pnlGroupBP.Top - splBoil.Height; pnlBoilerplateResize(Self); pnlBoilerplate.Visible := BPOK; @@ -1482,5 +1501,13 @@ frmTemplateFields := nil; end; - KillObj(@FPersonalObjects); + //---------- CQ #8665 - RV -------- + //KillObj(@FPersonalObjects); + if (assigned(uPersonalObjects)) then + begin + KillObj(@uPersonalObjects); + uPersonalObjects.Free; + uPersonalObjects := nil; + end; + // ---- end CQ #8665 ------------- dmodShared.OnTemplateLock := nil; dmodShared.InEditor := FALSE; @@ -2040,4 +2067,32 @@ end; +procedure TfrmTemplateEditor.AdjustControls4FontChange; +var + x: integer; + + procedure Adjust(Control: TWinControl); + begin + x := x - Control.Width - 2; + Control.Left := x; + end; + +begin + if FCanEditShared then + begin + x := pnlSharedBottom.Width; + Adjust(sbSHDelete); + Adjust(sbSHDown); + Adjust(sbSHUp); + cbSHHide.Width := x; + end; + x := pnlBottom.Width; + Adjust(btnApply); + Adjust(btnCancel); + Adjust(btnOK); + cbEditShared.Width := TextWidthByFont(cbEditShared.Font.Handle, cbEditShared.Caption) + 25; + cbNotes.Left := cbEditShared.Left + cbEditShared.Width + 60; + cbNotes.Width := TextWidthByFont(cbNotes.Font.Handle, cbNotes.Caption) + 25; +end; + function TfrmTemplateEditor.AllowMove(ADropNode, ADragNode: TTreeNode): boolean; var @@ -2205,4 +2260,6 @@ MoveCopyButtons; tvTreeChange(FCurTree, FCurTree.Selected); + if FCanEditShared then + AdjustControls4FontChange; end; @@ -2327,6 +2384,7 @@ procedure TfrmTemplateEditor.btnFindClick(Sender: TObject); var - Found: boolean; + Found: TTreeNode; edtSearch: TEdit; + IsNext: boolean; FindNext: boolean; FindWholeWords: boolean; @@ -2334,5 +2392,5 @@ Tree: TTreeView; LastFoundNode, TmpNode: TTreeNode; - S1,S2: string; +// S1,S2: string; begin @@ -2345,13 +2403,4 @@ FindCase := cbShMatchCase.Checked; LastFoundNode := FLastFoundShNode; - if(FSharedEmptyNodeCount > 0) then - begin - FInternalHiddenExpand := TRUE; - try - tvShared.Items.GetFirstNode.Expand(TRUE); - finally - FInternalHiddenExpand := FALSE; - end; - end; end else @@ -2363,53 +2412,28 @@ FindCase := cbPerMatchCase.Checked; LastFoundNode := FLastFoundPerNode; - if(FPersonalEmptyNodeCount > 0) then - begin - FInternalHiddenExpand := TRUE; - try - tvPersonal.Items.GetFirstNode.Expand(TRUE); - finally - FInternalHiddenExpand := FALSE; - end; - end; end; if(edtSearch.text <> '') then begin - if((FindNext) and assigned (LastFoundNode)) then - TmpNode := LastFoundNode.GetNext + IsNext := ((FindNext) and assigned (LastFoundNode)); + if IsNext then + + TmpNode := LastFoundNode else TmpNode := Tree.Items.GetFirstNode; - Found := FALSE; - if(assigned(TmpNode)) then - begin - S1 := edtSearch.Text; - if(not FindCase) then - S1 := UpperCase(S1); - while (assigned(TmpNode) and (not Found)) do - begin - S2 := TmpNode.Text; - if(not FindCase) then - S2 := UpperCase(S2); - Found := SearchMatch(S1, S2, FindWholeWords); - if(not Found) then - TmpNode := TmpNode.GetNext; - end; - end; - if(Found) then - begin + FInternalHiddenExpand := TRUE; + try + Found := FindTemplate(edtSearch.Text, Tree, Self, TmpNode, + IsNext, not FindCase, FindWholeWords); + finally + FInternalHiddenExpand := FALSE; + end; + if Assigned(Found) then + begin + Tree.Selected := Found; if(Tree = tvShared) then - FLastFoundShNode := TmpNode + FLastFoundShNode := Found else - FLastFoundPerNode := TmpNode; + FLastFoundPerNode := Found; SetFindNext(Tree, TRUE); - Tree.Selected := TmpNode; - end - else - begin - if(FindNext) then - S1 := '' - else - S1 := ' "' + edtSearch.Text + '" was not Found.'; - SetFindNext(Tree, FALSE); - InfoBox('Search Complete.' + S1, 'Information', MB_OK or MB_ICONINFORMATION); end; end; @@ -2499,4 +2523,6 @@ end; pnlBoilerplateResize(Self); + AdjustControls4FontChange; + MoveCopyButtons; end; end; @@ -2516,14 +2542,14 @@ begin UpdatePersonalObjects; - if FPersonalObjects.Count > 0 then + if uPersonalObjects.Count > 0 then // -------- CQ #8665 - RV ------------ begin DoIt := FALSE; for i := 0 to dmodShared.TIUObjects.Count-1 do - if FPersonalObjects.IndexOf(Piece(dmodShared.TIUObjects[i],U,2)) >= 0 then + if uPersonalObjects.IndexOf(Piece(dmodShared.TIUObjects[i],U,2)) >= 0 then // -------- CQ #8665 - RV ------------ frmTemplateObjects.cboObjects.Items.Add(dmodShared.TIUObjects[i]); end; end; if DoIt then - frmTemplateObjects.cboObjects.Items.Assign(dmodShared.TIUObjects); + FastAssign(dmodShared.TIUObjects, frmTemplateObjects.cboObjects.Items); frmTemplateObjects.Font := Font; frmTemplateObjects.re := reBoil; @@ -2633,4 +2659,10 @@ end; +procedure TfrmTemplateEditor.FormClose(Sender: TObject; + var Action: TCloseAction); +begin + SaveUserBounds(Self); +end; + procedure TfrmTemplateEditor.FormCloseQuery(Sender: TObject; var CanClose: Boolean); @@ -2666,4 +2698,8 @@ procedure TfrmTemplateEditor.splBoilMoved(Sender: TObject); begin + if pnlBoilerplate.Visible and pnlGroupBP.Visible then + tmplEditorSplitterBoil := reBoil.Height; + if pnlNotes.Visible then + tmplEditorSplitterNotes := pnlNotes.Height; pnlBoilerplateResize(Self); end; @@ -3105,5 +3141,6 @@ procedure TfrmTemplateEditor.mbMainResize(Sender: TObject); begin - pnlMenu.Width := mbMain.Width + 3; + pnlMenu.Width := mbMain.Width + 4; + mbMain.Width := pnlMenu.Width - 3; end; @@ -3179,5 +3216,5 @@ dmodShared.LoadTIUObjects; UpdatePersonalObjects; - GetAutoGenText(AName, AText, FPersonalObjects); + GetAutoGenText(AName, AText, uPersonalObjects); // -------- CQ #8665 - RV ------------ if(AName <> '') and (AText <> '') then begin @@ -3274,5 +3311,10 @@ pnlNotes.Visible := cbNotes.Checked; splNotes.Visible := cbNotes.Checked; - splNotes.Top := pnlNotes.Top-3; + if cbNotes.Checked then + begin + pnlNotes.Height := tmplEditorSplitterNotes; + pnlNotes.Top := pnlBottom.Top - pnlNotes.Height; + splNotes.Top := pnlNotes.Top-3; + end; pnlBoilerplateResize(Self); end; @@ -3397,8 +3439,8 @@ if (Flds.Count > 0) then begin ExpandEmbeddedFields(Flds); - Flds.Assign(ExportTemplateFields(Flds)); + FastAssign(ExportTemplateFields(Flds), Flds); for i := 0 to Flds.Count-1 do Flds[i] := ' ' + Flds[i]; - Tmpl.AddStrings(Flds); + FastAddStrings(Flds, Tmpl); end; {if} Tmpl.Add(''); @@ -3704,5 +3746,5 @@ FUpdating := FALSE; end; - ShowMessage('Can not assign a Reminder Dialog to a Reason for Request'); + ShowMsg('Can not assign a Reminder Dialog to a Reason for Request'); end else @@ -3790,5 +3832,5 @@ end; -procedure TfrmTemplateEditor.UpdatePersonalObjects; +(*procedure TfrmTemplateEditor.UpdatePersonalObjects; var i: integer; @@ -3803,5 +3845,5 @@ FPersonalObjects.Sorted := TRUE; end; -end; +end;*) (*function TfrmTemplateEditor.ModifyAllowed(const Node: TTreeNode): boolean; @@ -3875,5 +3917,5 @@ begin Resync([TTemplate(Sender)]); - ShowMessage(Format(TemplateLockedText, [TTemplate(Sender).PrintName])); + ShowMsg(Format(TemplateLockedText, [TTemplate(Sender).PrintName])); end; @@ -4074,9 +4116,9 @@ try case TTemplateLinkType(pnlLink.Tag) of - ltTitle: tmpSL.Assign(SubSetOfAllTitles(StartFrom, Direction)); + ltTitle: FastAssign(SubSetOfAllTitles(StartFrom, Direction), tmpSL); // ltConsult: ltProcedure: begin - tmpSL.Assign(SubSetOfProcedures(StartFrom, Direction)); + FastAssign(SubSetOfProcedures(StartFrom, Direction), tmpSL); for i := 0 to tmpSL.Count-1 do begin @@ -4096,4 +4138,5 @@ var Template,LinkTemplate: TTemplate; + update: boolean; begin @@ -4104,4 +4147,5 @@ if assigned(Template) and Template.CanModify then begin + update := true; if cbxLink.ItemIEN > 0 then begin @@ -4109,37 +4153,21 @@ if (assigned(LinkTemplate) and (LinkTemplate <> Template)) then begin - ShowMessage(GetLinkName(cbxLink.ItemID, TTemplateLinkType(pnlLink.tag)) + + ShowMsg(GetLinkName(cbxLink.ItemID, TTemplateLinkType(pnlLink.tag)) + ' is already assigned to another template.'); - cbxLink.ItemIndex := -1; + cbxLink.SelectByID(Template.LinkIEN); + update := False; + end + else + begin + Template.FileLink := ConvertFileLink(cbxLink.ItemID, TTemplateLinkType(pnlLink.tag)); + if Template.LinkName <> '' then + edtName.Text := copy(Template.LinkName,1,edtName.MaxLength); end; - Template.FileLink := ConvertFileLink(cbxLink.ItemID, TTemplateLinkType(pnlLink.tag)); - if Template.LinkName <> '' then - edtName.Text := copy(Template.LinkName,1,edtName.MaxLength); end else Template.FileLink := ''; - UpdateApply(Template); - end; - end; -end; - -procedure TfrmTemplateEditor.cbxLinkSynonymCheck(Sender: TObject; - const Text: String; var IsSynonym: Boolean); -var - LinkTemplate: TTemplate; - var IEN: string; - -begin - IsSynonym := FALSE; - if pnlLink.Visible and assigned(FShowingTemplate) then - begin - IEN := Piece(Text,#9,30); - if IEN <> '' then - begin - LinkTemplate := GetLinkedTemplate(IEN, TTemplateLinkType(pnlLink.Tag)); - IsSynonym := (assigned(LinkTemplate) and (LinkTemplate <> FShowingTemplate)); - end - else - IsSynonym := FALSE; + if update then + UpdateApply(Template); + end; end; end; Index: cprs/trunk/CPRS-Chart/Templates/fTemplateFieldEditor.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Templates/fTemplateFieldEditor.dfm (revision 456) +++ cprs/trunk/CPRS-Chart/Templates/fTemplateFieldEditor.dfm (revision 829) @@ -1,16 +1,9 @@ -object frmTemplateFieldEditor: TfrmTemplateFieldEditor +inherited frmTemplateFieldEditor: TfrmTemplateFieldEditor Left = 294 Top = 211 - Width = 640 - Height = 447 BorderIcons = [biSystemMenu, biMaximize] Caption = 'Template Field Editor' - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - OldCreateOrder = False + ClientHeight = 420 + ClientWidth = 788 Position = poScreenCenter OnCloseQuery = FormCloseQuery @@ -18,23 +11,24 @@ OnDestroy = FormDestroy OnResize = FormResize + ExplicitWidth = 796 + ExplicitHeight = 454 PixelsPerInch = 96 TextHeight = 13 - object splLeft: TSplitter - Left = 273 + object splLeft: TSplitter [0] + Left = 429 Top = 25 - Width = 3 Height = 366 - Cursor = crHSplit Beveled = True + ExplicitLeft = 273 end - object pnlBottom: TPanel + object pnlBottom: TPanel [1] Left = 0 Top = 391 - Width = 632 + Width = 788 Height = 29 Align = alBottom TabOrder = 2 DesignSize = ( - 632 + 788 29) object lblReq: TStaticText @@ -47,5 +41,5 @@ end object btnOK: TButton - Left = 392 + Left = 548 Top = 4 Width = 75 @@ -58,5 +52,5 @@ end object btnCancel: TButton - Left = 472 + Left = 628 Top = 4 Width = 75 @@ -70,5 +64,5 @@ end object btnApply: TButton - Left = 552 + Left = 708 Top = 4 Width = 75 @@ -80,5 +74,5 @@ end object btnPreview: TButton - Left = 279 + Left = 435 Top = 4 Width = 75 @@ -102,8 +96,8 @@ end end - object pnlObjs: TPanel + object pnlObjs: TPanel [2] Left = 0 Top = 25 - Width = 273 + Width = 429 Height = 366 Align = alLeft @@ -114,13 +108,14 @@ Left = 1 Top = 1 - Width = 271 + Width = 427 Height = 13 Align = alTop Caption = 'Template Fields' + ExplicitWidth = 74 end object cbxObjs: TORComboBox Left = 1 Top = 14 - Width = 271 + Width = 427 Height = 351 Style = orcsSimple @@ -141,5 +136,5 @@ Sorted = False SynonymChars = '' - TabPositions = '34,45,55,65,75' + TabPositions = '50,60,70,80,90' TabOrder = 0 OnChange = cbxObjsChange @@ -147,8 +142,9 @@ OnNeedData = cbxObjsNeedData OnSynonymCheck = cbxObjsSynonymCheck + CharsNeedMatch = 1 end end - object pnlRight: TPanel - Left = 276 + object pnlRight: TPanel [3] + Left = 432 Top = 25 Width = 356 @@ -182,4 +178,5 @@ Align = alTop Caption = 'Notes:' + ExplicitWidth = 31 end object reNotes: TRichEdit @@ -370,4 +367,5 @@ TabOrder = 1 OnChange = cbxTypeChange + CharsNeedMatch = 1 end object edtTextLen: TCaptionEdit @@ -389,9 +387,6 @@ Anchors = [akTop, akRight] Associate = edtTextLen - Min = 0 Max = 240 - Position = 0 TabOrder = 5 - Wrap = False end object pnlSwap: TPanel @@ -408,4 +403,5 @@ Width = 300 Height = 22 + Align = alTop Font.Charset = ANSI_CHARSET Font.Color = clWindowText @@ -420,5 +416,4 @@ OnEnter = edtpopControlEnter OnExit = ControlExit - Align = alTop Caption = 'Default Value' end @@ -460,8 +455,6 @@ Min = -9999 Max = 9999 - Position = 0 TabOrder = 1 Thousands = False - Wrap = False end object edtDefNum: TCaptionEdit @@ -483,8 +476,6 @@ Min = -9999 Max = 9999 - Position = 0 TabOrder = 3 Thousands = False - Wrap = False end object edtMinVal: TCaptionEdit @@ -508,5 +499,4 @@ Position = 1 TabOrder = 7 - Wrap = False end object edtInc: TCaptionEdit @@ -538,8 +528,6 @@ Min = -9999 Max = 9999 - Position = 0 TabOrder = 5 Thousands = False - Wrap = False end end @@ -549,4 +537,5 @@ Width = 300 Height = 22 + Align = alTop Font.Charset = ANSI_CHARSET Font.Color = clWindowText @@ -560,5 +549,4 @@ OnChange = edtURLChange OnEnter = edtpopControlEnter - Align = alTop Caption = 'URL' end @@ -615,4 +603,5 @@ TabStop = True OnChange = cbxDefaultChange + CharsNeedMatch = 1 end object pnlDate: TPanel @@ -678,4 +667,5 @@ TabOrder = 1 OnChange = cbxDateTypeChange + CharsNeedMatch = 1 end end @@ -703,5 +693,4 @@ Position = 1 TabOrder = 3 - Wrap = False end object gbIndent: TGroupBox @@ -743,10 +732,7 @@ Height = 21 Associate = edtIndent - Min = 0 Max = 30 - Position = 0 TabOrder = 1 Thousands = False - Wrap = False end object udPad: TUpDown @@ -756,10 +742,7 @@ Height = 21 Associate = edtPad - Min = 0 Max = 30 - Position = 0 TabOrder = 2 Thousands = False - Wrap = False end object edtPad: TCaptionEdit @@ -823,8 +806,8 @@ end end - object pnlTop: TPanel + object pnlTop: TPanel [4] Left = 0 Top = 0 - Width = 632 + Width = 788 Height = 25 Align = alTop @@ -832,10 +815,10 @@ TabOrder = 3 DesignSize = ( - 632 + 788 25) object MenuBar1: TMenuBar Left = 0 Top = 0 - Width = 23 + Width = 41 Height = 25 Align = alLeft @@ -844,5 +827,4 @@ ButtonWidth = 43 Caption = 'MenuBar1' - Flat = True Menu = mnuMain ShowCaptions = True @@ -850,5 +832,5 @@ end object btnNew: TButton - Left = 557 + Left = 711 Top = 2 Width = 75 @@ -860,5 +842,5 @@ end object btnCopy: TButton - Left = 478 + Left = 632 Top = 2 Width = 75 @@ -871,5 +853,5 @@ end object btnDelete: TButton - Left = 399 + Left = 553 Top = 2 Width = 75 @@ -881,4 +863,166 @@ OnClick = mnuDeleteClick end + end + inherited amgrMain: TVA508AccessibilityManager + Data = ( + ( + 'Component = pnlBottom' + 'Status = stsDefault') + ( + 'Component = lblReq' + 'Status = stsDefault') + ( + 'Component = btnOK' + 'Status = stsDefault') + ( + 'Component = btnCancel' + 'Status = stsDefault') + ( + 'Component = btnApply' + 'Status = stsDefault') + ( + 'Component = btnPreview' + 'Status = stsDefault') + ( + 'Component = cbHide' + 'Status = stsDefault') + ( + 'Component = pnlObjs' + 'Status = stsDefault') + ( + 'Component = cbxObjs' + 'Status = stsDefault') + ( + 'Component = pnlRight' + 'Status = stsDefault') + ( + 'Component = pnlPreview' + 'Status = stsDefault') + ( + 'Component = reNotes' + 'Status = stsDefault') + ( + 'Component = pnlObjInfo' + 'Status = stsDefault') + ( + 'Component = edtName' + 'Status = stsDefault') + ( + 'Component = edtLMText' + 'Status = stsDefault') + ( + 'Component = cbxType' + 'Status = stsDefault') + ( + 'Component = edtTextLen' + 'Status = stsDefault') + ( + 'Component = udTextLen' + 'Status = stsDefault') + ( + 'Component = pnlSwap' + 'Status = stsDefault') + ( + 'Component = edtDefault' + 'Status = stsDefault') + ( + 'Component = pnlNum' + 'Status = stsDefault') + ( + 'Component = udDefNum' + 'Status = stsDefault') + ( + 'Component = edtDefNum' + 'Status = stsDefault') + ( + 'Component = udMinVal' + 'Status = stsDefault') + ( + 'Component = edtMinVal' + 'Status = stsDefault') + ( + 'Component = udInc' + 'Status = stsDefault') + ( + 'Component = edtInc' + 'Status = stsDefault') + ( + 'Component = edtMaxVal' + 'Status = stsDefault') + ( + 'Component = udMaxVal' + 'Status = stsDefault') + ( + 'Component = edtURL' + 'Status = stsDefault') + ( + 'Component = reItems' + 'Status = stsDefault') + ( + 'Component = cbxDefault' + 'Status = stsDefault') + ( + 'Component = pnlDate' + 'Status = stsDefault') + ( + 'Component = edtDateDef' + 'Status = stsDefault') + ( + 'Component = cbxDateType' + 'Status = stsDefault') + ( + 'Component = edtLen' + 'Status = stsDefault') + ( + 'Component = udLen' + 'Status = stsDefault') + ( + 'Component = gbIndent' + 'Status = stsDefault') + ( + 'Component = edtIndent' + 'Status = stsDefault') + ( + 'Component = udIndent' + 'Status = stsDefault') + ( + 'Component = udPad' + 'Status = stsDefault') + ( + 'Component = edtPad' + 'Status = stsDefault') + ( + 'Component = gbMisc' + 'Status = stsDefault') + ( + 'Component = cbActive' + 'Status = stsDefault') + ( + 'Component = cbRequired' + 'Status = stsDefault') + ( + 'Component = cbSepLines' + 'Status = stsDefault') + ( + 'Component = cbExclude' + 'Status = stsDefault') + ( + 'Component = pnlTop' + 'Status = stsDefault') + ( + 'Component = MenuBar1' + 'Status = stsDefault') + ( + 'Component = btnNew' + 'Status = stsDefault') + ( + 'Component = btnCopy' + 'Status = stsDefault') + ( + 'Component = btnDelete' + 'Status = stsDefault') + ( + 'Component = frmTemplateFieldEditor' + 'Status = stsDefault')) end object mnuMain: TMainMenu Index: cprs/trunk/CPRS-Chart/Templates/fTemplateFieldEditor.pas =================================================================== --- cprs/trunk/CPRS-Chart/Templates/fTemplateFieldEditor.pas (revision 456) +++ cprs/trunk/CPRS-Chart/Templates/fTemplateFieldEditor.pas (revision 829) @@ -6,8 +6,8 @@ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ORCtrls, StdCtrls, ExtCtrls, Menus, ComCtrls, uTemplateFields, ORFn, - ToolWin, MenuBar, ORClasses, ORDtTm; + ToolWin, MenuBar, ORClasses, ORDtTm, fBase508Form, VA508AccessibilityManager; type - TfrmTemplateFieldEditor = class(TForm) + TfrmTemplateFieldEditor = class(TfrmBase508Form) pnlBottom: TPanel; btnOK: TButton; @@ -184,5 +184,5 @@ uses rTemplates, fTemplateDialog, Clipbrd, uSpell, uConst, - fTemplateFields; + fTemplateFields, VAUtils; {$R *.DFM} @@ -470,5 +470,5 @@ FUpdating := TRUE; try - cbxDefault.Items.Assign(reItems.Lines); + QuickCopy(reItems, cbxDefault); idx := -1; if(assigned(FFld)) and reItems.Visible and cbxDefault.Visible then @@ -509,5 +509,5 @@ tmp := TORStringList.Create; try - tmp.Assign(SubSetOfTemplateFields(StartFrom, Direction)); + FastAssign(SubSetOfTemplateFields(StartFrom, Direction), tmp); for i := 0 to FDeleted.Count-1 do begin @@ -516,5 +516,5 @@ tmp.delete(idx); end; - ConvertCodes2Text(tmp, TRUE); + ConvertCodes2Text(tmp, FALSE); cbxObjs.ForDataUse(tmp); finally @@ -815,5 +815,5 @@ if FDeleted.IndexOfPiece(FFld.FldName, U, 2) >= 0 then begin - ShowMessage('Template field can not be named the same as a deleted' + CRLF + + ShowMsg('Template field can not be named the same as a deleted' + CRLF + 'field until OK or Apply has been pressed.'); bad := TRUE; Index: cprs/trunk/CPRS-Chart/Templates/fTemplateFields.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Templates/fTemplateFields.dfm (revision 456) +++ cprs/trunk/CPRS-Chart/Templates/fTemplateFields.dfm (revision 829) @@ -1,43 +1,30 @@ -object frmTemplateFields: TfrmTemplateFields +inherited frmTemplateFields: TfrmTemplateFields Left = 212 Top = 155 - Width = 418 - Height = 300 Caption = 'Insert Template Field' - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] + ClientHeight = 319 + ClientWidth = 450 FormStyle = fsStayOnTop - OldCreateOrder = False Position = poOwnerFormCenter OnClose = FormClose OnCreate = FormCreate OnShow = FormShow + ExplicitWidth = 458 + ExplicitHeight = 346 PixelsPerInch = 96 TextHeight = 13 - object pnlBottom: TPanel + object pnlBottom: TPanel [0] Left = 0 - Top = 246 - Width = 410 - Height = 27 + Top = 226 + Width = 450 + Height = 28 Align = alBottom BevelOuter = bvNone - TabOrder = 0 + TabOrder = 1 DesignSize = ( - 410 - 27) - object lblReq: TStaticText - Left = 21 - Top = 8 - Width = 134 - Height = 17 - Caption = '* Indicates a Required Field' - TabOrder = 3 - end + 450 + 28) object btnCancel: TButton - Left = 335 + Left = 371 Top = 4 Width = 75 @@ -47,9 +34,9 @@ Caption = '&Done' ModalResult = 2 - TabOrder = 2 + TabOrder = 3 OnClick = btnCancelClick end object btnInsert: TButton - Left = 255 + Left = 291 Top = 4 Width = 75 @@ -59,23 +46,37 @@ Default = True ModalResult = 4 - TabOrder = 1 + TabOrder = 2 OnClick = btnInsertClick end object btnPreview: TButton - Left = 175 + Left = 211 Top = 4 Width = 75 Height = 21 + Anchors = [akTop, akRight] Caption = '&Preview' Enabled = False + TabOrder = 1 + OnClick = btnPreviewClick + end + object lblReq: TVA508StaticText + Name = 'lblReq' + AlignWithMargins = True + Left = 10 + Top = 12 + Width = 132 + Height = 15 + Alignment = taLeftJustify + Anchors = [akLeft, akBottom] + Caption = '* Indicates a Required Field' TabOrder = 0 - OnClick = btnPreviewClick - end - end - object cboObjects: TORComboBox + ShowAccelChar = True + end + end + object cboObjects: TORComboBox [1] Left = 0 Top = 0 - Width = 410 - Height = 246 + Width = 450 + Height = 226 Style = orcsSimple Align = alClient @@ -89,4 +90,5 @@ ListItemsOnly = True LongList = True + LookupPiece = 0 MaxLength = 0 Pieces = '2,3' @@ -95,8 +97,159 @@ SynonymChars = '' TabPositions = '50,60,70,80,90' - TabOrder = 1 + TabOrder = 0 + TabStop = True OnChange = cboObjectsChange OnDblClick = cboObjectsDblClick OnNeedData = cboObjectsNeedData + CharsNeedMatch = 1 + end + object pnlBottomSR: TPanel [2] + Left = 0 + Top = 254 + Width = 450 + Height = 65 + Align = alBottom + BevelOuter = bvNone + TabOrder = 2 + object lblSRCont2: TVA508StaticText + Name = 'lblSRCont2' + AlignWithMargins = True + Left = 24 + Top = 45 + Width = 423 + Height = 15 + Margins.Left = 24 + Margins.Top = 0 + Margins.Bottom = 0 + Align = alTop + Alignment = taLeftJustify + Caption = + 'speaking text that follows the template field, when the field re' + + 'ceives focus.' + TabOrder = 3 + ShowAccelChar = True + end + object lblSRCont1: TVA508StaticText + Name = 'lblSRCont1' + AlignWithMargins = True + Left = 10 + Top = 30 + Width = 437 + Height = 15 + Margins.Left = 10 + Margins.Top = 0 + Margins.Bottom = 0 + Align = alTop + Alignment = taLeftJustify + Caption = + '*** Place this code after a template field to allow the screen r' + + 'eader to continue' + TabOrder = 2 + ShowAccelChar = True + end + object lblSRStop: TVA508StaticText + Name = 'lblSRStop' + AlignWithMargins = True + Left = 10 + Top = 15 + Width = 437 + Height = 15 + Margins.Left = 10 + Margins.Top = 0 + Margins.Bottom = 0 + Align = alTop + Alignment = taLeftJustify + Caption = '** Screen reader will stop speaking at this point' + TabOrder = 1 + ShowAccelChar = True + end + object pnlSRIntro: TPanel + Left = 0 + Top = 0 + Width = 450 + Height = 15 + Align = alTop + BevelOuter = bvNone + TabOrder = 0 + object lblSRIntro1: TVA508StaticText + Name = 'lblSRIntro1' + AlignWithMargins = True + Left = 10 + Top = 0 + Width = 127 + Height = 15 + Margins.Left = 10 + Margins.Top = 0 + Margins.Bottom = 0 + Align = alLeft + Alignment = taLeftJustify + Caption = 'Screen Reader Codes' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + ParentFont = False + TabOrder = 0 + ShowAccelChar = True + end + object lblSRIntro2: TVA508StaticText + Name = 'lblSRIntro2' + Left = 140 + Top = 0 + Width = 310 + Height = 15 + Align = alClient + Alignment = taLeftJustify + Caption = '(make templates user friendly for those using screen readers)' + TabOrder = 1 + ShowAccelChar = True + end + end + end + inherited amgrMain: TVA508AccessibilityManager + Data = ( + ( + 'Component = pnlBottom' + 'Status = stsDefault') + ( + 'Component = btnCancel' + 'Status = stsDefault') + ( + 'Component = btnInsert' + 'Status = stsDefault') + ( + 'Component = btnPreview' + 'Status = stsDefault') + ( + 'Component = cboObjects' + 'Status = stsDefault') + ( + 'Component = frmTemplateFields' + 'Status = stsDefault') + ( + 'Component = lblReq' + 'Status = stsDefault') + ( + 'Component = pnlBottomSR' + 'Status = stsDefault') + ( + 'Component = lblSRCont2' + 'Status = stsDefault') + ( + 'Component = lblSRCont1' + 'Status = stsDefault') + ( + 'Component = lblSRStop' + 'Status = stsDefault') + ( + 'Component = pnlSRIntro' + 'Status = stsDefault') + ( + 'Component = lblSRIntro1' + 'Status = stsDefault') + ( + 'Component = lblSRIntro2' + 'Status = stsDefault')) end end Index: cprs/trunk/CPRS-Chart/Templates/fTemplateFields.pas =================================================================== --- cprs/trunk/CPRS-Chart/Templates/fTemplateFields.pas (revision 456) +++ cprs/trunk/CPRS-Chart/Templates/fTemplateFields.pas (revision 829) @@ -5,14 +5,21 @@ uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - ORCtrls, ComCtrls, StdCtrls, ExtCtrls; + ORCtrls, ComCtrls, StdCtrls, ExtCtrls, fBase508Form, VA508AccessibilityManager; type - TfrmTemplateFields = class(TForm) + TfrmTemplateFields = class(TfrmBase508Form) pnlBottom: TPanel; btnCancel: TButton; cboObjects: TORComboBox; btnInsert: TButton; - lblReq: TStaticText; btnPreview: TButton; + lblReq: TVA508StaticText; + pnlBottomSR: TPanel; + lblSRCont2: TVA508StaticText; + lblSRCont1: TVA508StaticText; + lblSRStop: TVA508StaticText; + pnlSRIntro: TPanel; + lblSRIntro1: TVA508StaticText; + lblSRIntro2: TVA508StaticText; procedure FormShow(Sender: TObject); procedure FormCreate(Sender: TObject); @@ -28,8 +35,12 @@ { Fre: TRichEdit;} Fre: TCustomEdit; + FInsertAllowed: boolean; + FInitialized: boolean; FAutoLongLines: TNotifyEvent; procedure InsertField; { procedure Setre(const Value: TRichEdit);} procedure Setre(const Value: TCustomEdit); + function ValidPreview: boolean; + function ValidInsert: boolean; public procedure UpdateStatus; @@ -47,5 +58,18 @@ procedure TfrmTemplateFields.FormShow(Sender: TObject); -begin +var + i: integer; +begin + if not FInitialized then + begin + with cboObjects do + begin + for i := low(ScreenReaderCodeLines) to high(ScreenReaderCodeLines) do + Items.Add(ScreenReaderCodeLines[i]); + InsertSeparator; + InitLongList(''); + end; + FInitialized := TRUE; + end; cboObjects.SelectAll; cboObjects.SetFocus; @@ -54,10 +78,10 @@ procedure TfrmTemplateFields.FormCreate(Sender: TObject); begin - cboObjects.InitLongList(''); - cboObjects.ItemHeight := 15; - ResizeAnchoredFormToFont(self); - //ResizeAnchoredFormToFont doesn't work right on the button positions for some reason. - btnCancel.Left := pnlBottom.ClientWidth - btnCancel.Width; - btnInsert.Left := btnCancel.Left - btnInsert.Width - 8; + ResizeFormToFont(self); + cboObjects.ItemHeight := lblReq.Height - 1; + FInsertAllowed := TRUE; + lblReq.Top := (pnlBottom.Height - lblReq.Height); + pnlSRIntro.Height := lblSRStop.Height; + pnlBottomSR.Height := lblSRCont1.Height * 4 + 5; end; @@ -76,6 +100,11 @@ var cnt: integer; - -begin + p1, p2: string; + check: boolean; + i: integer; + +begin + p1 := Piece(cboObjects.Items[cboObjects.ItemIndex],U,1); + if p1 = '' then exit; if assigned(Fre) and (not TORExposedCustomEdit(Fre).ReadOnly) and (cboObjects.ItemIndex >= 0) then begin @@ -83,8 +112,24 @@ cnt := TRichEdit(FRe).Lines.Count else - cnt :=0; - Fre.SelText := TemplateFieldBeginSignature + - Piece(cboObjects.Items[cboObjects.ItemIndex],U,2)+ - TemplateFieldEndSignature; + cnt := 0; + if StrToIntDef(p1, 0) < 0 then + begin + check := true; + for i := low(ScreenReaderCodeIDs) to high(ScreenReaderCodeIDs) do + begin + if p1 = ScreenReaderCodeIDs[i] then + begin + p2 := ScreenReaderCodes[i]; + check := FALSE; + break; + end; + end; + end + else + check := TRUE; + if check then + p2 := TemplateFieldBeginSignature + Piece(cboObjects.Items[cboObjects.ItemIndex],U,2) + + TemplateFieldEndSignature; + Fre.SelText := p2; if Fre is TRichEdit then if(assigned(FAutoLongLines) and (cnt <> TRichEdit(FRe).Lines.Count)) then @@ -95,5 +140,5 @@ procedure TfrmTemplateFields.cboObjectsDblClick(Sender: TObject); begin - if btnInsert.Enabled then + if ValidInsert then InsertField; end; @@ -118,10 +163,39 @@ procedure TfrmTemplateFields.UpdateStatus; begin - btnInsert.Enabled := (not TORExposedCustomEdit(re).ReadOnly); + FInsertAllowed := (not TORExposedCustomEdit(re).ReadOnly); + btnInsert.Enabled := ValidInsert and FInsertAllowed; +end; + +function TfrmTemplateFields.ValidInsert: boolean; +begin + Result := (cboObjects.ItemIndex >= 0); + if Result then + Result := (Piece(cboObjects.Items[cboObjects.ItemIndex],U,1) <> ''); +end; + +function TfrmTemplateFields.ValidPreview: boolean; +var + i: integer; + code: string; +begin + Result := ValidInsert; + if Result then + begin + code := Piece(cboObjects.Items[cboObjects.ItemIndex],U,1); + for I := low(ScreenReaderCodeIDs) to high(ScreenReaderCodeIDs) do + begin + if code = ScreenReaderCodeIDs[i] then + begin + Result := FALSE; + break; + end; + end; + end; end; procedure TfrmTemplateFields.btnInsertClick(Sender: TObject); begin - InsertField; + if ValidInsert then + InsertField; end; @@ -147,5 +221,6 @@ procedure TfrmTemplateFields.cboObjectsChange(Sender: TObject); begin - btnPreview.Enabled := (cboObjects.ItemIndex >= 0) + btnPreview.Enabled := ValidPreview; + btnInsert.Enabled := ValidInsert and FInsertAllowed; end; Index: cprs/trunk/CPRS-Chart/Templates/fTemplateImport.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Templates/fTemplateImport.dfm (revision 456) +++ cprs/trunk/CPRS-Chart/Templates/fTemplateImport.dfm (revision 829) @@ -1,3 +1,3 @@ -object frmTemplateImport: TfrmTemplateImport +inherited frmTemplateImport: TfrmTemplateImport Left = 273 Top = 195 @@ -7,24 +7,24 @@ ClientHeight = 132 ClientWidth = 288 - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] FormStyle = fsStayOnTop - OldCreateOrder = False Position = poScreenCenter PixelsPerInch = 96 TextHeight = 13 - object gaugeImport: TGauge + object gaugeImport: TGauge [0] Left = 8 Top = 82 Width = 272 Height = 21 - ForeColor = clNavy + BackColor = clHighlightText + ForeColor = clHighlight + Font.Charset = DEFAULT_CHARSET + Font.Color = clCaptionText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentFont = False Progress = 0 end - object lblImporting: TStaticText + object lblImporting: TStaticText [1] Left = 8 Top = 4 @@ -37,5 +37,5 @@ TabOrder = 0 end - object animImport: TAnimate + object animImport: TAnimate [2] Left = 8 Top = 20 @@ -44,7 +44,7 @@ Active = True CommonAVI = aviCopyFile - StopFrame = 26 + StopFrame = 20 end - object btnCancel: TButton + object btnCancel: TButton [3] Left = 106 Top = 106 @@ -57,3 +57,18 @@ OnClick = btnCancelClick end + inherited amgrMain: TVA508AccessibilityManager + Data = ( + ( + 'Component = lblImporting' + 'Status = stsDefault') + ( + 'Component = animImport' + 'Status = stsDefault') + ( + 'Component = btnCancel' + 'Status = stsDefault') + ( + 'Component = frmTemplateImport' + 'Status = stsDefault')) + end end Index: cprs/trunk/CPRS-Chart/Templates/fTemplateImport.pas =================================================================== --- cprs/trunk/CPRS-Chart/Templates/fTemplateImport.pas (revision 456) +++ cprs/trunk/CPRS-Chart/Templates/fTemplateImport.pas (revision 829) @@ -5,8 +5,8 @@ uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - Gauges, StdCtrls, ComCtrls; + Gauges, StdCtrls, ComCtrls, fBase508Form, VA508AccessibilityManager; type - TfrmTemplateImport = class(TForm) + TfrmTemplateImport = class(TfrmBase508Form) animImport: TAnimate; btnCancel: TButton; Index: cprs/trunk/CPRS-Chart/Templates/fTemplateObjects.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Templates/fTemplateObjects.dfm (revision 456) +++ cprs/trunk/CPRS-Chart/Templates/fTemplateObjects.dfm (revision 829) @@ -1,23 +1,18 @@ -object frmTemplateObjects: TfrmTemplateObjects +inherited frmTemplateObjects: TfrmTemplateObjects Left = 215 Top = 343 - Width = 247 - Height = 300 ActiveControl = cboObjects Caption = 'Insert Patient Data (Object)' - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] + ClientHeight = 273 + ClientWidth = 239 FormStyle = fsStayOnTop - OldCreateOrder = False Position = poOwnerFormCenter OnClose = FormClose OnShow = FormShow + ExplicitWidth = 247 + ExplicitHeight = 300 PixelsPerInch = 96 TextHeight = 13 - object cboObjects: TORComboBox + object cboObjects: TORComboBox [0] Left = 0 Top = 0 @@ -42,6 +37,7 @@ TabOrder = 0 OnDblClick = cboObjectsDblClick + CharsNeedMatch = 1 end - object pnlBottom: TPanel + object pnlBottom: TPanel [1] Left = 0 Top = 246 @@ -91,3 +87,24 @@ end end + inherited amgrMain: TVA508AccessibilityManager + Data = ( + ( + 'Component = cboObjects' + 'Status = stsDefault') + ( + 'Component = pnlBottom' + 'Status = stsDefault') + ( + 'Component = btnCancel' + 'Status = stsDefault') + ( + 'Component = btnInsert' + 'Status = stsDefault') + ( + 'Component = btnRefresh' + 'Status = stsDefault') + ( + 'Component = frmTemplateObjects' + 'Status = stsDefault')) + end end Index: cprs/trunk/CPRS-Chart/Templates/fTemplateObjects.pas =================================================================== --- cprs/trunk/CPRS-Chart/Templates/fTemplateObjects.pas (revision 456) +++ cprs/trunk/CPRS-Chart/Templates/fTemplateObjects.pas (revision 829) @@ -5,8 +5,9 @@ uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - ORCtrls, StdCtrls, ExtCtrls, ComCtrls, ORFn, dShared; + ORCtrls, StdCtrls, ExtCtrls, ComCtrls, ORFn, dShared, uTemplates, fBase508Form, + VA508AccessibilityManager; type - TfrmTemplateObjects = class(TForm) + TfrmTemplateObjects = class(TfrmBase508Form) cboObjects: TORComboBox; pnlBottom: TPanel; @@ -93,11 +94,26 @@ procedure TfrmTemplateObjects.btnRefreshClick(Sender: TObject); +var + i: integer; + DoIt: boolean; begin -cboObjects.SelectAll; -cboObjects.Clear; -dmodShared.RefreshObject := true; -dmodShared.LoadTIUObjects; -CboOBJECTS.Items.AddStrings(dmodShared.TIUObjects); + cboObjects.Clear; + dmodShared.RefreshObject := true; + dmodShared.LoadTIUObjects; + //---------- CQ #8665 - RV ---------------- + DoIt := TRUE; + UpdatePersonalObjects; + if uPersonalObjects.Count > 0 then + begin + DoIt := FALSE; + for i := 0 to dmodShared.TIUObjects.Count-1 do + if uPersonalObjects.IndexOf(Piece(dmodShared.TIUObjects[i],U,2)) >= 0 then + cboObjects.Items.Add(dmodShared.TIUObjects[i]); + end; + if DoIt then + //---------- end CQ #8665 ------------------ + cboObjects.Items.Assign(dmodShared.TIUObjects); end; end. + Index: cprs/trunk/CPRS-Chart/Templates/fTemplateView.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Templates/fTemplateView.dfm (revision 456) +++ cprs/trunk/CPRS-Chart/Templates/fTemplateView.dfm (revision 829) @@ -1,26 +1,20 @@ -object frmTemplateView: TfrmTemplateView +inherited frmTemplateView: TfrmTemplateView Left = 257 Top = 105 - Width = 578 - Height = 372 Caption = 'View Template' - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - OldCreateOrder = False + ClientHeight = 343 + ClientWidth = 568 Position = poScreenCenter OnClose = FormClose OnCreate = FormCreate OnDestroy = FormDestroy - OnShow = FormShow + ExplicitWidth = 576 + ExplicitHeight = 370 PixelsPerInch = 96 TextHeight = 13 - object pnlBottom: TPanel + object pnlBottom: TPanel [0] Left = 0 - Top = 315 - Width = 570 + Top = 313 + Width = 568 Height = 30 Align = alBottom @@ -28,8 +22,8 @@ TabOrder = 1 DesignSize = ( - 570 + 568 30) object btnClose: TButton - Left = 494 + Left = 492 Top = 6 Width = 75 @@ -52,5 +46,5 @@ end object btnPrint: TButton - Left = 414 + Left = 412 Top = 6 Width = 75 @@ -62,9 +56,9 @@ end end - object reMain: TRichEdit + object reMain: TRichEdit [1] Left = 0 Top = 0 - Width = 570 - Height = 315 + Width = 568 + Height = 313 Align = alClient Color = clCream @@ -82,4 +76,25 @@ WantReturns = False WordWrap = False + end + inherited amgrMain: TVA508AccessibilityManager + Data = ( + ( + 'Component = pnlBottom' + 'Status = stsDefault') + ( + 'Component = btnClose' + 'Status = stsDefault') + ( + 'Component = cbStayOnTop' + 'Status = stsDefault') + ( + 'Component = btnPrint' + 'Status = stsDefault') + ( + 'Component = reMain' + 'Status = stsDefault') + ( + 'Component = frmTemplateView' + 'Status = stsDefault')) end object popView: TPopupMenu Index: cprs/trunk/CPRS-Chart/Templates/fTemplateView.pas =================================================================== --- cprs/trunk/CPRS-Chart/Templates/fTemplateView.pas (revision 456) +++ cprs/trunk/CPRS-Chart/Templates/fTemplateView.pas (revision 829) @@ -5,8 +5,9 @@ uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - StdCtrls, ComCtrls, ExtCtrls, Menus, ORFn; + StdCtrls, ComCtrls, ExtCtrls, Menus, ORFn, fBase508Form, + VA508AccessibilityManager; type - TfrmTemplateView = class(TForm) + TfrmTemplateView = class(TfrmBase508Form) pnlBottom: TPanel; reMain: TRichEdit; @@ -26,6 +27,6 @@ procedure SelectAll1Click(Sender: TObject); procedure btnPrintClick(Sender: TObject); + procedure AlignButtons(); procedure FormCreate(Sender: TObject); - procedure FormShow(Sender: TObject); private end; @@ -52,5 +53,6 @@ if(not assigned(frmTemplateView)) then frmTemplateView := TfrmTemplateView.Create(Application); - ResizeAnchoredFormToFont(frmTemplateView); + //Quick fix to work around glich in resize algorithm + frmTemplateView.AlignButtons(); frmTemplateView.reMain.Lines.Clear; frmTemplateView.Caption := 'Template: ' + Title; @@ -80,4 +82,11 @@ SaveUserBounds(frmTemplateView); Action := caFree; +end; + +procedure TfrmTemplateView.FormCreate(Sender: TObject); +begin + inherited; + ResizeAnchoredFormToFont(Self); + SetFormPosition(Self); end; @@ -118,12 +127,10 @@ end; -procedure TfrmTemplateView.FormCreate(Sender: TObject); +procedure TfrmTemplateView.AlignButtons; +Const + BtnSpace = 8; begin - reMain.Color := ReadOnlyColor; -end; - -procedure TfrmTemplateView.FormShow(Sender: TObject); -begin - SetFormPosition(frmTemplateView); + btnClose.Left := frmTemplateView.Width - btnClose.Width - BtnSpace; + btnPrint.Left := btnClose.Left - BtnSpace - btnPrint.Width; end; Index: cprs/trunk/CPRS-Chart/Templates/mTemplateFieldButton.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Templates/mTemplateFieldButton.dfm (revision 456) +++ cprs/trunk/CPRS-Chart/Templates/mTemplateFieldButton.dfm (revision 829) @@ -2,6 +2,7 @@ Left = 0 Top = 0 - Width = 109 + Width = 136 Height = 14 + AutoScroll = True Font.Charset = ANSI_CHARSET Font.Color = clWindowText @@ -12,19 +13,23 @@ TabOrder = 0 TabStop = True - OnEnter = pnlBtnEnter - OnExit = pnlBtnExit + OnEnter = FrameEnter + OnExit = FrameExit object pnlBtn: TPanel Left = 0 Top = 0 - Width = 109 + Width = 136 Height = 14 Align = alClient TabOrder = 0 + OnExit = FrameExit OnMouseDown = pnlBtnMouseDown OnMouseUp = pnlBtnMouseUp + DesignSize = ( + 136 + 14) object lblText: TLabel Left = 2 Top = -1 - Width = 105 + Width = 132 Height = 14 Alignment = taCenter @@ -35,9 +40,10 @@ OnMouseDown = pnlBtnMouseDown OnMouseUp = pnlBtnMouseUp + ExplicitWidth = 105 end object pbFocus: TPaintBox Left = 1 Top = 1 - Width = 107 + Width = 134 Height = 12 Align = alClient @@ -45,4 +51,5 @@ OnMouseUp = pnlBtnMouseUp OnPaint = pbFocusPaint + ExplicitWidth = 107 end end Index: cprs/trunk/CPRS-Chart/Templates/mTemplateFieldButton.pas =================================================================== --- cprs/trunk/CPRS-Chart/Templates/mTemplateFieldButton.pas (revision 456) +++ cprs/trunk/CPRS-Chart/Templates/mTemplateFieldButton.pas (revision 829) @@ -5,8 +5,8 @@ uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - StdCtrls, ExtCtrls; + StdCtrls, ExtCtrls, uDlgComponents, VA508AccessibilityManager; type - TfraTemplateFieldButton = class(TFrame) + TfraTemplateFieldButton = class(TFrame, ICPRSDialogComponent) pnlBtn: TPanel; lblText: TLabel; @@ -16,8 +16,9 @@ procedure pnlBtnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); - procedure pnlBtnEnter(Sender: TObject); - procedure pnlBtnExit(Sender: TObject); + procedure FrameEnter(Sender: TObject); + procedure FrameExit(Sender: TObject); procedure pbFocusPaint(Sender: TObject); private + FCPRSDialogData: ICPRSDialogComponent; FBtnDown: boolean; FItems: TStringList; @@ -33,4 +34,5 @@ property Items: TStringList read FItems; property OnChange: TNotifyEvent read FOnChange write FOnChange; + property CPRSDialogData: ICPRSDialogComponent read FCPRSDialogData implements ICPRSDialogComponent; end; @@ -40,6 +42,6 @@ uses - ORFn; - + ORFn, VA508AccessibilityRouter; + procedure TfraTemplateFieldButton.pnlBtnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); @@ -69,4 +71,11 @@ idx := 0; ButtonText := FItems[idx]; + if ScreenReaderSystemActive then + begin + txt := FItems[idx]; + if Trim(txt) = '' then + txt := 'blank'; + GetScreenReader.Speak(txt); + end; if assigned(FOnChange) then FOnChange(Self); @@ -86,10 +95,13 @@ end; -procedure TfraTemplateFieldButton.pnlBtnEnter(Sender: TObject); +type + TWinControlFriend = class(TWinControl); + +procedure TfraTemplateFieldButton.FrameEnter(Sender: TObject); begin pbFocus.Invalidate; end; -procedure TfraTemplateFieldButton.pnlBtnExit(Sender: TObject); +procedure TfraTemplateFieldButton.FrameExit(Sender: TObject); begin pbFocus.Invalidate; @@ -98,9 +110,11 @@ constructor TfraTemplateFieldButton.Create(AOwner: TComponent); begin - inherited; + inherited Create(AOwner); + TabStop := TRUE; FItems := TStringList.Create; OnKeyDown := ButtonKeyDown; OnKeyUp := ButtonKeyUp; Font.Size := MainFontSize; + FCPRSDialogData := TCPRSDialogComponent.Create(Self, 'multi value button'); end; @@ -142,6 +156,10 @@ begin FItems.Free; + FCPRSDialogData := nil; inherited; end; +initialization + SpecifyFormIsNotADialog(TfraTemplateFieldButton); + end. Index: cprs/trunk/CPRS-Chart/Templates/rTemplates.pas =================================================================== --- cprs/trunk/CPRS-Chart/Templates/rTemplates.pas (revision 456) +++ cprs/trunk/CPRS-Chart/Templates/rTemplates.pas (revision 829) @@ -105,5 +105,5 @@ CallBroker; RPCBrokerV.Results.Delete(0); - BoilerPlate.Assign(RPCBrokerV.Results); + FastAssign(RPCBrokerV.Results, BoilerPlate); RPCBrokerV.Results.Clear; end; @@ -260,8 +260,8 @@ TmpList := TStringList.Create; try - TmpList.Assign(RPCBrokerV.Results); + FastAssign(RPCBrokerV.Results, TmpList); SortByPiece(TmpList, U, 2); MixedCaseList(TmpList); - RPCBrokerV.Results.Assign(TmpList); + FastAssign(TmpList, RPCBrokerV.Results); finally TmpList.Free; @@ -377,5 +377,5 @@ begin CallV('TIU FIELD CHECK',[nil]); - ResultString.Assign(RPCBrokerV.Results); + FastAssign(RPCBrokerV.Results, ResultString); end; @@ -398,5 +398,5 @@ CallBroker; end; - Text.Assign(RPCBrokerV.Results); + FastAssign(RPCBrokerV.Results, Text); end; @@ -449,5 +449,5 @@ Result := TRUE; CallV('TIU FIELD LIST IMPORT',[nil]); - ResultSet.Assign(RPCBrokerV.Results); + FastAssign(RPCBrokerV.Results, ResultSet); if ResultSet.Count < 1 then Result := FALSE; Index: cprs/trunk/CPRS-Chart/Templates/uTemplateFields.pas =================================================================== --- cprs/trunk/CPRS-Chart/Templates/uTemplateFields.pas (revision 456) +++ cprs/trunk/CPRS-Chart/Templates/uTemplateFields.pas (revision 829) @@ -5,9 +5,11 @@ uses Forms, SysUtils, Classes, Dialogs, StdCtrls, ExtCtrls, Controls, Contnrs, - Graphics, ORClasses, ComCtrls, ORDtTm; + Graphics, ORClasses, ComCtrls, ORDtTm, uDlgComponents, TypInfo, ORFn, StrUtils; type TTemplateFieldType = (dftUnknown, dftEditBox, dftComboBox, dftButton, dftCheckBoxes, - dftRadioButtons, dftDate, dftNumber, dftHyperlink, dftWP, dftText); + dftRadioButtons, dftDate, dftNumber, dftHyperlink, dftWP, dftText, +// keep dftScreenReader as last entry - users can not create this type of field + dftScreenReader); TTmplFldDateType = (dtUnknown, dtDate, dtDateTime, dtDateReqTime, @@ -30,5 +32,5 @@ FID: string; FFont: TFont; - FPanel: TPanel; + FPanel: TDlgFieldPanel; FControls: TStringList; FIndents: TStringList; @@ -47,4 +49,5 @@ procedure SetFieldValues(const Value: string); procedure SetAutoDestroyOnPanelFree(const Value: boolean); + function StripCode(var txt: string; code: char): boolean; protected procedure UpDownChange(Sender: TObject); @@ -57,5 +60,6 @@ constructor Create(AParent: TWinControl; AID, Text: string); destructor Destroy; override; - function GetPanel(MaxLen: integer; AParent: TWinControl): TPanel; + function GetPanel(MaxLen: integer; AParent: TWinControl; + OwningCheckBox: TCPRSDialogParentCheckBox): TDlgFieldPanel; function GetText: string; property Text: string read FText write FText; @@ -174,9 +178,38 @@ procedure ConvertCodes2Text(sl: TStrings; Short: boolean); function StripEmbedded(iItems: string): string; +procedure StripScreenReaderCodes(var Text: string); overload; +procedure StripScreenReaderCodes(SL: TStrings); overload; +function HasScreenReaderBreakCodes(SL: TStrings): boolean; const - TemplateFieldBeginSignature = '{FLD:'; + TemplateFieldSignature = '{FLD'; + TemplateFieldBeginSignature = TemplateFieldSignature + ':'; TemplateFieldEndSignature = '}'; + ScreenReaderCodeSignature = '{SR-'; + ScreenReaderCodeType = ' Screen Reader Code'; + ScreenReaderCodeCount = 2; + ScreenReaderShownCount = 1; + ScreenReaderStopCode = ScreenReaderCodeSignature + 'STOP' + TemplateFieldEndSignature; + ScreenReaderStopCodeLen = Length(ScreenReaderStopCode); + ScreenReaderStopCodeID = '-43'; + ScreenReaderStopName = 'SCREEN READER STOP CODE **'; + ScreenReaderStopCodeLine = ScreenReaderStopCodeID + U + ScreenReaderStopName + U + ScreenReaderCodeType; + ScreenReaderContinueCode = ScreenReaderCodeSignature + 'CONT' + TemplateFieldEndSignature; + ScreenReaderContinueCodeLen = Length(ScreenReaderContinueCode); + ScreenReaderContinueCodeOld = ScreenReaderCodeSignature + 'CONTINUE' + TemplateFieldEndSignature; + ScreenReaderContinueCodeOldLen = Length(ScreenReaderContinueCodeOld); + ScreenReaderContinueCodeID = '-44'; + ScreenReaderContinueCodeName = 'SCREEN READER CONTINUE CODE ***'; + ScreenReaderContinueCodeLine = ScreenReaderContinueCodeID + U + ScreenReaderContinueCodeName + U + ScreenReaderCodeType; MissingFieldsTxt = 'One or more required fields must still be entered.'; + + ScreenReaderCodes: array[0..ScreenReaderCodeCount] of string = + (ScreenReaderStopCode, ScreenReaderContinueCode, ScreenReaderContinueCodeOld); + ScreenReaderCodeLens: array[0..ScreenReaderCodeCount] of integer = + (ScreenReaderStopCodeLen, ScreenReaderContinueCodeLen, ScreenReaderContinueCodeOldLen); + ScreenReaderCodeIDs: array[0..ScreenReaderShownCount] of string = + (ScreenReaderStopCodeID, ScreenReaderContinueCodeID); + ScreenReaderCodeLines: array[0..ScreenReaderShownCount] of string = + (ScreenReaderStopCodeLine, ScreenReaderContinueCodeLine); TemplateFieldTypeCodes: array[TTemplateFieldType] of string[1] = @@ -191,18 +224,20 @@ { dftHyperlink } 'H', { dftWP } 'W', - { dftText } 'T'); + { dftText } 'T', + { dftScreenReader } 'S'); TemplateFieldTypeDesc: array[TTemplateFieldType, boolean] of string = { dftUnknown } (('',''), - { dftEditBox } ('Edit Box', 'Edit'), - { dftComboBox } ('Combo Box', 'Combo'), - { dftButton } ('Button', 'Button'), - { dftCheckBoxes } ('Check Boxes', 'Check'), - { dftRadioButtons } ('Radio Buttons', 'Radio'), - { dftDate } ('Date', 'Date'), - { dftNumber } ('Number', 'Num'), - { dftHyperlink } ('Hyperlink', 'Link'), - { dftWP } ('Word Processing','WP'), - { dftWP } ('Display Text', 'Text')); + { dftEditBox } ('Edit Box', 'Edit'), + { dftComboBox } ('Combo Box', 'Combo'), + { dftButton } ('Button', 'Button'), + { dftCheckBoxes } ('Check Boxes', 'Check'), + { dftRadioButtons } ('Radio Buttons', 'Radio'), + { dftDate } ('Date', 'Date'), + { dftNumber } ('Number', 'Num'), + { dftHyperlink } ('Hyperlink', 'Link'), + { dftWP } ('Word Processing', 'WP'), + { dftText } ('Display Text', 'Text'), + { dftScreenReader } ('Screen Reader Stop', 'SRStop')); TemplateDateTypeDesc: array[TTmplFldDateType, boolean] of string = @@ -226,5 +261,6 @@ { dftHyperlink } 'LINK', { dftWP } 'WRDP', - { dftTExt } 'TEXT'); + { dftTExt } 'TEXT', + { dftScreenReader } 'SRST'); TemplateFieldDateCodes: array[TTmplFldDateType] of string[1] = @@ -239,25 +275,10 @@ MaxTFWPLines = 20; MaxTFEdtLen = 70; - -type - TFieldPanel = class(TPanel) {This is the panel associated with the child} - private {dialog checkboxes in reminders dialogs} - FOnDestroy: TNotifyEvent; - FCanvas: TControlCanvas; {used to draw focus rect} - function GetFocus: boolean; - procedure SetTheFocus(const Value: boolean); - protected {used to draw focus rect} - procedure Paint; override; {used to draw focus rect} - public - destructor Destroy; override; - property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy; - property Focus: boolean read GetFocus write SetTheFocus; {to draw focus rect} - property OnKeyPress; {to click the checkbox when spacebar is pressed} - end; - + implementation uses - ORFn, rTemplates, ORCtrls, mTemplateFieldButton, dShared, uConst, uCore, rCore, Windows; + rTemplates, ORCtrls, mTemplateFieldButton, dShared, uConst, uCore, rCore, Windows, + VAUtils, VA508AccessibilityManager, VA508AccessibilityRouter; const @@ -279,20 +300,4 @@ FieldIDLen = 6; NewLine = 'NL'; - -type - TFieldLabel = class(TLabel) - private - FExclude: boolean; - public - property Exclude: boolean read FExclude; - end; - - TWebLabel = class(TFieldLabel) - private - FAddr: string; - procedure Clicked(Sender: TObject); - public - procedure Init(Addr: string); - end; function GetNewFieldID: string; @@ -694,5 +699,5 @@ Result := (msg <> ''); if(Result) then - ShowMessage(msg); + ShowMsg(msg); end; @@ -861,5 +866,5 @@ AList.Add(''); AList.Add('The following inactive template fields were found:'); - AList.AddStrings(InactiveList); + FastAddStrings(InactiveList, AList); end; if(AList.Count > 0) then @@ -1079,8 +1084,7 @@ dbox: TORDateBox; dcbo: TORDateCombo; - lbl: TFieldLabel; + lbl: TCPRSTemplateFieldLabel; re: TRichEdit; - pnl: TPanel; - ud: TUpDown; + pnl: TCPRSDialogNumber; DefDate: TFMDateTime; ctrl: TControl; @@ -1123,5 +1127,6 @@ dftEditBox: begin - edt := TEdit.Create(nil); + edt := TCPRSDialogFieldEdit.Create(nil); + (edt as ICPRSDialogComponent).RequiredField := Required; edt.Parent := Entry.FPanel; edt.BorderStyle := bsNone; @@ -1135,4 +1140,5 @@ edt.Tag := CtrlID; edt.OnChange := Entry.DoChange; + UpdateColorsFor508Compliance(edt, TRUE); ctrl := edt; end; @@ -1140,5 +1146,6 @@ dftComboBox: begin - cbo := TORComboBox.Create(nil); + cbo := TCPRSDialogComboBox.Create(nil); + (cbo as ICPRSDialogComponent).RequiredField := Required; cbo.Parent := Entry.FPanel; cbo.TemplateField := TRUE; @@ -1165,4 +1172,5 @@ cbo.DropDownCount := cbo.Items.Count; end; + UpdateColorsFor508Compliance(cbo, TRUE); ctrl := cbo; end; @@ -1171,4 +1179,5 @@ begin btn := TfraTemplateFieldButton.Create(nil); + (btn as ICPRSDialogComponent).RequiredField := Required; btn.Parent := Entry.FPanel; {Clear out embedded fields} @@ -1179,4 +1188,5 @@ btn.Tag := CtrlID; btn.OnChange := Entry.DoChange; + UpdateColorsFor508Compliance(btn); ctrl := btn; end; @@ -1192,5 +1202,7 @@ for i := 0 to TmpSL.Count-1 do begin - cb := TORCheckBox.Create(nil); + cb := TCPRSDialogCheckBox.Create(nil); + if i = 0 then + (cb as ICPRSDialogComponent).RequiredField := Required; cb.Parent := Entry.FPanel; cb.Caption := TmpSL[i]; @@ -1210,4 +1222,5 @@ cb.StringData := NewLine; cb.OnClick := Entry.DoChange; + UpdateColorsFor508Compliance(cb); inc(Index); Entry.FControls.InsertObject(Index, '', cb); @@ -1228,5 +1241,6 @@ if FDateType in DateComboTypes then begin - dcbo := TORDateCombo.Create(nil); + dcbo := TCPRSDialogDateCombo.Create(nil); + (dcbo as ICPRSDialogComponent).RequiredField := Required; dcbo.Parent := Entry.FPanel; dcbo.Tag := CtrlID; @@ -1237,9 +1251,11 @@ dcbo.TemplateField := TRUE; dcbo.OnChange := Entry.DoChange; + UpdateColorsFor508Compliance(dcbo, TRUE); ctrl := dcbo; end else begin - dbox := TORDateBox.Create(nil); + dbox := TCPRSDialogDateBox.Create(nil); + (dbox as ICPRSDialogComponent).RequiredField := Required; dbox.Parent := Entry.FPanel; dbox.Tag := CtrlID; @@ -1254,4 +1270,5 @@ dbox.Width := (wdth * tmp) + 18; dbox.OnChange := Entry.DoChange; + UpdateColorsFor508Compliance(dbox, TRUE); ctrl := dbox; end; @@ -1260,31 +1277,22 @@ dftNumber: begin - pnl := TPanel.Create(nil); + pnl := TCPRSDialogNumber.CreatePanel(nil); + (pnl as ICPRSDialogComponent).RequiredField := Required; pnl.Parent := Entry.FPanel; pnl.BevelOuter := bvNone; pnl.Tag := CtrlID; - edt := TEdit.Create(pnl); - edt.Parent := pnl; - edt.BorderStyle := bsNone; - edt.Height := ht; - edt.Width := (wdth * 5 + 4); - edt.Top := 0; - edt.Left := 0; - edt.AutoSelect := True; - ud := TUpDown.Create(pnl); - ud.Parent := pnl; - ud.Associate := edt; - ud.Min := MinVal; - ud.Max := MaxVal; - ud.Min := MinVal; // Both ud.Min settings are needeed! + pnl.Edit.Height := ht; + pnl.Edit.Width := (wdth * 5 + 4); + pnl.UpDown.Min := MinVal; + pnl.UpDown.Max := MaxVal; + pnl.UpDown.Min := MinVal; // Both ud.Min settings are needeed! i := Increment; if i < 1 then i := 1; - ud.Increment := i; - ud.Thousands := FALSE; - ud.Position := StrToIntDef(EditDefault, 0); - edt.Tag := Integer(ud); - edt.OnChange := Entry.UpDownChange; - pnl.Height := edt.Height; - pnl.Width := edt.Width + ud.Width; + pnl.UpDown.Increment := i; + pnl.UpDown.Position := StrToIntDef(EditDefault, 0); + pnl.Edit.OnChange := Entry.UpDownChange; + pnl.Height := pnl.Edit.Height; + pnl.Width := pnl.Edit.Width + pnl.UpDown.Width; + UpdateColorsFor508Compliance(pnl, TRUE); ctrl := pnl; end; @@ -1293,10 +1301,10 @@ begin if (FFldType = dftHyperlink) and User.WebAccess then - lbl := TWebLabel.Create(nil) + lbl := TCPRSDialogHyperlinkLabel.Create(nil) else - lbl := TFieldLabel.Create(nil); + lbl := TCPRSTemplateFieldLabel.Create(nil); lbl.Parent := Entry.FPanel; lbl.ShowAccelChar := FALSE; - lbl.FExclude := FSepLines; + lbl.Exclude := FSepLines; if (FFldType = dftHyperlink) then begin @@ -1313,7 +1321,8 @@ lbl.Caption := STmp; end; - if lbl is TWebLabel then - TWebLabel(lbl).Init(FURL); + if lbl is TCPRSDialogHyperlinkLabel then + TCPRSDialogHyperlinkLabel(lbl).Init(FURL); lbl.Tag := CtrlID; + UpdateColorsFor508Compliance(lbl); ctrl := lbl; end; @@ -1321,5 +1330,6 @@ dftWP: begin - re := TRichEdit.Create(nil); + re := TCPRSDialogRichEdit.Create(nil); + (re as ICPRSDialogComponent).RequiredField := Required; re.Parent := Entry.FPanel; re.Tag := CtrlID; @@ -1339,4 +1349,5 @@ re.Lines.Text := Items; re.OnChange := Entry.DoChange; + UpdateColorsFor508Compliance(re, TRUE); ctrl := re; end; @@ -1358,5 +1369,5 @@ Result := FLocked; if(not FLocked) then - ShowMessage('Template Field ' + FFldName + ' is currently being edited by another user.'); + ShowMsg('Template Field ' + FFldName + ' is currently being edited by another user.'); end else @@ -1707,4 +1718,5 @@ const EOL_MARKER = #182; + SR_BREAK = #186; procedure PanelDestroy(AData: Pointer; Sender: TObject); @@ -1737,12 +1749,17 @@ FControls.Text := Text; if(FControls.Count > 1) then + begin for i := 1 to FControls.Count-1 do FControls[i] := EOL_MARKER + FControls[i]; + if not ScreenReaderSystemActive then + StripScreenReaderCodes(FControls); + end; FFirstBuild := TRUE; - FPanel := TFieldPanel.Create(AParent.Owner); + FPanel := TDlgFieldPanel.Create(AParent.Owner); FPanel.Parent := AParent; FPanel.BevelOuter := bvNone; FPanel.Caption := ''; FPanel.Font.Assign(FFont); + UpdateColorsFor508Compliance(FPanel, TRUE); idx := 0; while (idx < FControls.Count) do @@ -1771,5 +1788,12 @@ FControls[idx] := copy(txt,1,i-1); if(Fld.Required) then + begin + if ScreenReaderSystemActive then + begin + if Fld.FFldType in [dftCheckBoxes, dftRadioButtons] then + FControls[idx] := FControls[idx] + ScreenReaderStopCode; + end; FControls[idx] := FControls[idx] + '*'; + end; Fld.CreateDialogControls(Self, idx, CtrlID); FControls.Insert(idx+1,copy(txt,i,MaxInt)); @@ -1789,4 +1813,20 @@ end; inc(idx); + end; + if ScreenReaderSystemActive then + begin + idx := 0; + while (idx < FControls.Count) do + begin + txt := FControls[idx]; + i := pos(ScreenReaderStopCode, txt); + if i > 0 then + begin + FControls[idx] := copy(txt, 1, i-1); + txt := copy(txt, i + ScreenReaderStopCodeLen, MaxInt); + FControls.Insert(idx+1, SR_BREAK + txt); + end; + inc(idx); + end; end; end; @@ -1867,7 +1907,7 @@ ind := 0; end; - if(Ctrl is TFieldLabel) then - begin - if not TFieldLabel(Ctrl).Exclude then begin + if(Ctrl is TCPRSTemplateFieldLabel) then + begin + if not TCPRSTemplateFieldLabel(Ctrl).Exclude then begin if emField <> '' then begin iField := GetTemplateField(emField,FALSE); @@ -1884,9 +1924,9 @@ end; else {case} - Result := TFieldLabel(Ctrl).Caption + Result := TCPRSTemplateFieldLabel(Ctrl).Caption end; {case iField.FldType} end {if emField} else - Result := TFieldLabel(Ctrl).Caption; + Result := TCPRSTemplateFieldLabel(Ctrl).Caption; end; end @@ -2014,7 +2054,8 @@ end; -function TTemplateDialogEntry.GetPanel(MaxLen: integer; AParent: TWinControl): TPanel; -var - i, x, y, cnt, idx, ind, yinc, ybase, MaxX: integer; +function TTemplateDialogEntry.GetPanel(MaxLen: integer; AParent: TWinControl; + OwningCheckBox: TCPRSDialogParentCheckBox): TDlgFieldPanel; +var + i, x, y, cnt, idx, ind, yinc, ybase, MaxX: integer; MaxTextLen: integer; {Max num of chars per line in pixels} MaxChars: integer; {Max num of chars per line} @@ -2022,33 +2063,77 @@ ctrl: TControl; LastLineBlank: boolean; + sLbl: TCPRSDialogStaticLabel; + nLbl: TVA508ChainedLabel; + sLblHeight: integer; + TabOrdr: integer; + const FOCUS_RECT_MARGIN = 2; {The margin around the panel so the label won't overlay the focus rect on its parent panel.} + + procedure Add2TabOrder(ctrl: TWinControl); + begin + ctrl.TabOrder := TabOrdr; + inc(TabOrdr); + end; + + function StripSRCode(var txt: string; code: string; len: integer): integer; + begin + Result := pos(code, txt); + if Result > 0 then + begin + delete(txt,Result,len); + dec(Result); + end + else + Result := -1; + end; + procedure DoLabel(Atxt: string); var - lbl: TLabel; - - begin - lbl := TLabel.Create(nil); - lbl.Parent := FPanel; - lbl.ShowAccelChar := FALSE; - lbl.Caption := Atxt; - lbl.Left := x; - lbl.Top := y; - inc(x, lbl.Width); - end; - - procedure NextLine; - begin - if(MaxX < x) then - MaxX := x; - x := FOCUS_RECT_MARGIN; {leave two pixels on the left for the Focus Rect} - inc(y, yinc); - yinc := ybase; - end; - -begin - MaxTextLen := MaxLen - (FOCUS_RECT_MARGIN * 2);{save room for the focus rectangle on the panel} - if(FFirstBuild or (FPanel.Width <> MaxLen)) then + ctrl: TControl; + tempLbl: TVA508ChainedLabel; + + begin + if ScreenReaderSystemActive then + begin + if assigned(sLbl) then + begin + tempLbl := TVA508ChainedLabel.Create(nil); + if assigned(nLbl) then + nLbl.NextLabel := tempLbl + else + sLbl.NextLabel := tempLbl; + nLbl := tempLbl; + ctrl := nLbl; + end + else + begin + sLbl := TCPRSDialogStaticLabel.Create(nil); + ctrl := sLbl; + end; + end + else + ctrl := TLabel.Create(nil); + SetOrdProp(ctrl, ShowAccelCharProperty, ord(FALSE)); + SetStrProp(ctrl, CaptionProperty, Atxt); + ctrl.Parent := FPanel; + ctrl.Left := x; + ctrl.Top := y; + if ctrl = sLbl then + begin + Add2TabOrder(sLbl); + sLbl.Height := sLblHeight; + ScreenReaderSystem_CurrentLabel(sLbl); + end; + if ScreenReaderSystemActive then + ScreenReaderSystem_AddText(Atxt); + UpdateColorsFor508Compliance(ctrl); + inc(x, ctrl.Width); + end; + + procedure Init; + var + lbl : TLabel; begin if(FFirstBuild) then @@ -2061,15 +2146,96 @@ //ybase := FontHeightPixel(FFont.Handle) + 1 + (FOCUS_RECT_MARGIN * 2); AGP commentout line for //reminder spacing - ybase := FontHeightPixel(FFont.Handle); + ybase := FontHeightPixel(FFont.Handle) + 2; yinc := ybase; LastLineBlank := FALSE; + sLbl := nil; + nLbl := nil; + TabOrdr := 0; + if ScreenReaderSystemActive then + begin + ScreenReaderSystem_CurrentCheckBox(OwningCheckBox); + lbl := TLabel.Create(nil); + try + lbl.Parent := FPanel; + sLblHeight := lbl.Height + 2; + finally + lbl.Free; + end; + + end; + end; + + procedure Text508Work; + var + ContinueCode: boolean; + begin + if StripCode(txt, SR_BREAK) then + begin + ScreenReaderSystem_Stop; + nLbl := nil; + sLbl := nil; + end; + + ContinueCode := FALSE; + while StripSRCode(txt, ScreenReaderContinueCode, ScreenReaderContinueCodeLen) >= 0 do + ContinueCode := TRUE; + while StripSRCode(txt, ScreenReaderContinueCodeOld, ScreenReaderContinueCodeOldLen) >= 0 do + ContinueCode := TRUE; + if ContinueCode then + ScreenReaderSystem_Continue; + end; + + procedure Ctrl508Work(ctrl: TControl); + var + lbl: TCPRSTemplateFieldLabel; + begin + if (Ctrl is TCPRSTemplateFieldLabel) and (not (Ctrl is TCPRSDialogHyperlinkLabel)) then + begin + lbl := Ctrl as TCPRSTemplateFieldLabel; + if trim(lbl.Caption) <> '' then + begin + ScreenReaderSystem_CurrentLabel(lbl); + ScreenReaderSystem_AddText(lbl.Caption); + end + else + begin + lbl.TabStop := FALSE; + ScreenReaderSystem_Stop; + end; + end + else + begin + if ctrl is TWinControl then + Add2TabOrder(TWinControl(ctrl)); + if Supports(ctrl, ICPRSDialogComponent) then + ScreenReaderSystem_CurrentComponent(ctrl as ICPRSDialogComponent); + end; + sLbl := nil; + nLbl := nil; + end; + + procedure NextLine; + begin + if(MaxX < x) then + MaxX := x; + x := FOCUS_RECT_MARGIN; {leave two pixels on the left for the Focus Rect} + inc(y, yinc); + yinc := ybase; + end; + +begin + MaxTextLen := MaxLen - (FOCUS_RECT_MARGIN * 2);{save room for the focus rectangle on the panel} + if(FFirstBuild or (FPanel.Width <> MaxLen)) then + begin + Init; for i := 0 to FControls.Count-1 do begin txt := FControls[i]; - if(copy(txt,1,1) = EOL_MARKER) then + if ScreenReaderSystemActive then + Text508Work; + if StripCode(txt,EOL_MARKER) then begin if((x <> 0) or LastLineBlank) then NextLine; - delete(txt,1,1); LastLineBlank := (txt = ''); end; @@ -2120,4 +2286,6 @@ if(assigned(ctrl)) then begin + if ScreenReaderSystemActive then + Ctrl508Work(ctrl); idx := FIndents.IndexOfObject(Ctrl); if idx >= 0 then @@ -2137,5 +2305,5 @@ inc(x, Ctrl.Width + 4); if yinc <= Ctrl.Height then - yinc := Ctrl.Height + 1; + yinc := Ctrl.Height + 2; if (x < MaxLen) and ((Ctrl is TRichEdit) or ((Ctrl is TLabel) and (pos(CRLF, TLabel(Ctrl).Caption) > 0))) then @@ -2150,4 +2318,6 @@ if(FFieldValues <> '') then SetFieldValues(FFieldValues); + if ScreenReaderSystemActive then + ScreenReaderSystem_Stop; Result := FPanel; end; @@ -2162,16 +2332,25 @@ i, idx: integer; obj: TObject; + max: integer; begin if(assigned(FPanel)) then begin - for i := FPanel.ControlCount-1 downto 0 do - if(FPanel.Controls[i] is TLabel) then + max := FPanel.ControlCount-1; + for i := max downto 0 do + begin +// deleting TVA508StaticText can delete several TVA508ChainedLabel components + if i < FPanel.ControlCount then begin obj := FPanel.Controls[i]; - idx := FControls.IndexOfObject(obj); - if idx < 0 then - obj.Free; - end; + if (not (obj is TVA508ChainedLabel)) and + ((obj is TLabel) or (obj is TVA508StaticText)) then + begin + idx := FControls.IndexOfObject(obj); + if idx < 0 then + obj.Free; + end; + end; + end; end; end; @@ -2188,8 +2367,8 @@ M.Data := Self; M.Code := @PanelDestroy; - TFieldPanel(FPanel).OnDestroy := TNotifyEvent(M); + FPanel.OnDestroy := TNotifyEvent(M); end else - TFieldPanel(FPanel).OnDestroy := nil; + FPanel.OnDestroy := nil; end; @@ -2232,4 +2411,5 @@ begin Done := FALSE; + TORCheckBox(Ctrl).Checked := FALSE; //<-PSI-06-170-ADDED THIS LINE - v27.23 - RV if(cnt = 0) then cnt := DelimCount(AText, '|') + 1; @@ -2278,72 +2458,24 @@ end; +function TTemplateDialogEntry.StripCode(var txt: string; code: char): boolean; +var + p: integer; +begin + p := pos(code, txt); + Result := (p > 0); + if Result then + begin + while p > 0 do + begin + delete(txt, p, 1); + p := pos(code, txt); + end; + end; +end; + procedure TTemplateDialogEntry.UpDownChange(Sender: TObject); begin EnsureText(TEdit(Sender), TUpDown(TEdit(Sender).Tag)); DoChange(Sender); -end; - -{ TFieldPanel } - -destructor TFieldPanel.Destroy; -begin - if(assigned(FOnDestroy)) then - FOnDestroy(Self); - inherited; -end; - -{intercept the paint event to draw the focus rect if FFocused is true} -function TFieldPanel.GetFocus: boolean; -begin - result := Focused; -end; - -procedure TFieldPanel.Paint; -var - DC: HDC; - R: TRect; - -begin - inherited; - if(Focused) then - begin - if(not assigned(FCanvas)) then - FCanvas := TControlCanvas.Create; - DC := GetWindowDC(Handle); - try - FCanvas.Handle := DC; - R := ClientRect; - InflateRect(R, -1, -1); - FCanvas.DrawFocusRect(R); - finally - ReleaseDC(Handle, DC); - end; - end; -end; - -procedure TFieldPanel.SetTheFocus(const Value: boolean); -begin - if Value then - SetFocus; -end; - -{ TWebLabel } - -procedure TWebLabel.Clicked(Sender: TObject); -begin - GotoWebPage(FAddr); -end; - -procedure TWebLabel.Init(Addr: string); -begin - FAddr := Addr; - OnClick := Clicked; - Font.Assign(TORExposedControl(Parent).Font); - Font.Color := clActiveCaption; - Font.Style := Font.Style + [fsUnderline]; - AdjustBounds; // make sure we have the right width - AutoSize := FALSE; - Height := Height + 1; // Courier New doesn't support underline unless it's higher - Cursor := crHandPoint; end; @@ -2371,4 +2503,48 @@ end; +procedure StripScreenReaderCodes(var Text: string); +var + p, j: integer; +begin + for j := low(ScreenReaderCodes) to high(ScreenReaderCodes) do + begin + p := 1; + while (p > 0) do + begin + p := posex(ScreenReaderCodes[j], Text, p); + if p > 0 then + delete(Text, p, ScreenReaderCodeLens[j]); + end; + end; +end; + +procedure StripScreenReaderCodes(SL: TStrings); +var + temp: string; + i: integer; + +begin + for i := 0 to SL.Count - 1 do + begin + temp := SL[i]; + StripScreenReaderCodes(temp); + SL[i] := temp; + end; +end; + +function HasScreenReaderBreakCodes(SL: TStrings): boolean; +var + i: integer; + +begin + Result := TRUE; + for i := 0 to SL.Count - 1 do + begin + if pos(ScreenReaderCodeSignature, SL[i]) > 0 then + exit; + end; + Result := FALSE; +end; + initialization Index: cprs/trunk/CPRS-Chart/Templates/uTemplates.pas =================================================================== --- cprs/trunk/CPRS-Chart/Templates/uTemplates.pas (revision 456) +++ cprs/trunk/CPRS-Chart/Templates/uTemplates.pas (revision 829) @@ -253,4 +253,9 @@ function MakeXMLParamTIU(ADCSummID: string; ADCSummRec: TEditDCSummRec): string; overload; function GetXMLParamReturnValueTIU(DocInfo, ParamTag: string): string; +procedure UpdatePersonalObjects; +procedure SetTemplateDialogCanceled(value: Boolean); +function WasTemplateDialogCanceled: Boolean; +procedure SetTemplateBPHasObjects(value: Boolean); +function TemplateBPHasObjects: Boolean; const @@ -278,4 +283,5 @@ ConsultsTemplate: TTemplate = nil; ProceduresTemplate: TTemplate = nil; + uPersonalObjects: TStringList = nil; // -------- CQ #8665 - RV ------------ implementation @@ -283,6 +289,11 @@ uses Windows, rTemplates, uCore, dShared, fTemplateDialog, ActiveX, ComObj, uTemplateFields, - XMLUtils, fTemplateImport, Word97, uSpell, rCore, uConst, ORCtrls, uEventHooks, - fReminderDialog, rODBase; + XMLUtils, fTemplateImport, uSpell, rCore, uConst, ORCtrls, uEventHooks, + fReminderDialog, rODBase + {$IFDEF VER140} + , Word97; + {$ELSE} + , WordXP, VAUtils; + {$ENDIF} const @@ -311,4 +322,6 @@ uDGroupConsults: integer = 0; uDGroupProcedures: integer = 0; + uTemplateDialogCanceled: Boolean = FALSE; + uTemplateBPHasObjects: Boolean = FALSE; type @@ -531,5 +544,5 @@ try GetTemplateRoots; - TmpSL.Assign(RPCBrokerV.Results); + FastAssign(RPCBrokerV.Results, TmpSL); for i := 0 to TmpSL.Count-1 do AddTemplate(TmpSL[i]); @@ -559,5 +572,5 @@ try GetTemplateChildren(tmpl.FID); - TmpSL.Assign(RPCBrokerV.Results); + FastAssign(RPCBrokerV.Results, TmpSL); for i := 0 to TmpSL.Count-1 do AddTemplate(TmpSL[i], tmpl); @@ -597,4 +610,12 @@ TempSL := nil; end; + // -------- CQ #8665 - RV ------------ + if (assigned(uPersonalObjects)) then + begin + KillObj(@uPersonalObjects); + uPersonalObjects.Free; + uPersonalObjects := nil; + end; + // ------end CQ #8665 ------------ if(assigned(Deleted)) then begin @@ -721,7 +742,7 @@ begin if(assigned(Errors)) then - ShowMessage(Errors.text) + ShowMsg(Errors.text) else - ShowMessage(SingleError); + ShowMsg(SingleError); end; @@ -865,5 +886,5 @@ else DescSL.Add('5,1=@'); - TempSL.AddStrings(DescSL) + FastAddStrings(DescSL, TempSL) finally DescSL.Free; @@ -1173,5 +1194,9 @@ WApp.Connect; TmpVar := AFileName; + {$IFDEF VER140} WDoc.ConnectTo(WApp.Documents.Add(TmpVar, EmptyParam)); + {$ELSE} + WDoc.ConnectTo(WApp.Documents.Add(TmpVar, EmptyParam, EmptyParam, EmptyParam)); + {$ENDIF} ffTotal := WDoc.FormFields.Count; @@ -1307,5 +1332,5 @@ if tmp <> '' then AddField(tfDefault, tmp); - Fields.AddStrings(PendingAdd); + FastAddStrings(PendingAdd, Fields); PendingAdd.Clear; AddFieldHeader(tmpType, FALSE); @@ -1396,5 +1421,5 @@ begin Fields[0] := Fields[0] + IntToStr(Integer(FldCache.Objects[i])) + '">'; - Data.AddStrings(Fields); + FastAddStrings(Fields, Data); end; end; @@ -1486,4 +1511,6 @@ begin + SetTemplateDialogCanceled(FALSE); + SetTemplateBPHasObjects(FALSE); Template := GetLinkedTemplate(IntToStr(IEN), LType); if assigned(Template) then @@ -1878,4 +1905,5 @@ try TmpSL.Text := FullBoilerPlate; + if Pos('|', TmpSL.Text) > 0 then SetTemplateBPHasObjects(TRUE); finally if(IsDialog) then @@ -2550,5 +2578,5 @@ dmodShared.OnTemplateLock(Self) else - ShowMessage(Format(TemplateLockedText, [FPrintName])); + ShowMsg(Format(TemplateLockedText, [FPrintName])); end; end @@ -2875,8 +2903,45 @@ end; +// -------- CQ #8665 - RV ------------ +procedure UpdatePersonalObjects; +var + i: integer; +begin + if not assigned(uPersonalObjects) then + begin + uPersonalObjects := TStringList.Create; + GetAllowedPersonalObjects; + for i := 0 to RPCBrokerV.Results.Count-1 do + uPersonalObjects.Add(Piece(RPCBrokerV.Results[i],U,1)); + uPersonalObjects.Sorted := TRUE; + end; +end; +// -----end CQ #8665 ------------ + + +procedure SetTemplateDialogCanceled(value: Boolean); +begin + uTemplateDialogCanceled := value; +end; + +function WasTemplateDialogCanceled: Boolean; +begin + Result := uTemplateDialogCanceled; +end; + +procedure SetTemplateBPHasObjects(value: Boolean); +begin + uTemplateBPHasObjects := value; +end; + +function TemplateBPHasObjects: Boolean; +begin + Result := uTemplateBPHasObjects; +end; + initialization finalization ReleaseTemplates; - end. +