Adding Automation to a standard Delphi Control - jhc-systems/DelphiUIAutomation GitHub Wiki
#Example of adding automation to a control
The standard Delphi controls do not implement the uiautomation interfaces in a usable way, for some this is not really an issue, but for controls like TEdit, TComboBox, etc. this means that they are not locatable via a name, althought they can be located through the order that they are located within the visual tree of a form / dialog.
For those controls that have caused me the most problem (TComboBox, TEdit, TMaskEdit, and especially TStringGrid), these are implemented as part of this library, see AutomatedEdit for example.
But, if someone wanted to implement a new control, to have a set automationID for example, how would this be done? Robert Deutschmann (from EKOR Consulting AG) wanted to add additional functionality to the standard TButton, and this is a good example ..
##'Automating' TButton
###Create a descendant class of TButton
TAutomatedButton = class(TButton)
...
end;
Add automation type-library
The UIAutomationCore_TLB file has the extracted type-library for the ms-uiautomation library, so it needs to be included in the module.
Add the interfaces that are required.
In this case the IRawElementProviderSimple interface is required, the IInvokeProvider and IValueProvider hook up the required methods.
TAutomatedButton = class(TButton,
IInvokeProvider,
IRawElementProviderSimple)
private
{ Private declarations }
FRawElementProviderSimple : IRawElementProviderSimple;
procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT;
public
{ Public declarations }
// IRawElementProviderSimple
function Get_ProviderOptions(out pRetVal: ProviderOptions): HResult; stdcall;
function GetPatternProvider(patternId: SYSINT; out pRetVal: IUnknown): HResult; stdcall;
function GetPropertyValue(propertyId: SYSINT; out pRetVal: OleVariant): HResult; stdcall;
function Get_HostRawElementProvider(out pRetVal: IRawElementProviderSimple): HResult; stdcall;
// IValueProvider
function SetValue(val: PWideChar): HResult; stdcall;
function Get_Value(out pRetVal: WideString): HResult; stdcall;
function Get_IsReadOnly(out pRetVal: Integer): HResult; stdcall;
// IInvokeProvider
function Invoke: HResult; stdcall;
Implementing these functions is pretty straightforward, these are the specifics:
###GetPatternProvider This tells the automation library what the control will respond to, in this case the control will be looking for ValuePattern (to give back a value) and InvokePattern (to invoke an event).
function TAutomatedButton.GetPatternProvider(patternId: SYSINT;
out pRetVal: IInterface): HResult;
begin
result := S_OK;
pRetval := nil;
if (patternID = UIA_ValuePatternID) ||
(patternID = UIA_InvokePatternId) then
begin
pRetVal := self;
end;
end;
###GetPropertyValue
This method tells the control to return certain values for the given properties. In this case Robert has set the ControlType to be UIA_ButtonControlTypeId (so it can be seen as a Button), and the AutomationID to be the name of the control., meaning that it can be easier found by either automationID or value.
function TAutomatedButton.GetPropertyValue(propertyId: SYSINT;
out pRetVal: OleVariant): HResult;
begin
if(propertyId = UIA_ClassNamePropertyId) then
begin
TVarData(pRetVal).VType := varOleStr;
TVarData(pRetVal).VOleStr := pWideChar(self.ClassName);
result := S_OK;
end
else if(propertyId = UIA_NamePropertyId) then
begin
TVarData(pRetVal).VType := varOleStr;
TVarData(pRetVal).VOleStr := pWideChar(self.Name);
result := S_OK;
end
else if(propertyId = UIA_AutomationIdPropertyId) then
begin
TVarData(pRetVal).VType := varOleStr;
TVarData(pRetVal).VOleStr := pWideChar(self.Name);
result := S_OK;
end
else if(propertyId = UIA_ControlTypePropertyId) then
begin
TVarData(pRetVal).VType := varInteger;
TVarData(pRetVal).VInteger := UIA_ButtonControlTypeId;
result := S_OK;
end
else
result := S_FALSE;
end;
###Get/Set Value These will return the text of the control, in this case the title (i.e. 'OK' / 'Cancel' / etc.)
function TAutomatedButton.Get_Value(out pRetVal: WideString): HResult;
begin
Result := S_OK;
pRetVal := self.Text;
end;
function TAutomatedButton.SetValue(val: PWideChar): HResult;
begin
self.Text := val;
Result := S_OK;
end;
IsReadOnly
This is rather undocumented as to how it should be implemented, so if returns 0 in this case.
function TAutomatedButton.Get_IsReadOnly(out pRetVal: Integer): HResult;
begin
pRetVal := 0; // Maybe?
Result := S_OK;
end;
Get_HostRawElementProvider & WMGetObject
These methods are 'plumbing' and need to be implemented as is, they expose the base automation to ms-uiautomation.
function TAutomatedButton.Get_HostRawElementProvider(
out pRetVal: IRawElementProviderSimple): HResult;
begin
result := UiaHostProviderFromHwnd (self.Handle, pRetVal);
end;
procedure TAutomatedButton.WMGetObject(var Message: TMessage);
begin
if (Message.Msg = WM_GETOBJECT) then
begin
QueryInterface(IID_IRawElementProviderSimple, FRawElementProviderSimple);
message.Result := UiaReturnRawElementProvider(self.Handle, Message.WParam, Message.LParam, FRawElementProviderSimple);
end
else
Message.Result := DefWindowProc(self.Handle, Message.Msg, Message.WParam, Message.LParam);
end;
###Invoke Finally when the IInvokePattern Invoke is called, then the click event of the button is triggered.
function TAutomatedButton.Invoke: HResult;
begin
Self.Click;
result := S_OK;
end;