Lazarus
Using the Lazarus IDE => General => Topic started by: nitep 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:
-
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.
-
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.
{**************************************************************}
-
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.
-
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
-
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