Extending the FireMonkey TStringGrid

While porting my VCL applications to FireMonkey I needed to find a replacement for the TAdvStringGrid from TMS software and so decided to try building my own custom TStringGrid. I was only looking for a stop gap minimal implementation as I expect (hope) that TMS will soon deliver FireMonkey versions of their grid components.

I used the example provided by Embarcadero as a guide to the component design and the TIsAdvStringGrid was born. In this instance I did not require to change the style handling of the base component so the style discussion of the document was ignored and no GetStyleObject function provided.

The full code is available in the zip of my converter download but the main points are

Step one: Create and Object Interface section inheriting from a current FMX Object (in this case TStringGrid) and add the extra properties and functionality required.

TISAdvStringGrid = class(TStringGrid)
  private
      >>
  protected
    { Protected declarations }
    //function GetStyleObject: TControl; override;
  public
    { Public declarations }
    function FindFirst(ASearchText: String; AMatchStates: TFindParams) : TGridCell;
    function ObjectSelected:TObject;
    procedure ClearAll;
    procedure AutoSizeColumns(ADoFixed: Boolean; APadding: Real);
    procedure AutoSizeRows(ADoFixed: Boolean; APadding: Real);
  published
    { Published declarations }
    property ColumnCount: integer read GetColumnCount write SetColumnCount;
    property OneDObjectArray: TArrayofObjects read FOneDObjectArray write SetOneDObjectArray;
    property TwoDObjectArray: TTwoDArrayofObjects read FTwoDObjectArray write SetTwoDObjectArray;
  end;

Step Two: Register the New Object

procedure Register;

implementation

uses
  Types;

procedure Register;
begin
  RegisterComponents('Innova Solutions', [TISAdvStringGrid]);
end;

Step Three: Fill Out the New Functions and Properties

In my case the AutoSizeColumns and AutoSizeRows functions were dummies provided as stubs to maintain other code until TMS (hopefully) provide the real thing. SetColumnCount and ClearAll however required an insight into the differences between a VCL TStringGrid and the very different FireMonkey Version.

{ TISAdvStringGrid }

function TISAdvStringGrid.GetColumnCount: integer;
begin
  Result := inherited ColumnCount;
end;

function TISAdvStringGrid.ObjectSelected: TObject;
Var
  Row,Col:integer;
  ObjMaxRow,ObjMaxCol:Integer;
begin
  Result:=nil;
  ObjMaxCol:=-1;
  ObjMaxRow:=High(FTwoDObjectArray);
  if ObjMaxRow<0 then
     ObjMaxRow:=High(FOneDObjectArray)
    Else
     ObjMaxCol:=High(FTwoDObjectArray[0]);
  if ObjMaxRow<0 then Exit;

  Row:=Selected;
  If Row<0 then exit;
  if Row>ObjMaxRow then exit;

  if ObjMaxCol<0 then
     Result:=FOneDObjectArray[Row]
   else
   begin
     Col:=ColumnIndex;
     if Col<0 then exit;

     if Col>ObjMaxCol then Exit;

     Try
     Result:=FTwoDObjectArray[Row,Col];
     Except
      Result:=nil;
     End;
   end;
end;

procedure TISAdvStringGrid.SetColumnCount(const Value: integer);
Var
  i, CurrentCount: integer;
  NxtColunm: TStringColumn;
begin
  CurrentCount := ColumnCount;
  if Value < CurrentCount then
    For i := CurrentCount - 1 Downto Value - 1 do
      ColumnByIndex(i).Free
  else
    For i := CurrentCount + 1 to Value do
    begin
      NxtColunm := TStringColumn.Create(Self);
      AddObject(NxtColunm);
    end;
end;

procedure TISAdvStringGrid.AutoSizeColumns(ADoFixed: Boolean; APadding: Real);
begin
   //Dummy
end;

procedure TISAdvStringGrid.AutoSizeRows(ADoFixed: Boolean; APadding: Real);
begin
  //Dummy
end;

procedure TISAdvStringGrid.ClearAll;
var
  i: integer;
  Obj: TFmxObject;
begin
  if (FContent <> nil) and (FContent.ChildrenCount > 0) then
    for i := FContent.ChildrenCount - 1 Downto 0 do
      if FContent.Children[i] is TColumn then
      begin
        Obj := FContent.Children[i];
        FContent.RemoveObject(Obj);
        Obj.Free;
      end;
end;

Step Four: Include in a Package File and install in the IDE

requires
  rtl,
  fmx;
contains
  IsAdvStringGrid in 'IsAdvStringGrid.pas'

There were no instructions on adding the component graphic to use on the pallet. I did make a token effort using what I recalled from doing VCL components years ago but had no success and it seems less important with the current pallet layout.