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.

Posted in FMX Tagged with: , , ,
6 comments on “Extending the FireMonkey TStringGrid
  1. cesarliws says:

    What about a screenshot?

  2. Jon Souter says:

    Many thanks for posting this – good to have such a decent walk-through on extending an existing FireMonkey control.

  3. I think your blog somehow ate the private section of the class declaration.

  4. andrew says:

    Roger, how to sort a Firemonkey TStringGrid? Could you help me, please?

  5. Roger says:

    I was hoping that TMS would have their grid out soon and I could let them do the sorting work but it seems to be at least six months away.

    I would approach sorting by creating a TStringlist (SL) and setting its sort parameters to Sort, Allow All and the desired case sensitivity. If you then add all the text from the chosen column as SL.AddObject(Cell[Col,Row] ,TObject(Row)) where Row steps from FixedRows to highest Row you will then have the new order. Turn off sorting (SL.sorted:=false) and for each column put all Column data into the string list in the new order
    SL[Row-FixedRows]:=Cell[Col,Integer(SL.Object[Row-FixedRows]]
    then write it back
    Cell[Col,Row]:= SL[Row-FixedRows].
    If you had the object array shown in my code you would then need to resort that also.

    But the Firemonkey StringGrid does not have a fixed rows concept yet and the TMS Grid allows you to sort up and sort down and revert back to the original order all driven by clicks on the fixed row. TMS grid also has so much more functionality I guess I can see why it might take some time just to decide how to approach designing a Firemonkey AdvancedStringGrid.