Firemonkey Grid Control - Styling a Cell based on a value (via the OnGetValue function call)

Question

I am looking for recommended solution to style a TGrid cell that is being drawn by the OnGetValue call (that is called to paint the cells in view). For background, an excellent response by Mike, showed how to simply apply a tAlign property when the cell is created; but my next challenge is colouring the cell contents.

Previous posting/answer

The objective is to change the cell attributes (Font, style, colour etc...) of the value I am about to return as the cell "Value". In the example below; it would be applying a style to the OnGetValue "value" that is being returned. It may well be that we have to do this via a FM Stylesheet; or can we get directly to the TText attributes? Ideally, both scenarios would be great - but at this stage I will take either solution... (;->

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Objects, FMX.Grid,
  FMX.Layouts, FMX.Edit;

type
  TForm1 = class(TForm)
    Grid1: TGrid;
    Button1: TButton;
    StyleBook1: TStyleBook;
    procedure Grid1GetValue(Sender: TObject; const Col, Row: Integer;
      var Value: Variant);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TStringColNum = class(TStringColumn)
  private
    function CreateCellControl: TStyledControl; override;
  published
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

function TStringColNum.CreateCellControl: TStyledControl;
begin
  Result:=TTextCell.Create(Self);
  TTextCell(Result).TextAlign := TTextAlign.taTrailing;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Grid1.AddObject(TStringColumn.Create(Self));
  Grid1.AddObject(TStringColNum.Create(Self)); // Right Aligned column?

  Grid1.RowCount:=5000;
  Grid1.ShowScrollBars:=True;
end;

procedure TForm1.Grid1GetValue(Sender: TObject; const Col, Row: Integer;
  var Value: Variant);
begin
  if Col=0 then
    Value:='Row '+IntToStr(Row);

  if Col=1 then
    Value := 'Row '+IntToStr(Row);

// Apply style based on value ?

end;

end.

Many thanks in advance, Ian.

Answer 1

Firstly, an apology. In my answer to your last question, CreateCellControl should have called inherited to create the cell. I've amended my answer.

As for this question, I've uploaded my blog posting on FireMonkey Cells - http://monkeystyler.com/blog/entry/firemonkey-grid-basics-custom-cells-and-columns - it covers the stuff from the previous answer, and also covers creating custom cell controls. You'll need to read that before your proceed. I'll wait.

...

Back now? Good.

Following on from the example in the blog post.

Except, that I've updated the TFinancialCell to inherit directly from TTextCell (which of course is a TEdit), which makes far more sense and is far simpler to style.

So, update the TFinancialCell:

type TFinancialCell = class(TTextCell)
  private
    FIsNegative: Boolean;
    FIsImportant: Boolean;
  protected
    procedure SetData(const Value: Variant); override;
    procedure ApplyStyle;override;
    procedure ApplyStyling;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property IsNegative: Boolean read FIsNegative;
    property IsImportant: Boolean read FIsImportant;
  end;

Code for the above:

procedure TFinancialCell.ApplyStyle;
var T: TFMXObject;
begin
  inherited;
  ApplyStyling;
end;

procedure TFinancialCell.ApplyStyling;
begin
  if IsNegative then
    FontFill.Color := claRed
  else
    FontFill.Color := claBlack;
  Font.Style := [TFontStyle.fsItalic];
  if IsImportant then
    Font.Style := [TFontStyle.fsBold]
  else
    Font.Style := [];
  if Assigned(Font.OnChanged) then
    Font.OnChanged(Font);
  Repaint;
end;

constructor TFinancialCell.Create(AOwner: TComponent);
begin
  inherited;
  TextAlign := TTextAlign.taTrailing;
end;

procedure TFinancialCell.SetData(const Value: Variant);
var F: Single;
  O: TFMXObject;
  S: String;
begin
  S := Value;
  FIsImportant := S[1] = '#';
  if IsImportant then
    S := Copy(Value,2,MaxInt)
  else
    S := Value;

  F := StrToFloat(S);
  inherited SetData(Format('%m', [F]));
  FIsNegative := F < 0;
  ApplyStyling;
end;

And finally, update the GetValue event handler:

procedure TForm1.Grid1GetValue(Sender: TObject; const Col, Row: Integer;
  var Value: Variant);
var Cell: TStyledControl;
begin
  if Col = 0 then
    Value := Row
  else if Col = 1 then
  begin
    Value := FloatToStr(Data[Row]);
    if Value > 30 then
      Value := '#'+Value;
  end;
end;

Answer 2

Code above is fine for versions before XE4, but for XE4 and XE5 does not work. Color and style of text is not changed.

This is a fixed code for XE4 and XE5:

procedure TFinancialCell.ApplyStyling;
begin
  StyledSettings := [TStyledSetting.ssFamily, TStyledSetting.ssSize];
  if IsNegative then
    FontColor := claRed
  else
    FontColor := claBlack;
  Font.Style := [TFontStyle.fsItalic];
  if IsImportant then
    Font.Style := [TFontStyle.fsBold]
  else
    Font.Style := [];
  if Assigned(Font.OnChanged) then
    Font.OnChanged(Font);
  Repaint;
end;