You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
787 lines
31 KiB
Plaintext
787 lines
31 KiB
Plaintext
unit VTAccessibility;
|
|
|
|
// This unit implements iAccessible interfaces for the VirtualTree visual components
|
|
// and the currently focused node.
|
|
//
|
|
// Written by Marco Zehe. (c) 2007
|
|
|
|
interface
|
|
|
|
uses
|
|
Winapi.Windows, System.Classes, Winapi.ActiveX, System.Types, Winapi.oleacc,
|
|
VirtualTrees, VTAccessibilityFactory, Vcl.Controls;
|
|
|
|
type
|
|
TVirtualTreeAccessibility = class(TInterfacedObject, IDispatch, IAccessible)
|
|
private
|
|
FVirtualTree: TVirtualStringTree;
|
|
public
|
|
constructor Create(AVirtualTree: TVirtualStringTree);
|
|
|
|
{ IAccessibility }
|
|
function Get_accParent(out ppdispParent: IDispatch): HResult; stdcall;
|
|
function Get_accChildCount(out pcountChildren: Integer): HResult; stdcall;
|
|
function Get_accChild(varChild: OleVariant; out ppdispChild: IDispatch): HResult; stdcall;
|
|
function Get_accName(varChild: OleVariant; out pszName: WideString): HResult; stdcall;
|
|
function Get_accValue(varChild: OleVariant; out pszValue: WideString): HResult; stdcall;
|
|
function Get_accDescription(varChild: OleVariant; out pszDescription: WideString): HResult; stdcall;
|
|
function Get_accRole(varChild: OleVariant; out pvarRole: OleVariant): HResult; stdcall;
|
|
function Get_accState(varChild: OleVariant; out pvarState: OleVariant): HResult; stdcall;
|
|
function Get_accHelp(varChild: OleVariant; out pszHelp: WideString): HResult; stdcall;
|
|
function Get_accHelpTopic(out pszHelpFile: WideString; varChild: OleVariant;
|
|
out pidTopic: Integer): HResult; stdcall;
|
|
function Get_accKeyboardShortcut(varChild: OleVariant; out pszKeyboardShortcut: WideString): HResult; stdcall;
|
|
function Get_accFocus(out pvarChild: OleVariant): HResult; stdcall;
|
|
function Get_accSelection(out pvarChildren: OleVariant): HResult; stdcall;
|
|
function Get_accDefaultAction(varChild: OleVariant; out pszDefaultAction: WideString): HResult; stdcall;
|
|
function accSelect(flagsSelect: Integer; varChild: OleVariant): HResult; stdcall;
|
|
function accLocation(out pxLeft: Integer; out pyTop: Integer; out pcxWidth: Integer;
|
|
out pcyHeight: Integer; varChild: OleVariant): HResult; stdcall;
|
|
function accNavigate(navDir: Integer; varStart: OleVariant; out pvarEndUpAt: OleVariant): HResult; stdcall;
|
|
function accHitTest(xLeft: Integer; yTop: Integer; out pvarChild: OleVariant): HResult; stdcall;
|
|
function accDoDefaultAction(varChild: OleVariant): HResult; stdcall;
|
|
function Set_accName(varChild: OleVariant; const pszName: WideString): HResult; stdcall;
|
|
function Set_accValue(varChild: OleVariant; const pszValue: WideString): HResult; stdcall;
|
|
{IDispatch}
|
|
function GetIDsOfNames(const IID: TGUID; Names: Pointer;
|
|
NameCount: Integer; LocaleID: Integer; DispIDs: Pointer): HRESULT; stdcall;
|
|
function GetTypeInfo(Index: Integer; LocaleID: Integer;
|
|
out TypeInfo): HRESULT; stdcall;
|
|
function GetTypeInfoCount(out Count: Integer): HRESULT; stdcall;
|
|
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
|
|
Flags: Word; var Params; VarResult: Pointer; ExcepInfo: Pointer;
|
|
ArgErr: Pointer): HRESULT; stdcall;
|
|
end;
|
|
|
|
TVirtualTreeItemAccessibility = class(TVirtualTreeAccessibility, IAccessible)
|
|
public
|
|
{ IAccessibility }
|
|
function Get_accParent(out ppdispParent: IDispatch): HResult; stdcall;
|
|
function Get_accChildCount(out pcountChildren: Integer): HResult; stdcall;
|
|
function Get_accChild(varChild: OleVariant; out ppdispChild: IDispatch): HResult; stdcall;
|
|
function Get_accName(varChild: OleVariant; out pszName: WideString): HResult; stdcall;
|
|
function Get_accValue(varChild: OleVariant; out pszValue: WideString): HResult; stdcall;
|
|
function Get_accDescription(varChild: OleVariant; out pszDescription: WideString): HResult; stdcall;
|
|
function Get_accRole(varChild: OleVariant; out pvarRole: OleVariant): HResult; stdcall;
|
|
function Get_accState(varChild: OleVariant; out pvarState: OleVariant): HResult; stdcall;
|
|
function accLocation(out pxLeft: Integer;
|
|
out pyTop: Integer; out pcxWidth: Integer;
|
|
out pcyHeight: Integer; varChild: OleVariant): HResult; stdcall;
|
|
function Get_accFocus(out pvarChild: OleVariant): HRESULT; stdcall;
|
|
end;
|
|
|
|
TVTMultiColumnItemAccessibility = class(TVirtualTreeItemAccessibility, IAccessible)
|
|
strict private
|
|
function GetItemDescription(varChild: OleVariant; out pszDescription: WideString; IncludeMainColumn: boolean): HResult; stdcall;
|
|
public
|
|
{ IAccessibility }
|
|
function Get_accName(varChild: OleVariant; out pszName: WideString): HResult; stdcall;
|
|
function Get_accDescription(varChild: OleVariant; out pszDescription: WideString): HResult; stdcall;
|
|
end;
|
|
|
|
TVTDefaultAccessibleProvider = class(TInterfacedObject, IVTAccessibleProvider)
|
|
public
|
|
function CreateIAccessible(ATree: TBaseVirtualTree): IAccessible;
|
|
end;
|
|
|
|
TVTDefaultAccessibleItemProvider = class(TInterfacedObject, IVTAccessibleProvider)
|
|
public
|
|
function CreateIAccessible(ATree: TBaseVirtualTree): IAccessible;
|
|
end;
|
|
|
|
TVTMultiColumnAccessibleItemProvider = class(TInterfacedObject, IVTAccessibleProvider)
|
|
public
|
|
function CreateIAccessible(ATree: TBaseVirtualTree): IAccessible;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
System.SysUtils, Vcl.Forms, System.Variants, System.Math;
|
|
|
|
{ TVirtualTreeAccessibility }
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
constructor TVirtualTreeAccessibility.Create(AVirtualTree: TVirtualStringTree);
|
|
// assigns the parent and current fields, and lets the control's IAccessible object know its address.
|
|
begin
|
|
inherited Create;
|
|
FVirtualTree := AVirtualTree;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TVirtualTreeAccessibility.accDoDefaultAction(varChild: OleVariant): HResult;
|
|
// a default action is not supported.
|
|
begin
|
|
Result := DISP_E_MEMBERNOTFOUND;
|
|
end;
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TVirtualTreeAccessibility.accHitTest(xLeft: Integer; yTop: Integer; out pvarChild: OleVariant): HResult;
|
|
// returns the iAccessible object at the given point, if applicable.
|
|
var
|
|
Pt: TPoint;
|
|
HitInfo: THitInfo;
|
|
begin
|
|
Result := S_FALSE;
|
|
if FVirtualTree <> nil then
|
|
begin
|
|
// VariantInit(pvarChild);
|
|
// TVarData(pvarChild).VType := VT_I4;
|
|
Pt := fVirtualTree.ScreenToClient(Point(xLeft, yTop));
|
|
if fVirtualTree.FocusedNode <> nil then
|
|
begin
|
|
fVirtualTree.GetHitTestInfoAt(xLeft, yTop, false, HitInfo);
|
|
if FVirtualTree.FocusedNode = HitInfo.HitNode then
|
|
begin
|
|
pvarChild := FVirtualTree.AccessibleItem;
|
|
Result := S_OK;
|
|
exit;
|
|
end;
|
|
end;
|
|
if PtInRect(FVirtualTree.BoundsRect, Pt) then
|
|
begin
|
|
pvarChild := CHILDID_SELF;
|
|
Result := S_OK;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeAccessibility.accLocation(out pxLeft: Integer;
|
|
out pyTop: Integer; out pcxWidth: Integer;
|
|
out pcyHeight: Integer; varChild: OleVariant): HResult;
|
|
// returns the location of the VirtualStringTree object.
|
|
var
|
|
P: TPoint;
|
|
begin
|
|
Result := S_FALSE;
|
|
if varChild = CHILDID_SELF then
|
|
begin
|
|
if FVirtualTree <> nil then
|
|
begin
|
|
P := FVirtualTree.ClientToScreen(FVirtualTree.ClientRect.TopLeft);
|
|
pxLeft := P.X;
|
|
pyTop := P.Y;
|
|
pcxWidth := FVirtualTree.Width;
|
|
pcyHeight := FVirtualTree.Height;
|
|
Result := S_OK;
|
|
end;
|
|
end
|
|
else if VarType(varchild) = VT_I4 then
|
|
begin
|
|
// return the location of the focused node
|
|
if (FVirtualTree <> nil) and (FVirtualTree.AccessibleItem <> nil) then
|
|
begin
|
|
Result := FVirtualTree.AccessibleItem.accLocation(pxLeft, pyTop, pcxWidth, pcyHeight, CHILDID_SELF);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeAccessibility.accNavigate(navDir: Integer; varStart: OleVariant;
|
|
out pvarEndUpAt: OleVariant): HResult;
|
|
// This is not supported.
|
|
begin
|
|
Result := DISP_E_MEMBERNOTFOUND;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeAccessibility.Get_accSelection(out pvarChildren: OleVariant): HResult;
|
|
// returns the selected child ID, if any.
|
|
begin
|
|
Result := s_false;
|
|
if FVirtualTree <> nil then
|
|
if fVirtualTree.FocusedNode <> nil then
|
|
begin
|
|
pvarChildren := 1;
|
|
result := s_OK;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeAccessibility.GetIDsOfNames(const IID: TGUID;
|
|
Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT;
|
|
// Not supported.
|
|
begin
|
|
Result := E_NOTIMPL;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeAccessibility.GetTypeInfo(Index, LocaleID: Integer;
|
|
out TypeInfo): HRESULT;
|
|
// not supported.
|
|
begin
|
|
Result := E_NOTIMPL;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeAccessibility.GetTypeInfoCount(
|
|
out Count: Integer): HRESULT;
|
|
// not supported.
|
|
begin
|
|
Result := E_NOTIMPL;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeAccessibility.Get_accChild(varChild: OleVariant; out ppdispChild: IDispatch): HResult;
|
|
// returns the iAccessible child, whicfh represents the focused item.
|
|
begin
|
|
if varChild = CHILDID_SELF then
|
|
begin
|
|
ppdispChild := FVirtualTree.AccessibleItem;
|
|
Result := S_OK;
|
|
end
|
|
else
|
|
Result := E_INVALIDARG
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeAccessibility.Get_accChildCount(out pcountChildren: Integer): HResult;
|
|
// Returns the number 1 for the one child: The focused item.
|
|
begin
|
|
pcountChildren := 1;
|
|
Result := S_OK;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeAccessibility.Get_accDefaultAction(varChild: OleVariant; out pszDefaultAction: WideString): HResult;
|
|
// Not supported.
|
|
begin
|
|
Result := DISP_E_MEMBERNOTFOUND;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeAccessibility.Get_accDescription(varChild: OleVariant; out pszDescription: WideString): HResult;
|
|
// returns the hint of the control, if assigned.
|
|
begin
|
|
pszDescription := '';
|
|
Result := S_FALSE;
|
|
if varChild = CHILDID_SELF then
|
|
begin
|
|
if FVirtualTree <> nil then
|
|
pszDescription := GetLongHint(fVirtualTree.Hint);
|
|
end;
|
|
if Length(pszDescription) > 0 then
|
|
Result := S_OK;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeAccessibility.Get_accFocus(out pvarChild: OleVariant): HResult;
|
|
// returns the child ID of 1, if assigned.
|
|
begin
|
|
Result := s_false;
|
|
if fVirtualTree <> nil then
|
|
begin
|
|
if FVirtualTree.FocusedNode <> nil then
|
|
pvarChild := FVirtualTree.AccessibleItem
|
|
else
|
|
pvarChild := childid_self;
|
|
result := S_OK;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeAccessibility.Get_accHelp(varChild: OleVariant; out pszHelp: WideString): HResult;
|
|
// Not supported.
|
|
begin
|
|
Result := DISP_E_MEMBERNOTFOUND;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeAccessibility.Get_accHelpTopic(out pszHelpFile: WideString; varChild: OleVariant;
|
|
out pidTopic: Integer): HResult;
|
|
// Returns the HelpContext ID, if present.
|
|
begin
|
|
pszHelpFile := '';
|
|
pidTopic := 0;
|
|
Result := S_OK;
|
|
if varChild = CHILDID_SELF then
|
|
if FVirtualTree <> nil then
|
|
begin
|
|
pszHelpFile := Application.HelpFile;
|
|
pidTopic := FVirtualTree.HelpContext;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeAccessibility.Get_accKeyboardShortcut(varChild: OleVariant; out pszKeyboardShortcut: WideString): HResult;
|
|
// Not supported.
|
|
begin
|
|
pszKeyboardShortcut := '';
|
|
Result := S_FALSE;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeAccessibility.Get_accName(varChild: OleVariant; out pszName: WideString): HResult;
|
|
// if set, returns the new published AccessibleName property.
|
|
// if not set, tries the name and class name properties.
|
|
// otherwise, returns the default text.
|
|
begin
|
|
pszName := '';
|
|
Result := S_FALSE;
|
|
if varChild = CHILDID_SELF then
|
|
begin
|
|
if FVirtualTree <> nil then
|
|
begin
|
|
if FVirtualTree.AccessibleName <> '' then
|
|
pszName := FVirtualTree.AccessibleName
|
|
else if FVirtualTree.Name <> '' then
|
|
pszName := FVirtualTree.Name
|
|
else if FVirtualTree.ClassName <> '' then
|
|
pszName := FVirtualTree.ClassName
|
|
else
|
|
PSZName := FVirtualTree.DefaultText;
|
|
result := S_OK;
|
|
end;
|
|
end
|
|
else if varType(varChild) = VT_I4 then
|
|
begin
|
|
// return the name for the inner accessible item
|
|
if (FVirtualTree <> nil) and (FVirtualTree.AccessibleItem <> nil) then
|
|
begin
|
|
Result := FVirtualTree.AccessibleItem.Get_accName(CHILDID_SELF, pszName);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeAccessibility.Get_accParent(out ppdispParent: IDispatch): HResult;
|
|
// Returns false, the tree itself does not have a parent.
|
|
var
|
|
hParent: HWND;
|
|
begin
|
|
Result := E_INVALIDARG;
|
|
ppdispParent := nil;
|
|
|
|
// Addition - Simon Moscrop 7/5/2009
|
|
if (FVirtualTree.HandleAllocated) then
|
|
begin
|
|
(* return the accesible object from the 'parent' which is the window of the
|
|
tree itself! (This doesn't initially appear correct but it seems to
|
|
be exactly what all the other controls do! To verfify try pointing the
|
|
ms accessibility explorer at a simple button control which has been dropped
|
|
onto a form.
|
|
*)
|
|
hParent := FVirtualTree.Handle;
|
|
RESULT := AccessibleObjectFromWindow(hParent,CHILDID_SELF,IID_IAccessible,pointeR(ppDispParent));
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeAccessibility.Get_accRole(varChild: OleVariant; out pvarRole: OleVariant): HResult;
|
|
// tells MSAA that it is a TreeView.
|
|
begin
|
|
Result := S_OK;
|
|
// VariantInit(pvarRole);
|
|
// TVarData(pvarRole).VType := VT_I4;
|
|
if varChild = CHILDID_SELF then
|
|
begin
|
|
if FVirtualTree <> nil then
|
|
pvarRole := ROLE_SYSTEM_OUTLINE;
|
|
end
|
|
else if VarType(varChild) = VT_I4 then
|
|
begin
|
|
// return the role of the inner accessible object
|
|
if (FVirtualTree <> nil) and (FVirtualTree.FocusedNode <> nil) then
|
|
pvarRole := ROLE_SYSTEM_OUTLINEITEM
|
|
else
|
|
RESULT := S_FALSE;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeAccessibility.accSelect(flagsSelect: Integer; varChild: OleVariant): HResult;
|
|
var
|
|
lIndexToSelect: Cardinal;
|
|
i: Integer;
|
|
lNode: PVirtualNode;
|
|
begin
|
|
lIndexToSelect := varChild;
|
|
if lIndexToSelect >= Self.FVirtualTree.TotalCount then
|
|
Exit(E_INVALIDARG);
|
|
lNode := FVirtualTree.GetFirst();
|
|
for i := 0 to Integer(lIndexToSelect) - 1 do
|
|
lNode := FVirtualTree.GetNext(lNode);
|
|
Result := E_NOTIMPL;
|
|
if (flagsSelect and SELFLAG_TAKEFOCUS) <> 0then begin
|
|
FVirtualTree.FocusedNode := lNode;
|
|
Result := S_OK;
|
|
end;//if SELFLAG_TAKEFOCUS
|
|
if (flagsSelect and SELFLAG_TAKESELECTION) <> 0 then begin
|
|
FVirtualTree.ClearSelection();
|
|
FVirtualTree.Selected[lNode] := True;
|
|
Result := S_OK;
|
|
end;//if SELFLAG_TAKEFOCUS
|
|
if (flagsSelect and SELFLAG_ADDSELECTION) <> 0 then begin
|
|
FVirtualTree.Selected[lNode] := True;
|
|
Result := S_OK;
|
|
end;
|
|
if (flagsSelect and SELFLAG_REMOVESELECTION) <> 0 then begin
|
|
FVirtualTree.Selected[lNode] := False;
|
|
Result := S_OK;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeAccessibility.Get_accState(varChild: OleVariant; out pvarState: OleVariant): HResult;
|
|
// returns the state of the control.
|
|
const
|
|
IsEnabled: array[Boolean] of Integer = (STATE_SYSTEM_UNAVAILABLE, 0);
|
|
HasPopup: array[Boolean] of Integer = (0, STATE_SYSTEM_HASPOPUP);
|
|
IsVisible: array[Boolean] of Integer = (STATE_SYSTEM_INVISIBLE, 0);
|
|
begin
|
|
Result := S_OK;
|
|
// VariantInit(pvarState);
|
|
// TVarData(pvarState).VType := VT_I4;
|
|
if varChild = CHILDID_SELF then
|
|
begin
|
|
if FVirtualTree <> nil then
|
|
begin
|
|
pvarState := STATE_SYSTEM_FOCUSED or STATE_SYSTEM_FOCUSABLE or STATE_SYSTEM_HOTTRACKED;
|
|
pvarState := pvarState or IsVisible[FVirtualTree.Visible];
|
|
pvarState := pvarState or IsEnabled[FVirtualTree.Enabled];
|
|
end
|
|
else
|
|
Result := E_INVALIDARG;
|
|
end
|
|
else if VarType(VarChild) = VT_I4 then
|
|
begin
|
|
// return the state of the inner accessible item
|
|
if (FVirtualTree <> nil) and (FVirtualTree.AccessibleItem <> nil) then
|
|
begin
|
|
Result := FVirtualTree.AccessibleItem.Get_accState(CHILDID_SELF, pVarState);
|
|
end
|
|
else
|
|
RESULT := E_INVALIDARG;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeAccessibility.Get_accValue(varChild: OleVariant; out pszValue: WideString): HResult;
|
|
// the TreeView control itself does not have a value, returning false here.
|
|
begin
|
|
RESULT := S_FALSE;
|
|
|
|
pszValue := '';
|
|
if VarType(varChild) = VT_I4 then
|
|
if varChild = CHILDID_SELF then
|
|
Result := S_FALSE
|
|
else if (FVirtualTree <> nil) and (FVirtualTree.AccessibleItem <> nil) then
|
|
RESULT := FVirtualTree.AccessibleItem.Get_accValue(CHILDID_SELF,pszValue);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeAccessibility.Invoke(DispID: Integer; const IID: TGUID;
|
|
LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
|
|
ArgErr: Pointer): HRESULT;
|
|
// not supported.
|
|
begin
|
|
Result := E_NOTIMPL;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeAccessibility.Set_accName(varChild: OleVariant; const pszName: WideString): HResult; stdcall;
|
|
// not supported.
|
|
begin
|
|
Result := DISP_E_MEMBERNOTFOUND;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeAccessibility.Set_accValue(varChild: OleVariant; const pszValue: WideString): HResult;
|
|
// not supported.
|
|
begin
|
|
Result := DISP_E_MEMBERNOTFOUND
|
|
end;
|
|
|
|
{ TVirtualTreeItemAccessibility }
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeItemAccessibility.accLocation(out pxLeft, pyTop, pcxWidth,
|
|
pcyHeight: Integer; varChild: OleVariant): HResult;
|
|
// returns the location of the current accessible item.
|
|
var
|
|
P: TPoint;
|
|
DisplayRect: TRect;
|
|
begin
|
|
Result := S_FALSE;
|
|
if varChild = CHILDID_SELF then
|
|
begin
|
|
if FVirtualTree.FocusedNode <> nil then
|
|
begin
|
|
DisplayRect := FVirtualTree.GetDisplayRect(FVirtualTree.FocusedNode, FVirtualTree.Header.Columns.GetFirstVisibleColumn, True, False);//Use first visible column instead of -1
|
|
P := FVirtualTree.ClientToScreen(DisplayRect.TopLeft);
|
|
pxLeft := P.X;
|
|
pyTop := P.Y;
|
|
pcxWidth := DisplayRect.Right - DisplayRect.Left;
|
|
pcyHeight := DisplayRect.Bottom - DisplayRect.Top;
|
|
Result := S_OK;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeItemAccessibility.Get_accChild(varChild: OleVariant; out ppdispChild: IDispatch): HResult;
|
|
// the item does not have children. Returning false.
|
|
begin
|
|
ppdispChild := nil;
|
|
Result := S_FALSE;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeItemAccessibility.Get_accChildCount(out pcountChildren: Integer): HResult;
|
|
// the item itself does not have children, returning 0.
|
|
begin
|
|
pcountChildren := 0;
|
|
Result := S_OK;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeItemAccessibility.Get_accDescription(varChild: OleVariant; out pszDescription: WideString): HResult;
|
|
// not supported for an item.
|
|
begin
|
|
Result := DISP_E_MEMBERNOTFOUND;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeItemAccessibility.Get_accFocus(out pvarChild: OleVariant): HResult;
|
|
begin
|
|
// must override this or we get an infinite loop when using MS narrator
|
|
// when navigating using the arrow keys.
|
|
RESULT := S_FALSE;
|
|
if FVirtualTree.FocusedNode <> nil then
|
|
begin
|
|
pvarChild := CHILDID_SELF;
|
|
RESULT := S_OK;
|
|
end;
|
|
end;
|
|
|
|
function TVirtualTreeItemAccessibility.Get_accName(varChild: OleVariant; out pszName: WideString): HResult;
|
|
// the name is the node's caption.
|
|
var
|
|
kind: TVTImageKind;
|
|
ImgText: WideString;
|
|
begin
|
|
pszName := '';
|
|
Result := S_FALSE;
|
|
if varChild = childid_self then
|
|
begin
|
|
if FVirtualTree <> nil then
|
|
if FVirtualTree.FocusedNode <> nil then
|
|
begin
|
|
for kind := ikNormal to ikOverlay do
|
|
begin
|
|
ImgText := FVirtualTree.ImageText[FVirtualTree.FocusedNode, Kind, FVirtualTree.Header.MainColumn];
|
|
if ImgText <> '' then
|
|
pszName := pszName + ImgText + ' ';
|
|
end;
|
|
pszName := pszName + FVirtualTree.Text[FVirtualTree.FocusedNode, FVirtualTree.Header.MainColumn];
|
|
result := S_OK;
|
|
end
|
|
else begin
|
|
PSZName := FVirtualTree.DefaultText;
|
|
result := S_OK;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeItemAccessibility.Get_accParent(out ppdispParent: IDispatch): HResult;
|
|
// tells MSAA that the VritualStringTree is its parent.
|
|
begin
|
|
result := S_FALSE;
|
|
if FVirtualTree <> nil then
|
|
begin
|
|
ppdispParent := FVirtualTree.Accessible;
|
|
Result := S_OK;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeItemAccessibility.Get_accRole(varChild: OleVariant; out pvarRole: OleVariant): HResult;
|
|
// tells MSAA that it is a TreeView item as opposed to the TreeView itself.
|
|
begin
|
|
Result := S_OK;
|
|
// VariantInit(pvarRole);
|
|
// TVarData(pvarRole).VType := VT_I4;
|
|
if varChild = childid_self then
|
|
begin
|
|
if FVirtualTree <> nil then
|
|
pvarRole := ROLE_SYSTEM_OUTLINEITEM;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeItemAccessibility.Get_accState(varChild: OleVariant; out pvarState: OleVariant): HResult;
|
|
// Tells MSAA the state the item is in.
|
|
const
|
|
IsEnabled: array[Boolean] of Integer = (STATE_SYSTEM_UNAVAILABLE, 0);
|
|
HasPopup: array[Boolean] of Integer = (0, STATE_SYSTEM_HASPOPUP);
|
|
IsVisible: array[Boolean] of Integer = (STATE_SYSTEM_INVISIBLE, 0);
|
|
IsChecked: array[Boolean] of Integer = (0, STATE_SYSTEM_CHECKED);
|
|
IsExpanded: array[Boolean] of Integer = (0, STATE_SYSTEM_EXPANDED);
|
|
IsCollapsed: array[Boolean] of Integer = (0, STATE_SYSTEM_COLLAPSED);
|
|
begin
|
|
Result := S_OK;
|
|
// VariantInit(pvarState);
|
|
// TVarData(pvarState).VType := VT_I4;
|
|
if varChild = childid_self then
|
|
begin
|
|
if FVirtualTree <> nil then
|
|
begin
|
|
pvarState := STATE_SYSTEM_FOCUSED or STATE_SYSTEM_FOCUSABLE or STATE_SYSTEM_HOTTRACKED;
|
|
pvarState := pvarState or IsVisible[FVirtualTree.Visible];
|
|
pvarState := pvarState or IsEnabled[FVirtualTree.Enabled];
|
|
if fVirtualTree.FocusedNode <> nil then
|
|
begin
|
|
pvarState := pvarState or IsChecked[csCheckedNormal = FVirtualTree.FocusedNode.CheckState];
|
|
pvarState := pvarState or IsExpanded[VSExpanded in FVirtualTree.FocusedNode.States];
|
|
if not (vsExpanded in FVirtualTree.FocusedNode.States) then
|
|
pvarState:= PvarState or IsCollapsed[vsHasChildren in FVirtualTree.FocusedNode.States];
|
|
end;
|
|
end
|
|
else
|
|
Result := E_INVALIDARG;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
function TVirtualTreeItemAccessibility.Get_accValue(varChild: OleVariant; out pszValue: WideString): HResult;
|
|
// for a TreeView item, the value is the nesting level number, 0-based.
|
|
begin
|
|
pszValue := '';
|
|
Result := S_FALSE;
|
|
if varChild = childid_self then
|
|
if FVirtualTree <> nil then
|
|
if FVirtualTree.FocusedNode <> nil then
|
|
begin
|
|
PSZValue := IntToStr(FVirtualTree.GetNodeLevel(FVirtualTree.FocusedNode));
|
|
result := S_OK;
|
|
end;
|
|
end;
|
|
|
|
{ TVTMultiColumnItemAccessibility }
|
|
|
|
function TVTMultiColumnItemAccessibility.GetItemDescription(
|
|
varChild: OleVariant; out pszDescription: WideString;
|
|
IncludeMainColumn: boolean): HResult;
|
|
var
|
|
I: Integer;
|
|
ImgText: WideString;
|
|
kind: TVTImageKind;
|
|
begin
|
|
pszDescription := '';
|
|
Result := S_FALSE;
|
|
if varChild = childid_self then
|
|
begin
|
|
if FVirtualTree <> nil then
|
|
if FVirtualTree.FocusedNode <> nil then
|
|
begin
|
|
if IncludeMainColumn then
|
|
begin
|
|
for kind := ikNormal to ikOverlay do
|
|
begin
|
|
ImgText := FVirtualTree.ImageText[FVirtualTree.FocusedNode, Kind, FVirtualTree.Header.MainColumn];
|
|
if ImgText <> '' then
|
|
ImgText := ImgText + ' ';
|
|
end;
|
|
pszDescription := ImgText + FVirtualTree.Text[FVirtualTree.FocusedNode, FVirtualTree.Header.MainColumn] + '; ';
|
|
end;
|
|
for I := 0 to FVirtualTree.Header.Columns.Count - 1 do
|
|
if (FVirtualTree.Header.MainColumn <> I) and (coVisible in FVirtualTree.Header.Columns[I].Options) then
|
|
begin
|
|
for kind := ikNormal to ikOverlay do
|
|
begin
|
|
ImgText := FVirtualTree.ImageText[FVirtualTree.FocusedNode, Kind, I];
|
|
if ImgText <> '' then
|
|
ImgText := ImgText + ' ';
|
|
end;
|
|
ImgText := ImgText + FVirtualTree.Text[FVirtualTree.FocusedNode, I];
|
|
if ImgText <> '' then
|
|
pszDescription := pszDescription
|
|
+FVirtualTree.Header.Columns[I].Text
|
|
+': '
|
|
+ ImgText
|
|
+'; ';
|
|
end;
|
|
if pszDescription <> '' then
|
|
if pszDescription[Length(pszDescription)-1] = ';' then
|
|
Delete(pszDescription, length(pszDescription)-1, 2);
|
|
result := S_OK;
|
|
end
|
|
else begin
|
|
PSZDescription := FVirtualTree.DefaultText;
|
|
result := S_OK;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TVTMultiColumnItemAccessibility.Get_accDescription(
|
|
varChild: OleVariant; out pszDescription: WideString): HResult;
|
|
begin
|
|
result := GetItemDescription(varChild, pszDescription, false)
|
|
end;
|
|
|
|
function TVTMultiColumnItemAccessibility.Get_accName(varChild: OleVariant;
|
|
out pszName: WideString): HResult;
|
|
begin
|
|
result := GetItemDescription(varChild, pszName, true)
|
|
end;
|
|
|
|
{ TVTDefaultAccessibleProvider }
|
|
|
|
function TVTDefaultAccessibleProvider.CreateIAccessible(ATree: TBaseVirtualTree): IAccessible;
|
|
begin
|
|
result := TVirtualTreeAccessibility.Create(TVirtualStringTree(ATree));
|
|
end;
|
|
|
|
{ TVTDefaultAccessibleItemProvider }
|
|
|
|
function TVTDefaultAccessibleItemProvider.CreateIAccessible(ATree: TBaseVirtualTree): IAccessible;
|
|
begin
|
|
result := TVirtualTreeItemAccessibility.Create(TVirtualStringTree(ATree));
|
|
end;
|
|
|
|
{ TVTMultiColumnAccessibleItemProvider }
|
|
|
|
function TVTMultiColumnAccessibleItemProvider.CreateIAccessible(ATree: TBaseVirtualTree): IAccessible;
|
|
begin
|
|
result := nil;
|
|
if TVirtualStringTree(ATree).Header.UseColumns then
|
|
result := TVTMultiColumnItemAccessibility.Create(TVirtualStringTree(ATree));
|
|
end;
|
|
|
|
var
|
|
DefaultAccessibleProvider: TVTDefaultAccessibleProvider;
|
|
DefaultAccessibleItemProvider: TVTDefaultAccessibleItemProvider;
|
|
MultiColumnAccessibleProvider: TVTMultiColumnAccessibleItemProvider;
|
|
|
|
initialization
|
|
if DefaultAccessibleProvider = nil then
|
|
begin
|
|
DefaultAccessibleProvider := TVTDefaultAccessibleProvider.Create;
|
|
TVTAccessibilityFactory.GetAccessibilityFactory.RegisterAccessibleProvider(DefaultAccessibleProvider);
|
|
end;
|
|
if DefaultAccessibleItemProvider = nil then
|
|
begin
|
|
DefaultAccessibleItemProvider := TVTDefaultAccessibleItemProvider.Create;
|
|
TVTAccessibilityFactory.GetAccessibilityFactory.RegisterAccessibleProvider(DefaultAccessibleItemProvider);
|
|
end;
|
|
if MultiColumnAccessibleProvider = nil then
|
|
begin
|
|
MultiColumnAccessibleProvider := TVTMultiColumnAccessibleItemProvider.Create;
|
|
TVTAccessibilityFactory.GetAccessibilityFactory.RegisterAccessibleProvider(MultiColumnAccessibleProvider);
|
|
end;
|
|
finalization
|
|
TVTAccessibilityFactory.GetAccessibilityFactory.UnRegisterAccessibleProvider(MultiColumnAccessibleProvider);
|
|
MultiColumnAccessibleProvider := nil;
|
|
TVTAccessibilityFactory.GetAccessibilityFactory.UnRegisterAccessibleProvider(DefaultAccessibleItemProvider);
|
|
DefaultAccessibleItemProvider := nil;
|
|
TVTAccessibilityFactory.GetAccessibilityFactory.UnRegisterAccessibleProvider(DefaultAccessibleProvider);
|
|
DefaultAccessibleProvider := nil;
|
|
|
|
end.
|
|
|
|
|
|
|