VistA-cprs/VA/VA508Accessibility/VA508DelphiCompatibility.pas

603 lines
15 KiB
Plaintext

unit VA508DelphiCompatibility;
interface
uses
SysUtils, Classes, Controls, Windows, StdCtrls, CheckLst, ExtCtrls, Forms,
ValEdit, DBGrids, Calendar, ComCtrls, VA508AccessibilityManager;
function GetCheckBoxComponentName(AllowGrayed: boolean): string;
function GetCheckBoxInstructionMessage(Checked: boolean): string;
function GetCheckBoxStateText(State: TCheckBoxState): String;
procedure ListViewIndexQueryProc(Sender: TObject; ItemIndex: integer; var Text: string);
type
TVA508StaticTextManager = class(TVA508ManagedComponentClass)
public
constructor Create; override;
function GetComponentName(Component: TWinControl): string; override;
function GetCaption(Component: TWinControl): string; override;
function GetValue(Component: TWinControl): string; override;
end;
implementation
uses Grids, VA508AccessibilityRouter, VA508AccessibilityConst, VA508MSAASupport,
VAUtils;
type
TCheckBox508Manager = class(TVA508ManagedComponentClass)
public
constructor Create; override;
function GetComponentName(Component: TWinControl): string; override;
function GetInstructions(Component: TWinControl): string; override;
function GetState(Component: TWinControl): string; override;
end;
TCheckListBox508Manager = class(TVA508ManagedComponentClass)
private
function GetIndex(Component: TWinControl): integer;
public
constructor Create; override;
function GetComponentName(Component: TWinControl): string; override;
function GetState(Component: TWinControl): string; override;
function GetItem(Component: TWinControl): TObject; override;
function GetItemInstructions(Component: TWinControl): string; override;
end;
TVA508EditManager = class(TVA508ManagedComponentClass)
public
constructor Create; override;
function GetValue(Component: TWinControl): string; override;
end;
TVA508ComboManager = class(TVA508ManagedComponentClass)
public
constructor Create; override;
function GetValue(Component: TWinControl): string; override;
end;
TCustomGrid508Manager = class(TVA508ManagedComponentClass)
private
public
constructor Create; override;
function GetComponentName(Component: TWinControl): string; override;
function GetInstructions(Component: TWinControl): string; override;
function GetValue(Component: TWinControl): string; override;
function GetItem(Component: TWinControl): TObject; override;
// function GetData(Component: TWinControl; Value: string): string; override;
end;
TVA508RegistrationScreenReader = class(TVA508ScreenReader);
function CustomComboAlternateHandle(Component: TWinControl): HWnd; forward;
procedure ListViewIndexQueryProc(Sender: TObject; ItemIndex: integer; var Text: string);
var
temp: string;
view: TListView;
item: TListItem;
i: integer;
include: boolean;
procedure Append(txt: string);
begin
if txt = '' then exit;
if text <> '' then
text := text + ' ';
text := text + txt + ',';
end;
procedure AppendHeader(txt: string);
begin
if txt = '' then
txt := 'blank header';
Append(txt);
end;
begin
view := TListView(Sender);
Text := '';
include := TRUE;
if (ItemIndex < 0) or (ItemIndex >= view.Items.Count) then exit;
item := view.Items.Item[ItemIndex];
if (view.ViewStyle = vsReport) and (view.Columns.Count > 0) then
begin
if view.Columns[0].Width < 1 then
include := FALSE
else
AppendHeader(view.Columns[0].Caption);
end;
if include then
begin
temp := item.Caption;
if temp = '' then
temp := 'blank';
Append(temp);
end;
if view.ViewStyle = vsReport then
begin
for i := 1 to view.Columns.Count - 1 do
begin
if view.Columns[i].Width > 0 then
begin
AppendHeader(view.Columns[i].Caption);
if (i-1) < item.SubItems.Count then
temp := item.SubItems[i-1]
else
temp := '';
if temp = '' then
temp := 'blank';
Append(temp);
end;
end;
end;
end;
procedure RegisterStandardDelphiComponents;
begin
RegisterAlternateHandleComponent(TCustomCombo, CustomComboAlternateHandle);
RegisterManagedComponentClass(TCheckBox508Manager.Create);
RegisterManagedComponentClass(TCheckListBox508Manager.Create);
RegisterManagedComponentClass(TCustomGrid508Manager.Create);
RegisterManagedComponentClass(TVA508StaticTextManager.Create);
RegisterManagedComponentClass(TVA508EditManager.Create);
RegisterManagedComponentClass(TVA508ComboManager.Create);
with TVA508RegistrationScreenReader(GetScreenReader) do
begin
// even though TListView is in Default.JCF, we add it here to clear out previous MSAA setting
RegisterCustomClassBehavior(TListView.ClassName, CLASS_BEHAVIOR_LIST_VIEW);
RegisterCustomClassBehavior(TVA508StaticText.ClassName, CLASS_BEHAVIOR_STATIC_TEXT);
end;
RegisterMSAAQueryListClassProc(TListView, ListViewIndexQueryProc);
{ TODO -oJeremy Merrill -c508 :
Add these components as ones that need an alternate handle
TColorBox
TValueListEditor ?? - may be fixed because it's a TStringGrid
TCaptionStringGrid
TToolBar (not needed when the tool bar doesn't have focus)
TPageScroller
add stuff for image processing
descendents of TCustomTabControl
}
{ TODO -oJeremy Merrill -c508 :Need to create a fix for the list box stuff here}
end;
{ TCustomCombo Alternate Handle }
type
TExposedCustomCombo = class(TCustomCombo)
public
property EditHandle;
end;
function CustomComboAlternateHandle(Component: TWinControl): HWnd;
begin
Result := TExposedCustomCombo(Component).EditHandle;
end;
{ Check Box Utils - used by multiple classes }
function GetCheckBoxComponentName(AllowGrayed: boolean): string;
begin
if AllowGrayed then
Result := 'Three State Check Box'
else
Result := 'Check Box';
end;
function GetCheckBoxInstructionMessage(Checked: boolean): string;
begin
if not Checked then // handles clear and gray entries
Result := 'to check press space bar'
else
Result := 'to clear check mark press space bar';
end;
function GetCheckBoxStateText(State: TCheckBoxState): String;
begin
case State of
cbUnchecked: Result := 'not checked';
cbChecked: Result := 'checked';
cbGrayed: Result := 'Partially Checked';
else Result := '';
end;
end;
{ TCheckBox508Manager }
constructor TCheckBox508Manager.Create;
begin
inherited Create(TCheckBox, [mtComponentName, mtInstructions, mtState, mtStateChange]);
end;
function TCheckBox508Manager.GetComponentName(Component: TWinControl): string;
begin
Result := GetCheckBoxComponentName(TCheckBox(Component).AllowGrayed);
end;
function TCheckBox508Manager.GetInstructions(Component: TWinControl): string;
begin
Result := GetCheckBoxInstructionMessage(TCheckBox(Component).Checked);
end;
function TCheckBox508Manager.GetState(Component: TWinControl): string;
begin
Result := GetCheckBoxStateText(TCheckBox(Component).State);
end;
{ TCheckListBox508Manager }
constructor TCheckListBox508Manager.Create;
begin
inherited Create(TCheckListBox, [mtComponentName, mtState, mtStateChange, mtItemChange, mtItemInstructions]);
end;
function TCheckListBox508Manager.GetComponentName(
Component: TWinControl): string;
var
lb : TCheckListBox;
begin
lb := TCheckListBox(Component);
if lb.AllowGrayed then
Result := 'Three State Check List Box'
else
Result := 'Check List Box';
end;
function TCheckListBox508Manager.GetItemInstructions(
Component: TWinControl): string;
var
lb : TCheckListBox;
idx: integer;
begin
lb := TCheckListBox(Component);
idx := GetIndex(Component);
if (idx < 0) then
Result := ''
else
Result := GetCheckBoxInstructionMessage(lb.Checked[idx]);
end;
function TCheckListBox508Manager.GetIndex(Component: TWinControl): integer;
var
lb : TCheckListBox;
begin
lb := TCheckListBox(Component);
if (lb.ItemIndex < 0) then
begin
if lb.Count > 0 then
Result := 0
else
Result := -1
end
else
Result := lb.ItemIndex;
end;
function TCheckListBox508Manager.GetItem(Component: TWinControl): TObject;
var
lb : TCheckListBox;
begin
lb := TCheckListBox(Component);
Result := TObject((lb.items.Count * 10000) + (lb.ItemIndex + 2));
end;
function TCheckListBox508Manager.GetState(Component: TWinControl): string;
var
lb : TCheckListBox;
idx: integer;
begin
lb := TCheckListBox(Component);
idx := GetIndex(Component);
if idx < 0 then
Result := ''
else
Result := GetCheckBoxStateText(lb.State[idx]);
end;
{ TCustomForm508Manager }
type
TAccessGrid = class(TCustomGrid);
constructor TCustomGrid508Manager.Create;
begin
{ TODO : Add support for other string grid features - like state changes for editing or selecting cells }
// inherited Create(TStringGrid, TRUE, TRUE, TRUE, FALSE, FALSE, TRUE);
inherited Create(TCustomGrid, [mtComponentName, mtInstructions, mtValue, mtItemChange], TRUE);
// FLastX := -1;
// FLastY := -1;
end;
// Data pieces
// 1 = Column header, if any
// 2 = Column #
// 3 = number of columns
// 4 = Row header, if any
// 5 = Row #
// 6 = number of rows
// 7 = Cell #
// 8 = total # of cells
// 9 = cell contents
const
DELIM = '^';
function TCustomGrid508Manager.GetComponentName(Component: TWinControl): string;
begin
Result := ' grid ';
// don't use 'grid' - we're abandoning the special code in the JAWS scripts for
// grids - it's too messy, and based on the 'grid' component name
end;
{
function TCustomGrid508Manager.GetData(Component: TWinControl; Value: string): string;
var
grid: TAccessGrid;
row, col: integer;
cnt, x, y, max, mult: integer;
txt: string;
procedure Add(txt: integer); overload;
begin
Result := Result + inttostr(txt) + DELIM;
end;
procedure Add(txt: string); overload;
begin
Result := Result + Piece(txt,DELIM,1) + DELIM;
end;
begin
grid := TAccessGrid(Component);
row := grid.Row;
col := grid.Col;
if (row >= 0) and (col >= 0) then
begin
if grid.FixedRows > 0 then
Add(grid.GetEditText(col, 0))
else
Add('');
Add(col - grid.FixedCols + 1);
Add(grid.ColCount - grid.FixedCols);
if grid.FixedCols > 0 then
Add(grid.GetEditText(0, row))
else
Add('');
Add(row - grid.FixedRows + 1);
Add(grid.RowCount - grid.FixedRows);
x := grid.ColCount - grid.FixedCols;
y := grid.RowCount - grid.FixedRows;
max := x * y;
x := grid.Col - grid.FixedCols;
y := grid.Row - grid.FixedRows;
mult := grid.ColCount - grid.FixedCols;
if (mult > 0) and
(x >= 0) and (x < grid.ColCount) and
(y >= 0) and (y < grid.RowCount) then
begin
cnt := (y * mult) + x + 1;
Add(cnt);
end
else
Add(0);
Add(max);
if Value = '' then
txt := grid.GetEditText(col, row)
else
txt := Value;
Add(txt);
delete(Result,length(Result),1); // remove trailing delimeter
end
else
Result := '';
end; }
function TCustomGrid508Manager.GetInstructions(Component: TWinControl): string;
var
grid: TAccessGrid;
// cnt, x, y, max, mult: integer;
begin
Result := '';
grid := TAccessGrid(Component);
// x := grid.ColCount - grid.FixedCols;
// y := grid.RowCount - grid.FixedRows;
// max := x * y;
// x := grid.Col - grid.FixedCols;
// y := grid.Row - grid.FixedRows;
// mult := grid.ColCount - grid.FixedCols;
//
// if (mult > 0) and
// (x >= 0) and (x < grid.ColCount) and
// (y >= 0) and (y < grid.RowCount) then
// begin
// cnt := (y * mult) + x + 1;
// Result := IntToStr(cnt) + ' of ' + inttostr(max) + ', ';
// end;
Result := Result + 'To move to items use the arrow ';
if goTabs in grid.Options then
Result := Result + ' or tab ';
Result := Result + 'keys';
end;
// if
// key
//end;
(*
listbox
column 120 row 430
unavailable (text of cell?) read only
20 or 81
listbox
column 3 of 10
row 6 of 10
unavailable (text of cell?) read only
20 or 81
with each navigation:
column 3 of 10
row 6 of 10
unavailable (text of cell?) read only
*)
function TCustomGrid508Manager.GetItem(Component: TWinControl): TObject;
var
grid: TAccessGrid;
row, col, maxRow: integer;
begin
grid := TAccessGrid(Component);
row := grid.Row + 2;
col := grid.Col + 2;
MaxRow := grid.RowCount + 3;
if MaxRow < 1000 then
MaxRow := 1000;
Result := TObject((row * maxRow) + col);
end;
//function TCustomGrid508Manager.GetValue(Component: TWinControl): string;
//var
// grid: TAccessGrid;
//begin
// grid := TAccessGrid(Component);
// Result := Piece(grid.GetEditText(grid.Col, grid.Row), DELIM, 1);
//end;
function TCustomGrid508Manager.GetValue(Component: TWinControl): string;
var
grid: TAccessGrid;
row, col: integer;
colHdr, rowHdr, txt: string;
begin
grid := TAccessGrid(Component);
row := grid.Row;
col := grid.Col;
if (row >= 0) and (col >= 0) then
begin
// if col <> FLastX then
// begin
if grid.FixedRows > 0 then
colHdr := Piece(grid.GetEditText(col, 0), DELIM, 1)
else
colHdr := '';
if colHdr = '' then
colHdr := inttostr(col+1-grid.FixedCols) + ' of ' + inttostr(grid.ColCount-grid.FixedCols);
colHdr := 'column ' + colhdr + ', ';
// end
// else
// colHdr := '';
// FLastX := col;
// if row <> FLastY then
// begin
if grid.FixedCols > 0 then
rowHdr := Piece(grid.GetEditText(0, row), DELIM, 1)
else
rowHdr := '';
if rowHdr = '' then
rowHdr := inttostr(row+1-grid.FixedRows) + ' of ' + inttostr(grid.RowCount-grid.FixedRows);
rowHdr := 'row ' + rowhdr + ', ';
// end
// else
// rowHdr := '';
// FLastY := row;
txt := Piece(grid.GetEditText(col, row), DELIM, 1);
if txt = '' then
txt := 'blank';
Result := colHdr + rowHdr + txt;
end
else
Result := ' ';
end;
{ TVA508StaticTextManager }
constructor TVA508StaticTextManager.Create;
begin
inherited Create(TVA508StaticText, [mtComponentName, mtCaption, mtValue], TRUE);
end;
function TVA508StaticTextManager.GetCaption(Component: TWinControl): string;
begin
Result := ' ';
end;
function TVA508StaticTextManager.GetComponentName(
Component: TWinControl): string;
begin
Result := 'label';
end;
function TVA508StaticTextManager.GetValue(Component: TWinControl): string;
var
next: TVA508ChainedLabel;
comp: TVA508StaticText;
begin
comp := TVA508StaticText(Component);
Result := comp.Caption;
next := comp.NextLabel;
while assigned(next) do
begin
Result := Result + ' ' + next.Caption;
next := next.NextLabel;
end;
end;
{ TVA508EditManager }
constructor TVA508EditManager.Create;
begin
inherited Create(TEdit, [mtValue], TRUE);
end;
function TVA508EditManager.GetValue(Component: TWinControl): string;
begin
Result := TEdit(Component).Text;
end;
{ TVA508ComboManager }
constructor TVA508ComboManager.Create;
begin
inherited Create(TComboBox, [mtValue], TRUE);
end;
function TVA508ComboManager.GetValue(Component: TWinControl): string;
begin
Result := TComboBox(Component).Text;
end;
initialization
RegisterStandardDelphiComponents;
end.