How to create an multiple colored Stringgrid ? / How to draw in a StringGrid-Cell ?

Mirror

How to create an multiple colored Stringgrid ? / How to draw in a StringGrid-Cell ? (Views: 707)

Problem/Question/Abstract:

The standard Delphi-StringGrid can only hold one color for all cells. How to create an multiple colored Stringgrid ?

Answer:

I's easier than you assumed. You must simply override the DrawCell and manuelly draw some data on the canvas of the Stringgrid-Cell .

Feel free to copy and reuse this sweet tiny component....

I hope this article is helpful for you ....

TBWStringGrid = class(TStringGrid)
private
protected
  procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
    AState: TGridDrawState); override;
public
  { just hold some data for each cell }
  CellColor: array of array of TColor;
  CellFontColor: array of array of TColor;
  CellData: array of array of REAL;
  procedure RebuildDynColorArray; // net gut !!!!
  procedure ResizeGrid(ColCount: Integer; RowCount: Integer; ClearAllFields: Boolean =
    TRUE);
  procedure ResetGridCellData;
  procedure ResetGrid;
  procedure UnselectAll;
published
end;

function InvertColor(Color: TColor): TColor;

{ TBWStringGrid }

//>Created at 05-Jul-2002 (14:12:19 ) by benjamin wittfoth
  procedure TBWStringGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
    AState: TGridDrawState);
  begin
    inherited;
    if CellColor[ACol, ARow] = clBlack then
      EXIT;
    with Canvas do
    begin
      if (gdSelected in AState) then
      begin // wenn selektiert -> INVERTIEREN
        Font.Color := InvertColor(CellFontColor[ACol, ARow]);
        Brush.Color := InvertColor(CellColor[ACol, ARow]);
      end
      else
      begin // Ansonsten nicht !
        Brush.Color := CellColor[ACol, ARow];
        Font.Color := CellFontColor[ACol, ARow];
      end;
      Brush.Style := bsSolid;
      FillRect(ARect);
      TextRect(ARect, ARect.left + 2, ARect.top + 2, Cells[ACol, ARow]);
    end;
  end;

  //>Created at 05-Jul-2002 (14:56:33 ) by benjamin wittfoth
  procedure TBWStringGrid.RebuildDynColorArray;
  begin
    SetLength(CellColor, ColCount, RowCount);
    SetLength(CEllFontColor, ColCount, RowCount);
    SetLength(CellData, ColCount, RowCount);
  end;
  //>Created at 10-Jul-2002 (08:11:25 ) by benjamin wittfoth
  procedure TBWStringGrid.ResizeGrid(ColCount: Integer; RowCount: Integer;
    ClearAllFields: Boolean = TRUE);
  begin
    Self.RowCount := RowCount;
    Self.ColCount := ColCount;
    RebuildDynColorArray;
    if ClearAllFields then
      ResetGrid;
  end;
  //>Created at 10-Jul-2002 (08:11:29 ) by benjamin wittfoth
  procedure TBWStringGrid.ResetGridCellData;
  var
    X, Y: Integer;
  begin
    for Y := 0 to RowCount - 1 do
      for X := 0 to ColCount - 1 do
        CellData[X, Y] := 0;
  end;
  //>Created at 09-Jul-2002 (16:54:43 ) by benjamin wittfoth
  procedure TBWStringGrid.ResetGrid;
  var
    X, Y: Integer;
  begin
    for Y := 0 to RowCount - 1 do
    begin
      for X := 0 to ColCount - 1 do
      begin
        CellData[X, Y] := 0;
        CellColor[X, Y] := clWhite;
        CellFontColor[X, Y] := clBlack;
        Cells[X, Y] := '';
      end;
    end;
  end;

  //>Created at 09-Jul-2002 (11:08:35 ) by benjamin wittfoth
  procedure TBWStringGrid.UnselectAll;
  var
    ARect: TGridRect;
  begin
    ARect.Left := 0;
    ARect.Top := 0;
    ARect.Right := 0;
    ARect.Bottom := 0;
    Selection := ARect;
  end;

  function InvertColor(Color: TColor): TColor;
  begin
    case Color of
      clAqua: RESULT := clTeal;
      clBlack: RESULT := clWhite;
      clBlue: RESULT := clMaroon;
      clDkGray: RESULT := clFuchsia;
      clFuchsia: RESULT := clDkGray;
      //    clGray      : RESULT:=clPurple;
      clGreen: RESULT := clRed;
      clLime: RESULT := clSilver; //clYellow;
      clLtGray: RESULT := clLime;
      clMaroon: RESULT := clOlive; //clBlue;
      clNavy: RESULT := clNavy;
      clOlive: RESULT := clMaroon; //clNavy;
      clPurple: RESULT := clGray;
      clRed: RESULT := clYellow; //clGreen;
      //    clSilver    : RESULT:=clLtGray;
      clTeal: RESULT := clAqua;
      clWhite: RESULT := clBlack;
      clYellow: RESULT := clRed; //clLime;
    end;
  end;

<< Back to main page