Delphi Components and Screen Readers

Question

I use Delphi and C++Builder and have some accessibility questions in regards to screen readers.

I have a button on a form which descends from TWinControl. If I put a caption on the button the screen reader will read it to me when the button is in focus. However, there are cases where I use buttons with an image and no caption. The screen reader doesn’t say anything if there is no caption. What can I do to have the screen reader say what this button is?

Similarly for an image on a form which descends from TGraphicControl. How can I tell the screen reader what to say when the object is moused over?

I’ve looked into the IAccessible wrapper, but I would prefer not to extend every control we use if at all possible.

A TGraphic can't get focus, it's not even a component. You're probably meaning to say TGraphicControl, which still can't get focus. That's one of the main purposes of a TGraphicControl. — Jerry Dodge
Thanks Jerry. I did indeed mean TGraphicControl and updated the question accordingly. I meant mouse over the control, not get focus. I'm curious to see ideas others have come up with for handling some sort of alt text for TGraphicControls on their forms. — Mike Nowakowski

Remy Lebeau Remy Lebeau · Accepted Answer · 2016-07-09T00:18:06

However, there are cases where I use buttons with an image and no caption. The screen reader doesn’t say anything if there is no caption. What can I do to have the screen reader say what this button is?

An IAccessible implementation for the button must provide the desired text to screen readers. By default, the OS provides a default IAccessible implementation for many UI controls, including buttons.

So, one simple trick you could do would be to owner-draw the button manually, then you can set its standard Caption for the default IAccessible implementation to use normally, and then you could simply do not include the Caption when you draw the button.

Otherwise, you can handle the WM_GETOBJECT message directly to retrieve the button's default IAccessible implementation and then wrap it so you can return your desired text and delegate everything else to the default implementation. For example:

type
  TMyAccessibleText = class(TInterfacedObject, IAccessible)
  private
    fAcc: IAccessible;
    fAccessibleText: string;
  public:
    constructor Create(Acc: IAccessible; AccessibleText: string);

    function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;

    function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
    function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;

    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;
  end;

constructor TMyAccessibleText.Create(Acc: IAccessible; AccessibleText: string);
begin
  inherited Create;
  fAcc := Acc;
  fAccessibleText := AccessibleText;
end;

function TMyAccessibleText.QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
begin
  if IID = IID_IAccessible then
    Result := inherited QueryInterface(IID, Obj)
  else
    Result := fAcc.QueryInterface(IID, Obj);
end;

function TMyAccessibleText.GetTypeInfoCount(out Count: Integer): HResult; stdcall;
begin
  Result := fAcc.GetTypeInfoCount(Count);
end;

function TMyAccessibleText.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
begin
  Result := fAcc.GetTypeInfo(Index, LocaleID, TypeInfo);
end;

function TMyAccessibleText.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
begin
  Result := fAcc.GetIDsOfNames(IID, Names, NameCount, LocaleID, DispIDs);
end;

function TMyAccessibleText.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
begin
  Result := fAcc.Invoke(DispID, IID, LocaleID, Flags, Params, VarResult, ExcepInfo, ArgErr);
end;

function TMyAccessibleText.Get_accParent(out ppdispParent: IDispatch): HResult; stdcall;
begin
  Result := fAcc.Get_accParent(ppdispParent);
end;

function TMyAccessibleText.Get_accChildCount(out pcountChildren: Integer): HResult; stdcall;
begin
  Result := fAcc.Get_accChildCount(pcountChildren);
end;

function TMyAccessibleText.Get_accChild(varChild: OleVariant; out ppdispChild: IDispatch): HResult; stdcall;
begin
  Result := fAcc.Get_accChild(varChild, ppdispChild);
end;

function TMyAccessibleText.Get_accName(varChild: OleVariant; out pszName: WideString): HResult; stdcall;
begin
  Result := fAcc.Get_accName(varChild, pszName);
end;

function TMyAccessibleText.Get_accValue(varChild: OleVariant; out pszValue: WideString): HResult; stdcall;
begin
  if varChild = CHILDID_SELF then
  begin
    pszValue := fAccessibleText;
    Result := S_OK;
  end else
    Result := fAcc.Get_accValue(varChild, pszValue);
end;

function TMyAccessibleText.Get_accDescription(varChild: OleVariant; out pszDescription: WideString): HResult; stdcall;
begin
  Result := fAcc.Get_accDescription(varChild, pszDescription);
end;

function TMyAccessibleText.Get_accRole(varChild: OleVariant; out pvarRole: OleVariant): HResult; stdcall;
begin
  Result := fAcc.Get_accRole(varChild, pvarRole);
end;

function TMyAccessibleText.Get_accState(varChild: OleVariant; out pvarState: OleVariant): HResult; stdcall;
begin
  Result := fAcc.Get_accState(varChild, pvarState);
end;

function TMyAccessibleText.Get_accHelp(varChild: OleVariant; out pszHelp: WideString): HResult; stdcall;
begin
  Result := fAcc.Get_accHelp(varChild, pszHelp);
end;

function TMyAccessibleText.Get_accHelpTopic(out pszHelpFile: WideString; varChild: OleVariant; out pidTopic: Integer): HResult; stdcall;
begin
  Result := fAcc.Get_accHelpTopic(pszHelpFile, varChild, pidTopic);
end;

function TMyAccessibleText.Get_accKeyboardShortcut(varChild: OleVariant; out pszKeyboardShortcut: WideString): HResult; stdcall;
begin
  Result := fAcc.Get_accKeyboardShortcut(varChild, pszKeyboardShortcut);
end;

function TMyAccessibleText.Get_accFocus(out pvarChild: OleVariant): HResult; stdcall;
begin
  Result := fAcc.Get_accFocus(pvarChild);
end;

function TMyAccessibleText.Get_accSelection(out pvarChildren: OleVariant): HResult; stdcall;
begin
  Result := fAcc.Get_accSelection(pvarChildren);
end;

function TMyAccessibleText.Get_accDefaultAction(varChild: OleVariant; out pszDefaultAction: WideString): HResult; stdcall;
begin
  Result := fAcc.Get_accDefaultAction(varChild, pszDefaultAction);
end;

function TMyAccessibleText.accSelect(flagsSelect: Integer; varChild: OleVariant): HResult; stdcall;
begin
  Result := fAcc.accSelect(flagsSelect, varChild);
end;

function TMyAccessibleText.accLocation(out pxLeft: Integer; out pyTop: Integer; out pcxWidth: Integer; out pcyHeight: Integer; varChild: OleVariant): HResult; stdcall;
begin
  Result := fAcc.accLocation(pxLeft, pyTop, pcxWidth, pcyHeight, varChild);
end;

function TMyAccessibleText.accNavigate(navDir: Integer; varStart: OleVariant; out pvarEndUpAt: OleVariant): HResult; stdcall;
begin
  Result := fAcc.accNavigate(navDir, varStart, pvarEndUpAt);
end;

function TMyAccessibleText.accHitTest(xLeft: Integer; yTop: Integer; out pvarChild: OleVariant): HResult; stdcall;
begin
  Result := fAcc.accHitTest(xLeft, yTop, pvarChild);
end;

function TMyAccessibleText.accDoDefaultAction(varChild: OleVariant): HResult; stdcall;
begin
  Result := fAcc.accDoDefaultAction(varChild);
end;

function TMyAccessibleText.Set_accName(varChild: OleVariant; const pszName: WideString): HResult; stdcall;
begin
  Result := fAcc.Set_accName(varChild, pszName);
end;

function TMyAccessibleText.Set_accValue(varChild: OleVariant; const pszValue: WideString): HResult; stdcall;
begin
  if varChild = CHILDID_SELF then
  begin
    fAccessibleText := pszValue;
    Result := S_OK;
  end else
    Result := fAcc.Set_accValue(varChild, pszValue);
end;

type
  TBitBtn = class(Vcl.Buttons.TBitBtn)
  private
    procedure WMGetObject(var Message: TMessage): message WM_GETOBJECT;
  public
    MyAccessibleText: string;
  end;

  TMyForm = class(TForm)
    Button1: TBitBtn;
    ...
    procedure FormCreate(Sender: TObject);
    ...
  end;

procedure TMyForm.FormCreate(Sender: TObject);
begin
  Button1.MyAccessibleText := 'There is an image here';
end;

procedure TBitBtn.WMGetObject(var Message: TMessage);
var
  Acc: IAccessible;
begin
  inherited;
  if (Message.LParam = OBJID_CLIENT) and (Message.Result > 0) and (Caption = '') and (MyAccessibleText <> '') then
  begin
    if ObjectFromLresult(Message.Result, IAccessible, Message.WParam, Acc) = S_OK then
    begin
      Acc := TMyAccessibleText.Create(Acc, MyAccessibleText) as IAccessible;
      Message.Result := LresultFromObject(IAccessible, Message.WParam, Acc);
    end;
  end;
end;

Similarly for an image on a form which descends from TGraphic. How can I tell the screen reader what to say when the object gets focus?

First off, TGraphic is not a component class. It is a wrapper for image data used by TPicture, which itself is a helper used by TImage, for instance. I assume you mean TGraphicControl instead (which TImage derives from).

A TGraphicControl-based component is not directly accessible to screen readers by default, as it has no window of its own, and as such it is not even known to the OS itself.

If you want a screen reader to interact with a graphical control, you must provide a full implementation of IAccessible from the Parent component (which does have a window) and have it expose additional Accessibility information about its graphical children.

I’ve looked into the IAccessible wrapper, but I would prefer not to extend every control we use if at all possible.

Sorry, but you will have to (unless you can find a 3rd party implementation that does what you need). The VCL simply does not implement any IAccessible functionality, so you have to implement it manually in your own code if you need to customize it beyond what the OS provides for you.

Delphi Components and Screen Readers

1 Answers