StringGrid Row Coloring 2

[PaidtheUmpire]

Is there a way of getting a StringGrid to color a row. For example... if the number in [4,n] is below 100 then shade the "n" row light red.

Any ideas how to do it?

Delphi I can't get enough of you.

 

[gcaramia]

1)Set the DefaultDrawing of the DBGrid to false

2)Use the OnDrawColumnCell event and type in:

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
   if Table1.FieldByName('Salary').Value < 100 then
    DBGrid1.Canvas.Font.Color := clRed;
  DBGrid1.DefaultDrawDataCell(Rect,dbgrid1.Columns[datacol].Field, State);

end;

Giovanni Caramia

 

[sggaunt]

The principle is the same for a Tstringgrid.
except the method is ondrawcell
this places 'text' a string into the coloured row.
'reqdrow' is the row you want to colour.
copy the values of the 'row' parameter passed into the procedure into a local 'r'.

if r = reqdrow then
begin
canvas.brush.color := clred;
canvas.fillrect(rect);
end;
canvas.textout(rect.left + 2, rect.top + 2,text);

Steve

Life is like a Grapefruit, sort of orangey-yellow and dimpled on the outside, wet and squidgy in the middle, it's got pips inside too. Oh and some people have half a one for breakfast. Ford Prefect.

Want to do more with TGML Download Star

 

[PaidtheUmpire]

Thanks guys,

Steve is it possible to get the actual code, as I can't get the thing to work.

It just places the value of the cell checked into all the row.

Delphi I can't get enough of you.

 

[sggaunt]

Ok this is the full procedure maybe I simplified it a bit too much.
Its looking for a '*' in each line of the stringlist 'list' that is the source of the Cell text.
If there is a '*' in the text it colours the cell in the error colour (red).

To improve this what you can do is create an object related to the grid cells, and assign a colour property to this.
The grid can then then store its own colour values, you can get lots of fancy effects. But careful coding is required!!

Look at the object property of a string grid in the help.

This is a quick and dirty way of doing it, I don't even bother to strip off the markers.

[COLOR=#0000FF #FFFFFF]
procedure TEmergiForm.emergidataDrawCell(Sender: TObject; Col,
  Row: Integer; Rect: TRect; State: TGridDrawState);
var count, r: integer;
begin
   r := row;  // Copy variable 'row' as it only  seems to be valid for a short time
   Count :=  (Row - 1) * emergidata.colcount + Col;
   if (count > 0) and (count <= list.count) then
   with (sender as tstringgrid) do
   begin
      if state = [] then  // dont overwrite fixed areas
        begin
           if R  = Foundrow then
               canvas.brush.color := FindColour
           else
              begin
                 if pos('*',list.strings[count]) <> 0 then

                     begin
                         canvas.brush.color := ErrorColour;//clRed;
                        canvas.font.color := clwhite;
                     end
                 else
                     begin
                        canvas.brush.color := OKColour;//clwindow;
                     end;
              end;
          canvas.fillrect(rect);
          canvas.textout(rect.left + 2, rect.top + 2,list.strings[count]);
       end;
  end;

[/color]

Steve

Life is like a Grapefruit, sort of orangey-yellow and dimpled on the outside, wet and squidgy in the middle, it's got pips inside too. Oh and some people have half a one for breakfast. Ford Prefect.

Want to do more with TGML Download Star

 

[Zathras]

The thing that makes this tricky is the fact that you want to color an entire row based on the contents of the cell, while Delphi only wants to color one cell at a time.

One way to do it is to force Delphi to repaint the entire grid every time it is likely that the user has changed a value in your trigger column. This is done by using the .Invalidate method in the three cases where it is necessry:
1. Pressing the enter key.
2. Selecting a different cell (mouse or arrow key)
3. Tabbing to a different component.

The OnDrawCell event should only be used to update the indicated cell. If you update another cell while processing the OnDrawCell event you could very easily set up an infinite loop.

Here is some code to experiment with:

unit Unit1;

interface

uses
  Windows, SysUtils, Classes, Graphics, Controls, Forms,
  StdCtrls, Grids;

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    Edit1: TEdit;
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);
    procedure StringGrid1Exit(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;


var
  Form1: TForm1;


implementation


{$R *.DFM}

{ Constants to specify what column/value/color to control grid row coloring.}
const
  TRIGGER_COLUMN    = 4;
  TRIGGER_VALUE     = 100;
  TRIGGER_COLOR     = clWhite;
  TRIGGER_BACKCOLOR = clRed;

{ Put specified text in the indicated TRect with the designated colors.}
procedure ColorCell( Canvas:TCanvas; Rect:TRect; Text:string;
     TextColor:TColor; Background:TColor );
var
  zSaveForegroundColor,zSaveBackgroundColor:TColor;
begin
  with Canvas do
    begin
      zSaveForegroundColor := Font.Color;
      zSaveBackgroundColor := Brush.Color;
      Font.Color := TextColor;
      Brush.Color := Background;
      TextRect( Rect, Rect.Left+2, Rect.Top+2, Text );
      Font.Color  := zSaveForegroundColor;
      Brush.Color := zSaveBackgroundColor;
    end;
end;

{ Color the cell according to the trigger column in that row.}
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  if (ACol > 0) and (ARow > 0) then
    with Sender as TStringGrid do
      if StrToIntDef(Cells[TRIGGER_COLUMN,ARow],999) < TRIGGER_VALUE then
        ColorCell( Canvas, Rect, Cells[ACol,ARow], TRIGGER_COLOR, TRIGGER_BACKCOLOR );
end;

{ Repaint the grid if the user selects a different cell.}
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
begin
  TStringGrid(Sender).Invalidate;
end;

{ Repaint the grid if the user presses the Enter key.}
procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
begin
  if Key = Char(13) then
    TStringGrid(Sender).Invalidate;
end;

{ Repaint the grid if the user tabs away.}
procedure TForm1.StringGrid1Exit(Sender: TObject);
begin
  TStringGrid(Sender).Invalidate;
end;

end.

 

[PaidtheUmpire]

Is there a way to get multiple colors when the value is in different regions?

This is what i got:

const
  TRIGGER_COLUMN    = 5;
  TRIGGER_UNDER     = 0;
  TRIGGER_LOW       = 100;
  TRIGGER_MID       = 500;
  TRIGGER_TEXTUNDER = clWhite;
  TRIGGER_BACKUNDER = clRed;
  TRIGGER_TEXTLOW   = clWhite;
  TRIGGER_BACKLOW   = clMaroon;
  TRIGGER_TEXTMID   = clBlack;
  TRIGGER_BACKMID   = clMoneyGreen;
  TRIGGER_TEXTHIGH  = clBlack;
  TRIGGER_BACKHIGH  = clTeal;

procedure TPrepaidList.PrepaidGridDrawCell(Sender: TObject; ACol,
  ARow: Integer; Rect: TRect; State: TGridDrawState);
begin

  if (ARow > 0) then
    with Sender as TStringGrid do
      begin
      if StrToIntDef(Cells[TRIGGER_COLUMN,ARow],999) >= TRIGGER_MID then
        ColorCell( Canvas, Rect, Cells[ACol,ARow], TRIGGER_TEXTHIGH, TRIGGER_BACKHIGH );
      if StrToIntDef(Cells[TRIGGER_COLUMN,ARow],999) >= TRIGGER_LOW then
        if StrToIntDef(Cells[TRIGGER_COLUMN,ARow],999) < TRIGGER_MID then
          ColorCell( Canvas, Rect, Cells[ACol,ARow], TRIGGER_TEXTMID, TRIGGER_BACKMID );
      if StrToIntDef(Cells[TRIGGER_COLUMN,ARow],999) >= TRIGGER_UNDER then
        if StrToIntDef(Cells[TRIGGER_COLUMN,ARow],999) < TRIGGER_LOW then
          ColorCell( Canvas, Rect, Cells[ACol,ARow], TRIGGER_TEXTLOW, TRIGGER_BACKLOW );
      if StrToIntDef(Cells[TRIGGER_COLUMN,ARow],999) < TRIGGER_UNDER then
        ColorCell( Canvas, Rect, Cells[ACol,ARow], TRIGGER_TEXTUNDER, TRIGGER_BACKUNDER );
      end;
end;

But currently ALL rows are going Teal and Black (>500 section) Any ideas?

Delphi I can't get enough of you.

 

[sggaunt]

This is just some general stuff, without making a detailed study of your code,
I must stress the importance of making a copy of the Row and Col parameters as these change as the control is drawn (I dont know how this happens but it does) So the value of ARow could be different by the time its gets 16+ lines into the code especialy as you are doing a lot of conversions, it took me ages to figure out what what going on when I first tried this.

Don't know if Zathras would agree with this, but.
For this sort of intensive drawing I would consider using the stringgrid objects array.
The ondraw cell really ought to be as short as possible to avoid problems, the string grid itself holds the text, and the objects can be made to hold the required colour values.

You set this up before the grid is shown, then all ondraw has to do is get the colour value from the cell object, rather than evaluating it on the fly.
You will have to do a bit of oop to achive this.

I have done this quite sucessfully but it was a while ago and I need to remind myself of the details before I post any code.








Steve

Life is like a Grapefruit, sort of orangey-yellow and dimpled on the outside, wet and squidgy in the middle, it's got pips inside too. Oh and some people have half a one for breakfast. Ford Prefect.

Want to do more with TGML Download Star

 

[Zathras]

I'd say it has more to do with coding style than anything else. All of those nested if's make it hard to see and debug the logic.

If you re-write the event handler like this, it should be easier to make it work the way you want it to (this code works):

{ Color a row according to the trigger column in that row.}
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
    function GridValueCase( Value:string ):integer;
    var
      n:integer;
    begin
      n := StrToIntDef( Value,999 );
      if n < TRIGGER_UNDER then Result := TRIGGER_UNDER
      else if n < TRIGGER_LOW then Result := TRIGGER_LOW
      else if n < TRIGGER_MID then Result := TRIGGER_MID
      else Result := -1;
    end;
    procedure DoColor( TextColor, BrushColor: TColor );
    begin
      with Sender as TStringGrid do
        ColorCell( Canvas, Rect, Cells[ACol,ARow], TextColor, BrushColor );
    end;
begin
  if (ACol > 0) and (ARow > 0) then
    with Sender as TStringGrid do
      case GridValueCase( Cells[TRIGGER_COLUMN,ARow] ) of
        TRIGGER_UNDER: DoColor( TRIGGER_TEXTUNDER, TRIGGER_BACKUNDER );
        TRIGGER_LOW  : DoColor( TRIGGER_TEXTLOW,   TRIGGER_BACKLOW   );
        TRIGGER_MID  : DoColor( TRIGGER_TEXTMID,   TRIGGER_BACKMID   );
        else           DoColor( TRIGGER_TEXTHIGH,  TRIGGER_BACKHIGH  );
      end;
end;

 

[Zathras]

PaidTheUmpire: I tried your code again and it worked this time just the way you posted it. I don't know why it didn't work before. Are you still having a problem with it?

Steve: Your post came in while I was testing my revised code so I didn't see it until now. I think the problem with "Row" and "Col" has to do with the poor implementation that Delphi did in D5 when coding the event handler stub. Both "Row" and "Col" were either parameters of the procedure or properties of the TStringGrid depending on how you referenced them. I think that is why they changed the parameter list to use "ARow" and "ACol" in D7. (Don't know about D6 - we skipped that version.)

As to using the Objects array associated with TStringGrid, I suppose that could be an option if the data displayed is static, otherwise you would have to update the all of the objects for a row with every change to a value in the target column. Not sure what that buys you except a few microseconds while the grid is repainting. I don't think it would be noticed with today's fast CPU's. I would rather save usage of the Objects array for other things in the application. Also introducing the use of the Object array makes the code that much more complex when it doesn't have to be.

 

[berty1970]

Steves unavalible at present but he asked me to post this on his behalf..

Generaly I would agree with Zathras, so the missing Row/Col value thing was a delphi bug intresting.

Heres how to do it with objects.
In fact when I dug this out it does do more than just set the colour as you can see.


Declare a class to extend the scope of the string list Tobjects array

type Tspec = class (Tobject)
  bc: tcolor;
  fc: tcolor;
  fontname: string;
  fontsize: integer;
  WordHere: integer;
end;

This proc sets up the grid objects array assigning the new class to it.
could have used a constructor but we don't need to go the whole oop thing.

procedure TWordForm.InitialiseGrid(NewGrid: Boolean);
// create the grid objects
var R,C: integer;
begin
   // make sure we dont try to assign to an uninitalised grid
   if (not newgrid) and (not initalised) then exit;
   with grid do
   for r := 0 to rowcount -1 do
      for c := 0 to colcount -1 do
          begin
             if Newgrid then
             begin
                Objects[c,r] := tspec.create;
                initalised := true;
             end;
             with (objects[c,r] as tspec) do
               begin
                  bc := BackColour;
                  fc := fontcolour;
                  fontname := gridfont;
                  fontsize := 11;
                  WordHere := 0;
               end;
          end;
end;

after we have finished with the grid object array we must destroy it explicitly
this proc does that.

procedure TWordform.FreeGrid;
// clears the associated objects array
var C,R: integer;
begin
   for c := 0 to grid.ColCount -1 do
      for r := 0 to grid.rowcount -1 do
         begin
           grid.Objects[c,r].free;
         end;
   Initalised := false;
end;

how this works in the ondrawcell

procedure TWordForm.GridDrawCell(Sender: TObject; Col, Row: Integer;
  Rect: TRect; State: TGridDrawState);
var R,C: integer;
begin
   R := Row; C:= Col;
   if not initalised then exit; // there will be a horrible crash if we try to do this and
                                // the object array hasnt been created  
   with (sender as Tstringgrid) do
      with canvas do
      try
         // get the drawing parameters from the object array
         // notice there is no testing at all as the grid is drawn
         brush.color := (objects[C,R] as tspec).bc;
         font.Name   := (objects[C,R] as tspec).fontname;
         font.Size   := (objects[C,R] as tspec).fontsize;
         font.Style  := [fsbold];
         font.color  := (objects[C,R] as tspec).fc;
         //dont let the font and background be the same invert the colour bits
         if brush.Color = Font.Color then
            brush.Color := Brush.Color xor $00FFFFFF;
         fillrect(rect);
         textout(rect.left + 4, rect.top + 2, cells[C,R]);
      except
         // smeged up characters will appear in a small font.
         brush.color := clwhite;
         font.Name   := 'Times new roman';
         font.Size   := 6;
         font.Style  := [fsbold];
         font.color  := clblack;
         fillrect(rect);
         textout(rect.left + 4, rect.top + 2, cells[C,R]);
     end;
end;

and loading the data elsewhere in the program.

with (grid.objects[C,R] as tspec) do
       begin
          if (findword mod 20) in [0..19] then
              bc := colours[findword mod 20]   // set the colour for this word
          else
              bc := clblue;

           fc := AnswerColour; // font colour for answers
           fontname := answerfont;
           fontsize := 11;    //answerfont size;
           grid.OnMouseMove := Gridmousemove;
           grid.Repaint;  // now force a call to ondraw
       end

Steve and Bert

a pseudonym for ??????