451 lines
13 KiB
Plaintext
451 lines
13 KiB
Plaintext
unit uAccessibleStringGrid;
|
|
|
|
interface
|
|
|
|
uses
|
|
ComObj, ActiveX, AxCtrls, Classes, CPRSChart_TLB, StdVcl, Accessibility_TLB,
|
|
ORCtrls, Variants;
|
|
|
|
type
|
|
TChildType = (ctInvalid, ctNoChild, ctChild);
|
|
|
|
TAccessibleStringGrid = class(TAutoObject, IAccessibleStringGrid, IAccessible)
|
|
private
|
|
FDefaultObject: IAccessible;
|
|
FDefaultObjectLoaded: boolean;
|
|
FControl: TCaptionStringGrid;
|
|
function GetDefaultObject: IAccessible;
|
|
protected {IAccessible}
|
|
function accHitTest(xLeft, yTop: Integer): OleVariant; safecall;
|
|
function accNavigate(navDir: Integer; varStart: OleVariant): OleVariant;
|
|
safecall;
|
|
function Get_accChild(varChild: OleVariant): IDispatch; safecall;
|
|
function Get_accChildCount: Integer; safecall;
|
|
function Get_accDefaultAction(varChild: OleVariant): WideString; safecall;
|
|
function Get_accDescription(varChild: OleVariant): WideString; safecall;
|
|
function Get_accFocus: OleVariant; safecall;
|
|
function Get_accHelp(varChild: OleVariant): WideString; safecall;
|
|
function Get_accHelpTopic(out pszHelpFile: WideString;
|
|
varChild: OleVariant): Integer; safecall;
|
|
function Get_accKeyboardShortcut(varChild: OleVariant): WideString;
|
|
safecall;
|
|
function Get_accName(varChild: OleVariant): WideString; safecall;
|
|
function Get_accParent: IDispatch; safecall;
|
|
function Get_accRole(varChild: OleVariant): OleVariant; safecall;
|
|
function Get_accSelection: OleVariant; safecall;
|
|
function Get_accState(varChild: OleVariant): OleVariant; safecall;
|
|
function Get_accValue(varChild: OleVariant): WideString; safecall;
|
|
procedure accDoDefaultAction(varChild: OleVariant); safecall;
|
|
procedure accLocation(out pxLeft, pyTop, pcxWidth, pcyHeight: Integer;
|
|
varChild: OleVariant); safecall;
|
|
procedure accSelect(flagsSelect: Integer; varChild: OleVariant); safecall;
|
|
procedure Set_accName(varChild: OleVariant; const pszName: WideString);
|
|
safecall;
|
|
procedure Set_accValue(varChild: OleVariant; const pszValue: WideString);
|
|
safecall;
|
|
protected
|
|
property DefaultObject: IAccessible read GetDefaultObject write FDefaultObject;
|
|
public
|
|
property Control: TCaptionStringGrid read FControl write FControl;
|
|
function ChildType( varChild: OleVariant): TChildType;
|
|
class procedure WrapControl( Control: TCaptionStringGrid);
|
|
class procedure UnwrapControl( Control: TCaptionStringGrid);
|
|
public {but it wouldn't be in a perfect world}
|
|
function SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult; override;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses uComServ, SysUtils, uAccessAPI, Windows, Controls;
|
|
|
|
var
|
|
UserIsRestricted: boolean = False;
|
|
|
|
function TAccessibleStringGrid.accHitTest(xLeft,
|
|
yTop: Integer): OleVariant;
|
|
var
|
|
ACol: integer;
|
|
ARow: integer;
|
|
P: TPoint;
|
|
begin
|
|
result := Null;
|
|
if Assigned(FControl) then
|
|
begin
|
|
P.X := xLeft;
|
|
P.Y := yTop;
|
|
P := FControl.ScreenToClient(P);
|
|
FControl.MouseToCell(P.X, P.Y, ACol, ARow);
|
|
if (ACol = -1) or (ARow = -1) then
|
|
result := NULL
|
|
else
|
|
result := FControl.ColRowToIndex( ACol, ARow);
|
|
end
|
|
else
|
|
result := CHILDID_SELF;
|
|
end;
|
|
|
|
function TAccessibleStringGrid.accNavigate(navDir: Integer;
|
|
varStart: OleVariant): OleVariant;
|
|
begin
|
|
result := Null;
|
|
if Assigned(FControl) then
|
|
begin
|
|
case ChildType(varStart) of
|
|
ctNoChild:
|
|
case navDir of
|
|
NAVDIR_FIRSTCHILD:
|
|
result := 1;
|
|
NAVDIR_LASTCHILD:
|
|
result := Get_AccChildCount;
|
|
NAVDIR_DOWN,
|
|
NAVDIR_LEFT,
|
|
NAVDIR_NEXT,
|
|
NAVDIR_PREVIOUS,
|
|
NAVDIR_RIGHT,
|
|
NAVDIR_UP:
|
|
result := varStart;
|
|
end;
|
|
ctChild:
|
|
case NavDir of
|
|
NAVDIR_FIRSTCHILD,
|
|
NAVDIR_LASTCHILD:
|
|
result := varStart;
|
|
NAVDIR_DOWN:
|
|
result := varStart + (FControl.ColCount - FControl.FixedCols);
|
|
NAVDIR_LEFT,
|
|
NAVDIR_NEXT:
|
|
result := varStart + 1;
|
|
NAVDIR_PREVIOUS,
|
|
NAVDIR_RIGHT:
|
|
result := varStart - 1;
|
|
NAVDIR_UP:
|
|
result := varStart - (FControl.ColCount - FControl.FixedCols);
|
|
end;
|
|
end;
|
|
//revert if index is invalid
|
|
if ChildType(result) = ctChild then
|
|
begin
|
|
if (result > Get_AccChildCount) or (result < 1) then
|
|
result := varStart;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TAccessibleStringGrid.Get_accChild(
|
|
varChild: OleVariant): IDispatch;
|
|
begin
|
|
result := nil;
|
|
OleError(S_FALSE);
|
|
end;
|
|
|
|
function TAccessibleStringGrid.Get_accChildCount: Integer;
|
|
begin
|
|
if Assigned(FControl) then
|
|
result := (FControl.RowCount - FControl.FixedRows) * (FControl.ColCount - FControl.FixedCols)
|
|
else
|
|
result := 0;
|
|
end;
|
|
|
|
function TAccessibleStringGrid.Get_accDefaultAction(
|
|
varChild: OleVariant): WideString;
|
|
begin
|
|
result := '';
|
|
if Assigned(DefaultObject) then
|
|
result := DefaultObject.Get_accDefaultAction(varChild);
|
|
end;
|
|
|
|
function TAccessibleStringGrid.Get_accDescription(
|
|
varChild: OleVariant): WideString;
|
|
begin
|
|
result := '';
|
|
if Assigned(DefaultObject) then
|
|
result := DefaultObject.Get_accDescription(varChild);
|
|
end;
|
|
|
|
function TAccessibleStringGrid.Get_accFocus: OleVariant;
|
|
begin
|
|
if Assigned(FControl) and FControl.Focused then
|
|
result := FControl.ColRowToIndex(FControl.Col, FControl.Row)
|
|
else
|
|
result := NULL;
|
|
end;
|
|
|
|
function TAccessibleStringGrid.Get_accHelp(
|
|
varChild: OleVariant): WideString;
|
|
begin
|
|
result := '';
|
|
if Assigned(DefaultObject) then
|
|
result := DefaultObject.Get_accHelp(varChild);
|
|
end;
|
|
|
|
function TAccessibleStringGrid.Get_accHelpTopic(
|
|
out pszHelpFile: WideString; varChild: OleVariant): Integer;
|
|
begin
|
|
result := 0;
|
|
if Assigned(DefaultObject) then
|
|
result := DefaultObject.Get_accHelpTopic(pszHelpFile, varChild);
|
|
end;
|
|
|
|
function TAccessibleStringGrid.Get_accKeyboardShortcut(
|
|
varChild: OleVariant): WideString;
|
|
begin
|
|
result := '';
|
|
if Assigned(DefaultObject) then
|
|
result := DefaultObject.Get_accKeyboardShortcut(varChild);
|
|
end;
|
|
|
|
function TAccessibleStringGrid.Get_accName(
|
|
varChild: OleVariant): WideString;
|
|
var
|
|
Row,Col: integer;
|
|
ColumnName: string;
|
|
RowName: string;
|
|
begin
|
|
case ChildType(varChild) of
|
|
ctNoChild:
|
|
result := FControl.Caption;
|
|
ctChild:
|
|
begin
|
|
if Assigned(FControl) then
|
|
begin
|
|
FControl.IndexToColRow(varChild,Col,Row);
|
|
if (FControl.FixedRows = 1) and (FControl.Cells[Col,0] <> '') then
|
|
ColumnName := FControl.Cells[Col,0]
|
|
else
|
|
ColumnName := IntToStr(Col-FControl.FixedCols+1);
|
|
if (FControl.FixedCols = 1) and ((FControl.Cells[0,Row] <> '')) then
|
|
RowName := FControl.Cells[0,Row]
|
|
else
|
|
RowName := IntToStr(Row-FControl.FixedRows+1) + ' of ' +
|
|
IntToStr(FControl.RowCount - FControl.FixedRows);
|
|
result := 'Column ' + ColumnName + ', Row ' + RowName;
|
|
end
|
|
else
|
|
result := 'Unknown Property';
|
|
end;
|
|
else
|
|
result := 'Unknown Property';
|
|
end;
|
|
end;
|
|
|
|
function TAccessibleStringGrid.Get_accParent: IDispatch;
|
|
begin
|
|
result := nil;
|
|
if Assigned(DefaultObject) then
|
|
result := DefaultObject.Get_accParent;
|
|
end;
|
|
|
|
function TAccessibleStringGrid.Get_accRole(
|
|
varChild: OleVariant): OleVariant;
|
|
begin
|
|
case ChildType(varChild) of
|
|
ctNoChild:
|
|
result := ROLE_SYSTEM_LIST;
|
|
ctChild:
|
|
result := ROLE_SYSTEM_LISTITEM;
|
|
else
|
|
result := ROLE_SYSTEM_CLIENT;
|
|
end;
|
|
end;
|
|
|
|
function TAccessibleStringGrid.Get_accSelection: OleVariant;
|
|
begin
|
|
//We are assuming single-selection for this control
|
|
if Assigned(FControl) then
|
|
result := FControl.ColRowToIndex(FControl.Col, FControl.Row)
|
|
else
|
|
result := NULL;
|
|
end;
|
|
|
|
function TAccessibleStringGrid.Get_accState(
|
|
varChild: OleVariant): OleVariant;
|
|
begin
|
|
if Assigned(FControl) then
|
|
begin
|
|
result := STATE_SYSTEM_FOCUSABLE or STATE_SYSTEM_READONLY or STATE_SYSTEM_SELECTABLE;
|
|
case ChildType(varChild) of
|
|
ctNoChild:
|
|
if FControl.Focused then
|
|
result := result or STATE_SYSTEM_FOCUSED;
|
|
ctChild:
|
|
begin
|
|
if FControl.ColRowToIndex(FControl.Col, FControl.Row) = varChild then
|
|
begin
|
|
result := result or STATE_SYSTEM_SELECTED;
|
|
if FControl.Focused then
|
|
result := result or STATE_SYSTEM_FOCUSED;
|
|
end;
|
|
end;
|
|
end;
|
|
if ([csCreating,csDestroyingHandle] * FControl.ControlState <> []) or
|
|
([csDestroying,csFreeNotification,csLoading,csWriting] * FControl.ComponentState <> []) then
|
|
result := result or STATE_SYSTEM_UNAVAILABLE;
|
|
end
|
|
else
|
|
result := STATE_SYSTEM_UNAVAILABLE;
|
|
end;
|
|
|
|
function TAccessibleStringGrid.Get_accValue(
|
|
varChild: OleVariant): WideString;
|
|
var
|
|
Row,Col: integer;
|
|
begin
|
|
case ChildType(varChild) of
|
|
ctNoChild:
|
|
result := '';
|
|
ctChild:
|
|
begin
|
|
if Assigned(FControl) then
|
|
begin
|
|
FControl.IndexToColRow(varChild,Col,Row);
|
|
result := FControl.Cells[Col,Row];
|
|
if FControl.JustToTab then
|
|
result := Copy(result, 1, pos(#9{Tab},Result) -1);
|
|
end
|
|
else
|
|
result := 'Unknown Property';
|
|
end;
|
|
else
|
|
result := 'Unknown Property';
|
|
end;
|
|
end;
|
|
|
|
procedure TAccessibleStringGrid.accDoDefaultAction(varChild: OleVariant);
|
|
begin
|
|
if Assigned(DefaultObject) then
|
|
DefaultObject.accDoDefaultAction(varChild);
|
|
end;
|
|
|
|
procedure TAccessibleStringGrid.accLocation(out pxLeft, pyTop, pcxWidth,
|
|
pcyHeight: Integer; varChild: OleVariant);
|
|
var
|
|
P: TPoint;
|
|
R: TRect;
|
|
begin
|
|
if Assigned(FControl) then
|
|
begin
|
|
case ChildType(varChild) of
|
|
ctNoChild:
|
|
begin
|
|
P.X := 0;
|
|
P.Y := 0;
|
|
with FControl.ClientToScreen(P) do begin
|
|
pxLeft := X;
|
|
pyTop := Y;
|
|
end;
|
|
pcxWidth := FControl.Width;
|
|
pcyHeight := FControl.Height;
|
|
end;
|
|
ctChild:
|
|
begin
|
|
R := FControl.CellRect(FControl.Col,FControl.Row);
|
|
with FControl.ClientToScreen(R.TopLeft) do begin
|
|
pxLeft := X;
|
|
pyTop := Y;
|
|
end;
|
|
pcxWidth := R.Right - R.Left;
|
|
pcyHeight := R.Bottom - R.Top;
|
|
end;
|
|
else
|
|
begin
|
|
pxLeft := 0;
|
|
pyTop := 0;
|
|
pcxWidth := 0;
|
|
pcyHeight := 0;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TAccessibleStringGrid.accSelect(flagsSelect: Integer;
|
|
varChild: OleVariant);
|
|
begin
|
|
if Assigned(DefaultObject) then
|
|
DefaultObject.accSelect(flagsSelect, varChild);
|
|
end;
|
|
|
|
procedure TAccessibleStringGrid.Set_accName(varChild: OleVariant;
|
|
const pszName: WideString);
|
|
begin
|
|
if Assigned(DefaultObject) then
|
|
DefaultObject.Set_accName(varChild, pszName);
|
|
end;
|
|
|
|
procedure TAccessibleStringGrid.Set_accValue(varChild: OleVariant;
|
|
const pszValue: WideString);
|
|
var
|
|
Row,Col: integer;
|
|
begin
|
|
case ChildType(varChild) of
|
|
ctChild:
|
|
begin
|
|
if Assigned(FControl) then
|
|
begin
|
|
FControl.IndexToColRow(varChild,Col,Row);
|
|
FControl.Cells[Col,Row] := pszValue;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TAccessibleStringGrid.ChildType(varChild: OleVariant): TChildType;
|
|
begin
|
|
if VarType(varChild) <> varInteger then
|
|
result := ctInvalid
|
|
else if varChild = CHILDID_SELF then
|
|
result := ctNoChild
|
|
else
|
|
result := ctChild;
|
|
end;
|
|
|
|
function TAccessibleStringGrid.GetDefaultObject: IAccessible;
|
|
begin
|
|
if Assigned(FControl) and not FDefaultObjectLoaded then begin
|
|
FDefaultObject := uAccessAPI.GetDefaultObject(FControl);
|
|
FDefaultObjectLoaded := True;
|
|
end;
|
|
Result := FDefaultObject;
|
|
end;
|
|
|
|
function TAccessibleStringGrid.SafeCallException(ExceptObject: TObject;
|
|
ExceptAddr: Pointer): HResult;
|
|
begin
|
|
if (ExceptObject is EOleSysError) then
|
|
result := EOleSysError(ExceptObject).ErrorCode
|
|
else
|
|
result := inherited SafeCallException(ExceptObject, ExceptAddr);
|
|
end;
|
|
|
|
class procedure TAccessibleStringGrid.UnwrapControl(
|
|
Control: TCaptionStringGrid);
|
|
begin
|
|
if not UserIsRestricted then
|
|
Control.MakeAccessible(nil);
|
|
end;
|
|
|
|
class procedure TAccessibleStringGrid.WrapControl(
|
|
Control: TCaptionStringGrid);
|
|
var
|
|
AccessibleStringGrid: TAccessibleStringGrid;
|
|
{Using Accessible here is probably just interface reference count paranoia}
|
|
Accessible: IAccessible;
|
|
begin
|
|
if not UserIsRestricted then
|
|
begin
|
|
AccessibleStringGrid := TAccessibleStringGrid.Create;
|
|
Accessible := AccessibleStringGrid;
|
|
AccessibleStringGrid.Control := Control;
|
|
Control.MakeAccessible(Accessible);
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
try
|
|
TAutoObjectFactory.Create(ComServer, TAccessibleStringGrid, Class_AccessibleStringGrid,
|
|
ciMultiInstance, tmApartment);
|
|
except
|
|
{Let the poor restricted users pass!}
|
|
UserIsRestricted := True;
|
|
end;
|
|
end.
|