TstringGrid read cell color [solved]

[rnervi]

I've been able to colour a cell backgrund using the related event.
I wonder theres is no way to read a single cell Canvas.Brush.Color (as has been settled in the code).
Is there or not a way to read cell colour ?

[wp]

No, the grid in its current implementation does not handle individual cell colors. Nevertheless it is possible to change colors by code in the OnPrepareCanvas or OnDrawCell events - but this is your code, and you are the only one how knows why this and that color has been used here and there.

[Xenno]

I don't believe that approach is feasible. Cells aren't independent objects; they are simply rectangles rendered within the grid. Since the Canvas belongs to the grid, we must maintain a reference for each cell to track its state—such as its assigned color—or how we determined its color.

[rnervi]

tryied this way:

while scanning all cells (rows/col) I'm looking 1 pixel inside the rect, and reading one pixel I get the "cell background color"

Code: Pascal  [Select][+][-]

1. var
2.      rett: trect;
3.  
4. rett := grd.CellRect(Col, Row);
5.  
6.             CellColor := n1.Canvas.Pixels[rett.Left + 1, rett.Top -1];

//n1 is the stringgrid component

In this way I can have the "cell color" based on a single pixel 

[rnervi]

but only if the TstringGrid is "onScreen"

[rnervi]

why not component implement a "single cell property" (like the tag) with "canvas color" settle after the OnDrawcell / on preparecanvas....

[wp]

Here is some kind of "advanced" solution taking advantage of the internal structure of the grid. The grid works internally with a TVirtualGrid containing pointers to TCellProps records, and these records contain elements for the cell text, the cell data as well as cell attributes :

Code: Pascal  [Select][+][-]

1. type
2.   PCellProps= ^TCellProps;
3.   TCellProps=record
4.     Attr: pointer;
5.     Data: TObject;
6.     Text: pchar;
7.   end;

The Attr pointer is not used and is available to store cell background and text foreground colors:

Code: Pascal  [Select][+][-]

1. type
2.   TCellAttr = record
3.     BkColor: TColor;
4.     TxtColor: TColor;
5.   end;
6.   PCellAttr = ^TCellAttr;

We implement properties CellBkColor[ACol, ARow]: TColor and CellTxtColor[ACol, ARow] and for this purpose we access the internal virtual grid introduced in TCustomDrawGrid as FGrid. And this virtual grid has a property to access the pointers to the TCellProps records, named Celda[ARow, ACol]: PCellProps ("celta" = Portuguese for "cell").

This is the getter for CellBkColor (that for CellTxtColor is similar): It reads the CellProps records and the Attr record to get the field with the background color of the specified cell (when the pointer to them are nil, the default grid Color is returned)

Code: Pascal  [Select][+][-]

1. function TStringGrid.GetCellBkColor(ACol, ARow: Integer): TColor;
2. var
3.   C: PCellProps;
4. begin
5.   Result := Color;
6.   C:= FGrid.Celda[ACol, ARow];
7.   if (C = nil) or (C^.Attr = nil) then
8.     Result := Color
9.   else
10.     Result := PCellAttr(C^.Attr)^.BkColor;
11. end;

and the setter for it: it allocates a new CellProps and within it an Attrib record in which the new background color can be stored:

Code: Pascal  [Select][+][-]

1. procedure TStringGrid.SetCellBkColor(ACol, ARow: Integer; AValue: TColor);
2. var
3.   C: PCellProps;
4. begin
5.   C := FGrid.Celda[ACol, ARow];
6.   if C <> nil then
7.   begin
8.     if C^.Attr = nil then
9.     begin
10.       New(PCellAttr(C^.Attr));
11.       PCellAttr(C^.Attr)^.BkColor := Color;
12.       PCellAttr(C^.Attr)^.TxtColor := Font.Color;
13.     end;
14.     if AValue <> PCellAttr(C^.Attr)^.BkColor then
15.       PCellAttr(C^.Attr)^.BkColor := AValue;
16.     UpdateCell(ACol, ARow);
17.     Modified := True;
18.   end else
19.   begin
20.     New(C);
21.     New(PCellAttr(C^.Attr));
22.     PCellAttr(C^.Attr)^.BkColor := AValue;
23.     PCellAttr(C^.Attr)^.TxtColor := Font.Color;
24.     C^.Text := nil;
25.     C^.Data := nil;
26.     FGrid.Celda[ACol, ARow] := C;
27.     UpdateCell(ACol, ARow);
28.     Modified := True;
29.   end;
30. end;

With these new properties

Code: Pascal  [Select][+][-]

1.     property CellBkColor[ACol, ARow: Integer]: TColor read GetCellBkColor write SetCellBkColor;
2.     property CellTxtColor[ACol, ARow: Integer]: TColor read GetCellTxtColor write SetCellTxtColor;

the cell background and text colors can be defined as simply as

Code: Pascal  [Select][+][-]

1. procedure TForm1.FormCreate(Sender: TObject);
2. begin
3.   StringGrid1.CellBkColor[1, 1] := clYellow;
4.   StringGrid1.CellTxtColor[2, 1] := clRed;
5. end;

But: this is not yet the whole story. We must provide a way to apply the new colors when the cell is painted, and we must make sure that the memory allocated for the TCellAttr record is disposed when the cell is destroyed:

For application of the colors in the Attr field we hook into the PrepareCanvas mechanism. PrepareCanvas is called immediately before a cell is painted. We must check whether a cell stores colors inside the virtual grid and must extract these colors and set them to the grid's canvas:

Code: Pascal  [Select][+][-]

1. procedure TStringGrid.PrepareCanvas(ACol, ARow: Integer; AState:TGridDrawState);
2. var
3.   C: PCellProps;
4.   savedHandler: TOnPrepareCanvasEvent;
5.   isSelected: Boolean;
6. begin
7.   savedHandler := OnPrepareCanvas;
8.   try
9.     OnPrepareCanvas := nil;
10.     inherited;
11.     GetSelectedState(AState, isSelected);
12.     C := FGrid.Celda[ACol, ARow];
13.     if (C <> nil) and not isSelected then
14.     begin
15.       Canvas.Brush.Color := GetCellBkColor(ACol, ARow);
16.       Canvas.Font.Color := GetCellTxtColor(ACol, ARow);
17.     end;
18.   finally
19.     OnPrepareCanvas := savedHandler;
20.     DoPrepareCanvas(ACol, ARow, AState);
21.   end;
22. end;

Next point: The internal grid must take care of disposing the memory allocated for the Attr field. The virtual grid has a method DisposeCell called whenever a cell is destroyed, and this is where we can dispose the memory:

Code: Pascal  [Select][+][-]

1. procedure TCellAttrVirtualGrid.DisposeCell(var P: PCellProps);
2. begin
3.   if Assigned(P) and Assigned(P^.Attr) then Dispose(PCellAttr(P^.Attr));
4.   inherited;
5. end;

This is an overridden virtual method and implemented in a derived class, TCellAttrVirtualGrid. Of course, the StringGrid must be told to create this modified virtual grid instead of its default one - otherwise the new DisposeCell would never be called. But luckily the grid has a method CreateGrid where the virtual grid is created, and here we can create the TCellAttrVirtualGrid instead of the default one:

Code: Pascal  [Select][+][-]

1. function TStringGrid.CreateVirtualGrid: TVirtualGrid;
2. begin
3.   Result := TCellAttrVirtualGrid.Create;
4. end;

Yes, that's all (well -- mostly, except for a helper which I dropped here for clarity). The important point left is: we need to subclass the TStringGrid in order to put all this in its correct place. Subclassing can be done by giving the StringGrid class a new name, e.g. TColoredStringGrid, or by descending the new StringGrid from Grids.TStringGrid in the same unit of the form where it is used (alternatively the code can also be put into a separate unit, but that must be used at the end of the "uses" line).

The entire (tested) code is in the attachment. You can easily extend it to add other attributes to the TCellAttr record (e.g. text alignment, font styles, line-break, ...)

[EDIT]
I committed an extended version of this sample project to the examples/gridexamples/attribute_grid folder of Lazarus/main. Just copy the unit "attrgrid.pas" from that folder to your project and list its name at the end of the "uses" clause, and you have the new feature that cell attributes such as font (size, name, color, style), text alignment, word-break and backgroundcolor can be accessed simply by properties:

Examples:

Code: Pascal  [Select][+][-]

1.   StringGrid1.CellBkColor[3, 3] := clYellow;
2.   StringGrid1.CellAlignment[4, 4] := taRightJustify;
3.   StringGrid1.CellWordWrap[4, 4] := true;
4.   MyColor := StringGrid1.CellBkColor[3, 3];

[hedgehog]

I implemented it like this

Code: Pascal  [Select][+][-]

1. type
2.  
3.   { TStringGridCellColorHelper }
4.  
5.   TStringGridCellColorHelper = class helper for TStringGrid
6.     function GetCellColor(aCol, aRow: Integer): TColor;
7.     procedure SetCellColor(aCol, aRow: Integer; C: TColor);
8.   end;
9.  
10. ..............
11.  
12. { TStringGridCellColorHelper }
13.  
14. function TStringGridCellColorHelper.GetCellColor(aCol, aRow: Integer): TColor;
15. var
16.   P: PtrInt;
17. begin
18.   Result:= clDefault;
19.   P:= PtrInt(Objects[aCol, aRow]);
20.   if P <> 0 then
21.     Result:= TColor(P shr 1);  
22. end;
23.  
24. procedure TStringGridCellColorHelper.SetCellColor(aCol, aRow: Integer; C: TColor);
25. var
26.   P: PtrInt;
27. begin
28.   if (C = clDefault) then P:=0
29.   else P:= (ColorToRGB(C) shl 1) or 1;
30.   Objects[aCol, aRow]:= TObject(P);
31. end;  
32.  

[rnervi]

gr8 thanks to all submitter

[Josh]

i had similar task a few years ago, cant find wat i done in the end, cant even remember the utility i wrote it for but, if memory serves.
i called the PrepareCanvas event directly(eliminates the grid not calling it on non-visible cells); then reading color.
all my coloring alignment etc was done in PrepareCanvas
something like

Code: Pascal  [Select][+][-]

1. StringGrid1.PrepareCanvas(2, 500, []);
2. CellColor:=StringGrid1.Canvas.Brush.Color;

not saying its perfect..