* * *

Author Topic: How to colour individual cells in a stringgrid  (Read 8275 times)

nitep

  • Newbie
  • Posts: 3
How to colour individual cells in a stringgrid
« on: October 02, 2008, 02:01:41 am »
I want the words 'To be deleted?' in red but they stay black same as all other cells. Code is:-


procedure load_form;
var s:string;

begin
  str(count,s);
  form1.Caption:='Archive files in        '+ mydir+'  '+s+'  files';
  Form1.StringGrid1.rowcount:=count;

  p:=first^.next;
  i:=0;
     repeat
     with p^ do
             with form1.StringGrid1 do
               begin
                Cells[0,i]:=  fName;
                Cells[1,i]:=  show_date(abs(time));
                IF TIME<0 THEN
                   begin
                   
                      { brush.Color := clRed;    // no errors but does not work
                       Canvas.Font.Color := clRed;   // no errors but does not work
                       Font.Color := clRed;  // no errors but does not work
                       Canvas.Brush.Color := clRed;   // no errors but does not work
                       // PrepareCanvas.Color := clRed;   does not work
                       canvas.FillRect(aRect);     // no errors but does not work  }
                       
                       Cells[2,i]:=  'To be deleted?';
                       Font.Color := clblack;  // no errors but does not work
                   end
                    else
                        Cells[2,i]:=  '';
                end;

     i:=i+1;
          p:=p^.next;
   until p=last;

end;    

I have tried each option in the {  } one by one but none work. Any ideas. :shock:

arnoldb

  • Jr. Member
  • **
  • Posts: 96
RE: How to colour individual cells in a stringgrid
« Reply #1 on: October 02, 2008, 08:53:16 am »
You have to use the OnDrawCell event of the stringgrid to change the colour.

Do a search for "delphi stringgrid colour cell" on the web - you'll find many useful samples.

nitep

  • Newbie
  • Posts: 3
How to colour individual cells in a stringgrid
« Reply #2 on: October 03, 2008, 05:53:15 am »
I had tried on draw but the code is never executed

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,unit2,
  Grids;

type

{ TForm1 }

TForm1 = class(TForm)
  Button1: TButton;
  Button2: TButton;
  Label1: TLabel;
  StringGrid1: TStringGrid;
  procedure Button1Click(Sender: TObject);
  procedure Button2Click(Sender: TObject);
  procedure FormCreate(Sender: TObject);
  procedure StringGrid1DrawCell(Sender: TObject; Col, Row: Integer;  Rect: TRect; State: TGridDrawState);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;
  ended,deleted:boolean;
  on_draw_cell_counter       :integer;

implementation

{ TForm1 }
{**************************************************************}
procedure TForm1.StringGrid1DrawCell(Sender: TObject; Col, Row: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  on_draw_cell_counter:=on_draw_cell_counter+1;
  If (gdFixed in State){or (gdSelected in State)} then exit;
  if (Col = 2) and (Row = i) then begin
    stringgrid1.canvas.Brush.Color:=clRed;
    stringgrid1.canvas.FillRect(rect);
//stringgrid1.canvas.textRect(rect,Rect.left+2,rect.top+2,'ZZZZ'{stringgrid1.cells[Col,Row]});
    StringGrid1.Canvas.TextOut(Rect.Left + 2, Rect.Top + 2, 'ZZZZ');
 end;
end;
{**************************************************************}
procedure load_form;
begin
  Form1.StringGrid1.rowcount:=count;
  p:=first^.next;
  i:=0;
      repeat
         with p^ do
            with form1.StringGrid1 do
               begin
                Cells[0,i]:=  fName;
                Cells[1,i]:=  show_date(abs(time));
                IF TIME<0 THEN Cells[2,i]:=  'To be deleted?' else Cells[2,i]:=  '';
                end;
          i:=i+1;
          p:=p^.next;
   until p=last;
end;
{**************************************************************}
procedure TForm1.FormCreate(Sender: TObject);
begin
on_draw_cell_counter:=0;   { to test count how often procedure TForm1.StringGrid1DrawCell is executed}
get_data;
load_form;
end;
{**************************************************************}
procedure TForm1.Button1Click(Sender: TObject);    {end program}
var s:string;
begin
str(on_draw_cell_counter,s);
s:=s+'  in on draw procedure';
ShowMessage (s); {to show how often  procedure TForm1.StringGrid1DrawCell is executed}
close;
end;
{**************************************************************}
procedure TForm1.Button2Click(Sender: TObject); {delete files}
var s:string;
    j:integer;
begin
delete_files(j);
end;
{**************************************************************}
initialization
  {$I unit1.lrs}
end.
{**************************************************************}

arnoldb

  • Jr. Member
  • **
  • Posts: 96
How to colour individual cells in a stringgrid
« Reply #3 on: October 06, 2008, 09:21:52 am »
The following works (as example):

Create a new project with a blank form "form1", add a label "Label1", add a Spinedit "SpinEdit1", and add a stringgrid "StringGrid1".
Set the Rowcount for the StringGrid1 to 10, set the ColumnCount to 4, and add dummy data to the grid.
Set the SpinEdit's MinValue to 1 and MaxValue to 10.

Paste the code below into the form's Implementation section.

Then VERY IMPORTANT: To get the code to execute, set the StringGrid's OnDrawCell event to "StringGrid1DrawCell, and the SpinEdit's OnChange event to SpinEdit1Change, and Form1's OnCreate event to FormCreate.

Code:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, LResources, Forms, Grids ,
Controls, Graphics, Dialogs, StdCtrls, Spin;

type

{ TForm1 }

TForm1 = class(TForm)
  Label1: TLabel;
  SpinEdit1: TSpinEdit;
  StringGrid1: TStringGrid;
  procedure FormCreate(Sender: TObject);
  procedure SpinEdit1Change(Sender: TObject);
  procedure StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer;
    aRect: TRect; aState: TGridDrawState);
private
{ private declarations }
public
{ public declarations }
end;

var
  Form1: TForm1;
  on_draw_cell_counter :integer;

implementation

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  on_draw_cell_counter:=0;
end;

procedure TForm1.SpinEdit1Change(Sender: TObject);
begin
  stringgrid1.Repaint;
  label1.Caption:= inttostr(on_draw_cell_counter);
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer;
  aRect: TRect; aState: TGridDrawState);
begin
  on_draw_cell_counter:=on_draw_cell_counter+1;
  If (gdFixed in aState) then exit;
  if (aCol = 2) and (aRow = spinedit1.Value) then begin
    stringgrid1.canvas.Brush.Color:=clRed;
    stringgrid1.canvas.FillRect(arect);
    StringGrid1.Canvas.TextOut(aRect.Left + 2, aRect.Top + 2, 'ZZZZ');
  end;

end;



initialization
{$I unit1.lrs}
end.

----------

This should then work. I tested it on my PC using Lazarus 0.9.25 and FPC 2.2.2.

nitep

  • Newbie
  • Posts: 3
How to colour individual cells in a stringgrid
« Reply #4 on: October 07, 2008, 01:52:05 am »
Thanks very much. That works. I am embarrassed to say that I had not set the OnDrawCell event . I had not even looked at those events. That was all I had to do to get my original program working with a form. I previously had it working only as a console program. I last did extensive programming in Pascal 16 years ago then 4 years in Informix 4th generation code and nothing for the last 12 years. The object event driven code is all new to me. All I need now for this program is to be able to set it to super user in linux. Same as sudo from the terminal.

Thanks again
Regards,
Peter

arnoldb

  • Jr. Member
  • **
  • Posts: 96
How to colour individual cells in a stringgrid
« Reply #5 on: October 07, 2008, 08:20:48 pm »
Pleasure - I started on a TRS-80 with BASIC, moved on to Borlan Bascal on PC, did a lot of assembler on both these systems etc, so I understand missing the "events"; back then there were no events - just BIOS interrupts!

As to becoming super user, I don't think that's possible from within your program, unless you set the permissions on your program on linux to cmod +s...
Regards
Arnold

 

Recent

Get Lazarus at SourceForge.net. Fast, secure and Free Open Source software downloads