UIAutomation in Delphi 13

[Oboba 6]

There are more issues with the UIAutomation implementation in Delphi.

 

Here's the VCL code:

procedure TWinControl.WMGetObject(var Message: TMessage);
begin
  if (Message.Msg = WM_GETOBJECT) and (Message.LParam = LPARAM(UiaRootObjectId)) then
  begin
    if not Assigned(FUIAutomationProvider) then
      FUIAutomationProvider := InitUIAutomationProvider;

    if Assigned(FUIAutomationProvider) then
      Message.Result := UiaReturnRawElementProvider(Handle, Message.WParam, Message.LParam, FUIAutomationProvider)
    else
      inherited;
  end
  else
    inherited;
end;

 

And here's what the MSDN says:

Quote

Before comparing this value against the OBJID_ values, the server must cast it to DWORD; otherwise, on 64-bit Windows, the sign extension of the lParam can interfere with the comparison.

 

As expected, Delphi's implementation fails to work on 64 bits - the accessibility object is not created because the condition fails. So I had to override this behavior for my custom accessible controls: 

procedure TMyControl.WMGetObject(var Message: TMessage);
begin
  if (Message.Msg = WM_GETOBJECT) and (DWORD(Message.LParam) = DWORD(UiaRootObjectId)) then
  begin
    if not Assigned(UIAutomationProvider) then
      UIAutomationProvider := InitUIAutomationProvider;

    if Assigned(UIAutomationProvider) then
      Message.Result := UiaReturnRawElementProvider(Handle, Message.WParam, Message.LParam, UIAutomationProvider)
    else
      inherited;
  end
  else
    inherited;
end;

 

Edited November 10 by Oboba

[Remy Lebeau 1694]

I don't see any tickets about this at qp.embarcadero.com. You should open a new bug ticket for it.

[pyscripter 891]

Also

(Message.Msg = WM_GETOBJECT)

is redundant!

[David Heffernan 2514]

8 hours ago, pyscripter said:

Also

(Message.Msg = WM_GETOBJECT)

is redundant!

Tell tale sign of unsupervised intern code