Not very simply unfortunately.
I started from this:
https://github.com/jhc-systems/DelphiUIAutomation
Which has the UIAutomation type library imported, then I updated TAutomatedEdit which already has IRawElementProviderSimple in IValueProvider implemented.
I added the ITextProvider implementation which requires an implementation of ITextRangeProvider (unit DelphiUIAutomation.TextRangeProviders).
WARNING! This is a quick and dirty (not even close to proper) implementation of the ITextProvider and ITextRangeProvider interfaces.
Also I may have missed something. Let me know if you can't get it to work.
If you want to set an input scope for a control (numeric, email, URL, ... keyboard) use the SetInputScope function in the Winapi.MsCTF unit. (This should be implemented as a property on the new control or in case of a VCL fix in the TCustomEdit class)
I don't know if this will fit in the post but here goes:
{***************************************************************************}
{ }
{ DelphiUIAutomation }
{ }
{ Copyright 2015 JHC Systems Limited }
{ }
{***************************************************************************}
{ }
{ Licensed under the Apache License, Version 2.0 (the "License"); }
{ you may not use this file except in compliance with the License. }
{ You may obtain a copy of the License at }
{ }
{
http://www.apache.org/licenses/LICENSE-2.0 }
{ }
{ Unless required by applicable law or agreed to in writing, software }
{ distributed under the License is distributed on an "AS IS" BASIS, }
{ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. }
{ See the License for the specific language governing permissions and }
{ limitations under the License. }
{ }
{***************************************************************************}
unit AutomatedEdit;
interface
uses
UIAutomationCore_TLB,
messages,
ActiveX,
System.SysUtils, System.Classes, Vcl.Controls, Vcl.StdCtrls,
DelphiUIAutomation.TextRangeProviders;
type
TAutomatedEdit = class(TEdit,
ITextProvider,
IValueProvider,
IRawElementProviderSimple)
private
{ Private declarations }
FRawElementProviderSimple : IRawElementProviderSimple;
procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT;
protected
{ Protected declarations }
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;
// ITextProvider
function GetSelection(out pRetVal: PSafeArray): HResult; stdcall;
function GetVisibleRanges(out pRetVal: PSafeArray): HResult; stdcall;
function RangeFromChild(const childElement: IRawElementProviderSimple;
out pRetVal: ITextRangeProvider): HResult; stdcall;
function RangeFromPoint(point: UiaPoint; out pRetVal: ITextRangeProvider): HResult; stdcall;
function Get_DocumentRange(out pRetVal: ITextRangeProvider): HResult; stdcall;
function Get_SupportedTextSelection(out pRetVal: SupportedTextSelection): HResult; stdcall;
published
{ Published declarations }
end;
procedure Register;
implementation
uses
windows;
procedure Register;
begin
RegisterComponents('Samples', [TAutomatedEdit]);
end;
{ TAutomatedEdit }
function TAutomatedEdit.GetPatternProvider(patternId: SYSINT;
out pRetVal: IInterface): HResult;
begin
result := S_OK;
pRetval := nil;
if (patternID = UIA_ValuePatternID) then
begin
pRetVal := IValueProvider(self);
end else if (patternID = UIA_TextPatternID) then
begin
pRetVal := ITextProvider(self);
end
end;
function TAutomatedEdit.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_EditControlTypeId;
result := S_OK;
end
else
result := S_FALSE;
end;
function TAutomatedEdit.GetSelection(out pRetVal: PSafeArray): HResult;
var
I: Integer;
ptr: Pointer;
rp: TCustomEditRangeProvider;
begin
if (SelStart = 1) and (SelLength = Length(Text)) then begin
pRetVal := SafeArrayCreateVector(VT_PTR, 0, 1);
I := 0;
rp := TCustomEditRangeProvider.Create(Self);
ptr := @rp;
SafeArrayPutElement(pRetVal, I, ptr);
end else
pRetVal := SafeArrayCreateVector(VT_PTR, 0, 0);
Result := S_OK;
end;
function TAutomatedEdit.GetVisibleRanges(out pRetVal: PSafeArray): HResult;
var
I: Integer;
ptr: Pointer;
rp: TCustomEditRangeProvider;
begin
pRetVal := SafeArrayCreateVector(VT_PTR, 0, 1);
I := 0;
rp := TCustomEditRangeProvider.Create(Self);
ptr := @rp;
SafeArrayPutElement(pRetVal, I, ptr);
Result := S_OK;
end;
function TAutomatedEdit.Get_DocumentRange(
out pRetVal: ITextRangeProvider): HResult;
begin
pRetVal := ITextRangeProvider(TCustomEditRangeProvider.Create(Self));
Result := S_OK;
end;
function TAutomatedEdit.Get_HostRawElementProvider(
out pRetVal: IRawElementProviderSimple): HResult;
begin
result := UiaHostProviderFromHwnd (self.Handle, pRetVal);
end;
function TAutomatedEdit.Get_IsReadOnly(out pRetVal: Integer): HResult;
begin
pRetVal := 0; // Maybe?
Result := S_OK;
end;
function TAutomatedEdit.Get_ProviderOptions(
out pRetVal: ProviderOptions): HResult;
begin
pRetVal:= ProviderOptions_ServerSideProvider;
Result := S_OK;
end;
function TAutomatedEdit.Get_SupportedTextSelection(
out pRetVal: SupportedTextSelection): HResult;
begin
pRetVal := SupportedTextSelection_Single;
Result := S_OK;
end;
function TAutomatedEdit.Get_Value(out pRetVal: WideString): HResult;
begin
Result := S_OK;
pRetVal := self.Text;
end;
function TAutomatedEdit.RangeFromChild(
const childElement: IRawElementProviderSimple;
out pRetVal: ITextRangeProvider): HResult;
begin
pRetVal := ITextRangeProvider(TCustomEditRangeProvider.Create(Self));
Result := S_OK;
end;
function TAutomatedEdit.RangeFromPoint(point: UiaPoint;
out pRetVal: ITextRangeProvider): HResult;
begin
pRetVal := ITextRangeProvider(TCustomEditRangeProvider.Create(Self));
Result := S_OK;
end;
function TAutomatedEdit.SetValue(val: PWideChar): HResult;
begin
self.Text := val;
Result := S_OK;
end;
procedure TAutomatedEdit.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;
end.
**************************************************************
The ITextRangeProvider implementation:
unit DelphiUIAutomation.TextRangeProviders;
interface
uses
UIAutomationCore_TLB, ActiveX, StdCtrls, Windows, SysUtils;
type
TCustomEditRangeProvider = class(TInterfacedObject, ITextRangeProvider)
private
FCustomEdit: TCustomEdit;
protected
function GetCustomEdit: TCustomEdit;
public
constructor Create(CustomEdit: TCustomEdit);
function Clone(out pRetVal: ITextRangeProvider): HResult; stdcall;
function Compare(const range: ITextRangeProvider; out pRetVal: Integer): HResult; stdcall;
function CompareEndpoints(endpoint: TextPatternRangeEndpoint;
const targetRange: ITextRangeProvider;
targetEndpoint: TextPatternRangeEndpoint; out pRetVal: SYSINT): HResult; stdcall;
function ExpandToEnclosingUnit(unit_: TextUnit): HResult; stdcall;
function FindAttribute(attributeId: SYSINT; val: OleVariant; backward: Integer;
out pRetVal: ITextRangeProvider): HResult; stdcall;
function FindText(const text: WideString; backward: Integer; ignoreCase: Integer;
out pRetVal: ITextRangeProvider): HResult; stdcall;
function GetAttributeValue(attributeId: SYSINT; out pRetVal: OleVariant): HResult; stdcall;
function GetBoundingRectangles(out pRetVal: PSafeArray): HResult; stdcall;
function GetEnclosingElement(out pRetVal: IRawElementProviderSimple): HResult; stdcall;
function GetText(maxLength: SYSINT; out pRetVal: WideString): HResult; stdcall;
function Move(unit_: TextUnit; count: SYSINT; out pRetVal: SYSINT): HResult; stdcall;
function MoveEndpointByUnit(endpoint: TextPatternRangeEndpoint; unit_: TextUnit; count: SYSINT;
out pRetVal: SYSINT): HResult; stdcall;
function MoveEndpointByRange(endpoint: TextPatternRangeEndpoint;
const targetRange: ITextRangeProvider;
targetEndpoint: TextPatternRangeEndpoint): HResult; stdcall;
function Select: HResult; stdcall;
function AddToSelection: HResult; stdcall;
function RemoveFromSelection: HResult; stdcall;
function ScrollIntoView(alignToTop: Integer): HResult; stdcall;
function GetChildren(out pRetVal: PSafeArray): HResult; stdcall;
property CustomEdit: TCustomEdit read GetCustomEdit;
end;
implementation
{ TCustomEditRangeProvider }
function TCustomEditRangeProvider.AddToSelection: HResult;
begin
FCustomEdit.SelectAll;
Result := S_OK;
end;
function TCustomEditRangeProvider.Clone(
out pRetVal: ITextRangeProvider): HResult;
begin
pRetVal := ITextRangeProvider(TCustomEditRangeProvider.Create(FCustomEdit));
Result := S_OK;
end;
function TCustomEditRangeProvider.Compare(const range: ITextRangeProvider;
out pRetVal: Integer): HResult;
begin
pRetVal := 1;
Result := S_OK;
end;
function TCustomEditRangeProvider.CompareEndpoints(
endpoint: TextPatternRangeEndpoint; const targetRange: ITextRangeProvider;
targetEndpoint: TextPatternRangeEndpoint; out pRetVal: SYSINT): HResult;
begin
pRetVal := 0;
Result := S_OK;
end;
constructor TCustomEditRangeProvider.Create(CustomEdit: TCustomEdit);
begin
FCustomEdit := CustomEdit;
end;
function TCustomEditRangeProvider.ExpandToEnclosingUnit(
unit_: TextUnit): HResult;
begin
Result := S_OK;
end;
function TCustomEditRangeProvider.FindAttribute(attributeId: SYSINT;
val: OleVariant; backward: Integer; out pRetVal: ITextRangeProvider): HResult;
begin
pRetVal := ITextRangeProvider(Self);
Result := S_OK
end;
function TCustomEditRangeProvider.FindText(const text: WideString; backward,
ignoreCase: Integer; out pRetVal: ITextRangeProvider): HResult;
begin
pRetVal := ITextRangeProvider(Self);
Result := S_OK
end;
function TCustomEditRangeProvider.GetAttributeValue(attributeId: SYSINT;
out pRetVal: OleVariant): HResult;
begin
pRetVal := ITextRangeProvider(Self);
Result := S_OK
end;
function TCustomEditRangeProvider.GetBoundingRectangles(
out pRetVal: PSafeArray): HResult;
begin
pRetVal := SafeArrayCreateVector(VT_RECORD, 0, 0);
Result := S_OK;
end;
function TCustomEditRangeProvider.GetChildren(out pRetVal: PSafeArray): HResult;
begin
pRetVal := SafeArrayCreateVector(VT_PTR, 0, 0);
Result := S_OK;
end;
function TCustomEditRangeProvider.GetCustomEdit: TCustomEdit;
begin
Result := FCustomEdit;
end;
function TCustomEditRangeProvider.GetEnclosingElement(
out pRetVal: IRawElementProviderSimple): HResult;
begin
if not Supports(FCustomEdit, IID_IRawElementProviderSimple, pRetVal) then
Result := S_OK
else
Result := E_NOINTERFACE;
end;
function TCustomEditRangeProvider.GetText(maxLength: SYSINT;
out pRetVal: WideString): HResult;
begin
if maxLength < 0 then
pRetVal := FCustomEdit.Text
else
pRetVal := Copy(FCustomEdit.Text, 1, maxLength);
Result := S_OK;
end;
function TCustomEditRangeProvider.Move(unit_: TextUnit; count: SYSINT;
out pRetVal: SYSINT): HResult;
begin
pRetVal := 0;
Result := S_OK;
end;
function TCustomEditRangeProvider.MoveEndpointByRange(
endpoint: TextPatternRangeEndpoint; const targetRange: ITextRangeProvider;
targetEndpoint: TextPatternRangeEndpoint): HResult;
begin
Result := S_OK;
end;
function TCustomEditRangeProvider.MoveEndpointByUnit(
endpoint: TextPatternRangeEndpoint; unit_: TextUnit; count: SYSINT;
out pRetVal: SYSINT): HResult;
begin
pRetVal := 0;
Result := S_OK;
end;
function TCustomEditRangeProvider.RemoveFromSelection: HResult;
begin
Result := S_OK
end;
function TCustomEditRangeProvider.ScrollIntoView(alignToTop: Integer): HResult;
begin
Result := S_OK;
end;
function TCustomEditRangeProvider.Select: HResult;
begin
FCustomEdit.SelectAll;
Result := S_OK;
end;
end.
Connect with Us