Delphi multi color value in TStringGrid

Question

I want the currency values in the TStringGrid table to have different color decimals. How can do that?

See f.i, the OnDrawCell event of TStringGrid, described in the Online Help.. — MartynA
i looked online help. but i didnt find any help for multi color grid canvas — zuluman
@zuluman: That's because it is up to the programmer (i.e. you) to implement that yourself. — Andreas Rejbrand
@Martyn if you allow me, I don't think the answer you refer to answers this question. The other one, although indicates where (OnDrawCell) to code, it specifically only concerns the background color. This question asks for color change of the text, and specifically the decimals of a value. As seen from the solution by @Andreas it is much more involved than painting the bg. — Tom Brunberg
Thanks@TomBrunberg, I've re-opened it. Obviously having a bad day. (Btw, I'm sure there must have been a multitde of qs about this) — MartynA

Andreas Rejbrand Andreas Rejbrand · Accepted Answer · 2020-05-17T16:29:59

You need to draw the cells yourself by implementing an OnDrawCell handler.

Something like this:

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  Grid: TStringGrid;
  S: string;
  Val: Double;
  FracVal, IntVal: Integer;
  FracStr, IntStr: string;
  IntW, FracW, W, H: Integer;
  Padding: Integer;
const
  PowersOfTen: array[0..8] of Integer =
    (
      1,
      10,
      100,
      1000,
      10000,
      100000,
      1000000,
      10000000,
      100000000
    );
  Decimals = 2;
  BgColor = clWhite;
  IntColor = clBlack;
  FracColor = clRed;
begin

  Grid := Sender as TStringGrid;

  if (ACol < Grid.FixedCols) or (ARow < Grid.FixedRows) then
    Exit;

  Grid.Canvas.Brush.Color := BgColor;
  Grid.Canvas.FillRect(Rect);

  S := Grid.Cells[ACol, ARow];
  Padding := Grid.Canvas.TextWidth('0') div 2;

  if not TryStrToFloat(S, Val) or not InRange(Val, Integer.MinValue, Integer.MaxValue) then
  begin
    Grid.Canvas.TextRect(Rect, S, [tfSingleLine, tfVerticalCenter, tfLeft]);
    Exit;
  end;

  IntVal := Trunc(Val);
  IntStr := IntVal.ToString;
  if Decimals > 0 then
    IntStr := IntStr + FormatSettings.DecimalSeparator;
  IntW := Grid.Canvas.TextWidth(IntStr);
  FracVal := Round(Frac(Abs(Val)) * PowersOfTen[Decimals]);
  FracStr := FracVal.ToString.PadRight(Decimals, '0');
  if Decimals = 0 then
    FracStr := '';
  FracW := Grid.Canvas.TextWidth(FracStr);
  W := IntW + FracW;
  H := Grid.Canvas.TextHeight(IntStr);

  if W >= Grid.ColWidths[ACol] - 2*Padding then
  begin
    S := '###';
    Grid.Canvas.TextRect(Rect, S, [tfSingleLine, tfVerticalCenter, tfRight]);
  end
  else
  begin
    Grid.Canvas.Font.Color := IntColor;
    Grid.Canvas.TextOut(Rect.Right - Padding - W,
      Rect.Top + Rect.Height div 2 - H div 2, IntStr);
    Grid.Canvas.Font.Color := FracColor;
    Grid.Canvas.TextOut(Rect.Right - Padding - FracW,
      Rect.Top + Rect.Height div 2 - H div 2, FracStr);
  end;

end;

This code will write non-numeric data left-aligned as is. For numeric data, it will draw the values with a fixed number of decimals. You can choose the decimals (0..8), as well as the colours of the integral and fractional parts. If the number doesn't fit in its cell, ### will be displayed instead.

I haven't fully tested the code. I'll leave that to you as an exercise.

Update: Sorry, I forgot you are using Delphi 7. This means that you need to replace IntVal.ToString with IntToStr(IntVal) and so on.

Delphi multi color value in TStringGrid

1 Answers