Passing SafeArray from Delphi through to ms-uiautomation libraries

Question

In relation to a previous question, I now have a partially working implementation that wraps up the TStringGrid, and allows automation to access it.

Sort of anyway.

I need to implement the GetSelection method of the ISelectionProvider, but even though I think I have create a pSafeArray, when I use ms-uiautomation to get the resulting array, it has 0 entries. The code below is definitely called, as I can put a break point and stop it in the method.

I have tried several ways of creating and populating the array, this is my latest (base on a different question on StackOverflow..

function TAutomationStringGrid.GetSelection(out pRetVal: PSafeArray): HResult;
var
  obj : TAutomationStringGridItem;
  outBuffer : PSafeArray;
  offset : integer;
begin
  obj := TAutomationStringGridItem.create(self);
  obj.Row := self.row;
  obj.Column := self.Col;
  obj.Value := self.Cells[self.Col, self.Row];

  offset := 0;
  outBuffer := SafeArrayCreateVector(VT_VARIANT, 0, 1);
  SafeArrayPutElement(outBuffer, offset, obj);
  pRetVal := outBuffer;
  result := S_OK;
end;

Any thoughts on what I am doing wrong ?

UPDATE:

Just to clarify, the automation code that gets called is as follows ..

  var
    collection : IUIAutomationElementArray;
  ...
  // Assume that we have a valid pattern
  FSelectionPattern.GetCurrentSelection(collection);
  collection.Get_Length(length);

The value returned from Get_Length is 0.

Answer 1

Your GetSelection() implementation is expected to return a SAFEARRAY of IRawElementProviderSimple interface pointers. However, you are creating a SAFEARRAY of VARIANT elements instead, but then populating the elements with TAutomationStringGridItem object pointers. SafeArrayPutElement() requires you to pass it a value that matches the type of the array (which in your code would be a pointer to a VARIANT whose value will then be copied). So it makes sense that UIAutomation would not be able to use your malformed array when initializing the IUIAutomationElementArray for the client app.

Try something more like this instead:

type
  TAutomationStringGridItem = class(TInterfacedObject, IRawElementProviderSimple, IValueProvider, ...)
    ...
  public
    constructor Create(AGrid: TAutomationStringGrid; ARow, ACol: Integer; const AValue: string);
    ...
  end;

constructor TAutomationStringGridItem.Create(AGrid: TAutomationStringGrid; ARow, ACol: Integer; const AValue: string);
begin
  ...
  Self.Row := ARow;
  Self.Column := ACol;
  Self.Value := AValue;
  ...
end;

function TAutomationStringGrid.get_CanSelectMultiple(out pRetVal: BOOL): HResult;
begin
  pRetVal := False;
  Result := S_OK;
end;

function TAutomationStringGrid.get_IsSelectionRequired(out pRetVal: BOOL): HResult;
begin
  pRetVal := False;
  Result := S_OK;
end;

function TAutomationStringGrid.GetSelection(out pRetVal: PSafeArray): HResult;
var
  intf: IRawElementProviderSimple;
  unk: IUnknown;
  outBuffer : PSafeArray;
  offset, iRow, iCol : integer;
begin
  // get the current selected cell, if any...
  iRow := Self.Row;
  iCol := Self.Col;

  // is a cell selected?
  if (iRow > -1) and (iCol > -1) then
  begin
    // yes...
    intf := TAutomationStringGridItem.Create(Self, iRow, iCol, Self.Cells[iCol, iRow]);
    outBuffer := SafeArrayCreateVector(VT_UNKNOWN, 0, 1);
  end else
  begin
    // no ...

    // you would have to check if UIA allows you to return a nil
    // array, possibly with S_FALSE instead of S_OK, so as to
    // avoid having to allocate memory for an empty array...
    {
    // pRetVal is already nil because of 'out'...
    Result := S_FALSE; // or S_OK if S_FALSE is not allowed...
    Exit;
    }

    outBuffer := SafeArrayCreateVector(VT_UNKNOWN, 0, 0);
  end;

  if outBuffer = nil then
  begin
    Result := E_OUTOFMEMORY;
    Exit;
  end;

  if intf <> nil then
  begin
    offset := 0;
    unk := intf as IUnknown;
    Result := SafeArrayPutElement(outBuffer, offset, unk);
    if Result <> S_OK then
    begin
      SafeArrayDestroy(outBuffer);
      Exit;
    end;
  end;

  pRetVal := outBuffer;
end;

With that said, TStringGrid supports multi-selection, and the output of GetSelection() is expected to return an array of all selected items. So a more accurate implementation would look more like this instead:

function TAutomationStringGrid.get_CanSelectMultiple(out pRetVal: BOOL): HResult;
begin
  pRetVal := goRangeSelect in Self.Options;
  Result := S_OK;
end;

function TAutomationStringGrid.get_IsSelectionRequired(out pRetVal: BOOL): HResult;
begin
  pRetVal := False;
  Result := S_OK;
end;

function TAutomationStringGrid.GetSelection(out pRetVal: PSafeArray): HResult;
var
  intfs: array of IRawElementProviderSimple;
  unk: IUnknown;
  outBuffer : PSafeArray;
  offset, iRow, iCol: Integer;
  R: TGridRect;
begin
  // get the current range of selected cells, if any...
  R := Self.Selection; 

  // are any cells selected?
  if (R.Left > -1) and (R.Right > -1) and (R.Top > -1) and (R.Bottom > -1) then
  begin
    // yes...
    SetLength(intfs, ((R.Right-R.Left)+1)*((R.Bottom-R.Top)+1));
    offset := Low(intfs);
    for iRow := R.Top to R.Bottom do
    begin
      for iCol := R.Left to R.Right do
      begin
        intfs[offset] := TAutomationStringGridItem.Create(Self, iRow, iCol, Self.Cells[iCol, iRow]);
        Inc(offset);
      end;
    end;
  end;

  // you would have to check if UIA allows you to return a nil
  // array, possibly with S_FALSE instead of S_OK, so as to
  // avoid having to allocate memory for an empty array...
  {
  if Length(intfs) = 0 then
  begin
    // pRetVal is already nil because of 'out'...
    Result := S_FALSE; // or S_OK if S_FALSE is not allowed...
    Exit;
  end;
  }

  outBuffer := SafeArrayCreateVector(VT_UNKNOWN, Low(intfs), Length(intfs));
  if outBuffer = nil then
  begin
    Result := E_OUTOFMEMORY;
    Exit;
  end;

  for offset := Low(intfs) to High(intfs) do
  begin
    unk := intfs[offset] as IUnknown;
    Result := SafeArrayPutElement(outBuffer, offset, unk);
    if Result <> S_OK then
    begin
      SafeArrayDestroy(outBuffer);
      Exit;
    end;
  end;

  pRetVal := outBuffer;
  Result := S_OK;
end;