Color row of DBGrid

[FrancoJommi]

I change color of the 'current' record in a DBGrid using the
OnDrawColumnCell eventi with the following code:

if (gdFocused in State) or (gdSelected in State) then
begin
if BtnMod.Down then
MyDBGrid.Canvas.Brush.Color := clYellow
else
MyDBGrid.Options := DelegheDBGrid.Options + [dgRowSelect];
MyDBGrid.DefaultDrawColumnCell(Rect,DataCol,Column,State);
end;

The problem I have is that it doesn't work exactly as I wanted. The first
time I show the DBGrid no record are hilighted though dgRowSelect is true.
Clicking on the BtnMod the focused row is correctly painted in yellow, since
dgRowSelect is true. But I need dgRowSelect to be false to edit the record
and if it is set to false, the cells are not painted in yellow.

Thanks in advance for any suggestions.

[Fons]

I think you should do ALL the drawing of the cells in OnDrawColumnCell.
I have written a program with a grid with user-chosen colors, crosses in
colored cells etc. Most of the standard drawing, not different from a
standard grid is simple; that's not too much work.

I think it doesn't work with just changing the Brush.Color and the Options.

> Thanks in advance for any suggestions.

Fons.

[FrancoJommi]

Would you share what you have done or give guidance on how to do it ?

"Fons" <fonz...@SPAMxs4allPLEASE.nl> ha scritto nel messaggio
news:468ab710$0$336$e4fe...@news.xs4all.nl...

[Fons]

Try this:

procedure TFormMain.StringGridDrawCell(Sender: TObject; ACol,
ARow: Integer; Rect: TRect; State: TGridDrawState);
begin
DrawCell(ACol, ARow, Rect, State);
end;

procedure TFormMain.DrawCell(ACol, ARow: Integer; Rect: TRect; State:
TGridDrawState);
var
S : string;
TextTop, TextLeft : integer;
begin
S := Trim(StringGrid.Cells[ACol, ARow]);

TextTop := Rect.Top + (RectHeight(Rect) -
StringGrid.Canvas.TextHeight(S)) div 2;
TextLeft := Rect.Left + (RectWidth(Rect) -
StringGrid.Canvas.TextWidth(S)) div 2;

StringGrid.Canvas.Font.Color := clRed;
StringGrid.Canvas.Pen.Color := clRed;
StringGrid.Canvas.Brush.Color := clBtnFace;
StringGrid.Canvas.TextRect(Rect, TextLeft, TextTop, S);
end;

DrawCell is called for *every* cell (you can put the code directly in
StringGridDrawCell, but I always try to keep the code in the
event-handler as short as possible). But in DrawCell you can change the
Font, Pen or Brush color depending S (the text in the cell) or the
coordinates. You can draw lines, draw circles etc. But *do not* draw
outside the Rect. If you do you'll mess it up. Try drawing with random
colors. You'll see, this is not what you want. It'll give some
kaleidoscope when resizing the grid.

TextTop and TextLeft are only to center the text.

Hope this helps,
Fons.

[FrancoJommi]

Thanks, I'all surely try your code.

"Fons" <fonz...@SPAMxs4allPLEASE.nl> ha scritto nel messaggio

news:468b9397$0$323$e4fe...@news.xs4all.nl...

[FrancoJommi]

I notice the proc you wrote applies to a TStingGrid, rather then to a
DBGrid. How do I replace the "DrawCell(ACol, ARow, Rect, State);" statement
since the OnDraw event of a DBGrid supplies Columns coordinates rather then
Cells ?

"Fons" <fonz...@SPAMxs4allPLEASE.nl> ha scritto nel messaggio

news:468b9397$0$323$e4fe...@news.xs4all.nl...

[Fons]

Oops !

I'll try to make a DBGrid example this afternoon and tell you this evening.

Fons.

[Fons]

> I notice the proc you wrote applies to a TStingGrid, rather then to a
> DBGrid. How do I replace the "DrawCell(ACol, ARow, Rect, State);" statement
> since the OnDraw event of a DBGrid supplies Columns coordinates rather then
> Cells ?

This is the unit I wrote. Also check the last procedure.

I can email you a zip with the complete source and the exe if you can't
compile ADO.

Fons.

unit DBGridUnitMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
Forms,
Dialogs, DBGrids, Grids, DB, ADODB, StdCtrls, Menus;

type
TFormMain = class(TForm)
DBGrid: TDBGrid;
LabelCount: TLabel;
ADOConnection: TADOConnection;
ADOQuery: TADOQuery;
DataSource: TDataSource;
procedure FormShow(Sender: TObject);
procedure DBGridDrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
procedure DBGridDrawDataCell(Sender: TObject; const Rect: TRect;
Field: TField; State: TGridDrawState);
private
{ Private declarations }
procedure Connect;
public
{ Public declarations }
end;

var
FormMain: TFormMain;

implementation

{$R *.dfm}

procedure TFormMain.Connect;
begin
ADOConnection.LoginPrompt := False;
ADOConnection.ConnectionString :=
'Data Source = MS Access-database; Initial Catalog = DBGrid.mdb';
ADOQuery.Connection := ADOConnection;
ADOQuery.SQL.Add('select * from ListA');
DataSource.DataSet := ADOQuery;
DBGrid.DataSource := DataSource;

ADOQuery.ExecSQL;
ADOQuery.Active := True;
end;

procedure TFormMain.FormShow(Sender: TObject);
begin
Connect;
LabelCount.Caption := '0';
end;

function RectHeight(R : TRect) : integer;
begin
Result := R.Bottom - R.Top;
end;

function RectWidth(R : TRect) : integer;
begin
Result := R.Right - R.Left;
end;

procedure TFormMain.DBGridDrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumn;

State: TGridDrawState);
var
S : string;
TextTop, TextLeft : integer;
begin

{-To see how often DBGridDrawColumnCell is called.}
LabelCount.Caption := IntToStr(StrToInt(LabelCount.Caption) + 1);

S := Column.Field.AsString;

TextTop := RectHeight(Rect) - DBGrid.Canvas.TextHeight(S);
TextTop := Rect.Top + TextTop div 2;
TextLeft := RectWidth(Rect) - DBGrid.Canvas.TextWidth(S);
TextLeft := Rect.Left + TextLeft div 2;

if State = [gdFocused, gdSelected] then begin
DBGrid.Canvas.Font.Color := clBlack;
DBGrid.Canvas.Brush.Color := clWhite;
DBGrid.Canvas.TextRect(Rect, TextLeft, TextTop, S);

DBGrid.Canvas.Pen.Color := clBlue;
DBGrid.Canvas.Ellipse(Rect);

DBGrid.Canvas.Font.Color := clBlack;
DBGrid.Canvas.Brush.Color := clWhite;
DBGrid.Canvas.TextOut(TextLeft, TextTop, S);
end else
if DataCol = 0 then begin
DBGrid.Canvas.Font.Color := clBlack;
DBGrid.Canvas.Brush.Color := clBlue;
DBGrid.Canvas.TextRect(Rect, TextLeft, TextTop, S);
end else
if Column.FieldName = 'FieldB' then begin
DBGrid.Canvas.Font.Color := clBlack;
DBGrid.Canvas.Brush.Color := clBtnFace;
DBGrid.Canvas.TextRect(Rect, TextLeft, TextTop, S);
DBGrid.Canvas.Pen.Color := clRed;
DBGrid.Canvas.MoveTo(Rect.Left, Rect.Top);
DBGrid.Canvas.LineTo(Rect.Right, Rect.Bottom);
DBGrid.Canvas.MoveTo(Rect.Left, Rect.Bottom);
DBGrid.Canvas.LineTo(Rect.Right, Rect.Top);
end;
end;

procedure TFormMain.DBGridDrawDataCell(Sender: TObject;
const Rect: TRect; Field: TField; State: TGridDrawState);
begin
{- In the help :

Do not write an OnDrawDataCell event handler.
OnDrawDataCell is obsolete and included for
backward compatibility.
Instead, write an OnDrawColumnCell event handler.
}
end;

end.

[alang...@aol.com]

On 5 Jul, 16:33, Fons <fonzz...@SPAMxs4allPLEASE.nl> wrote:
<snip>

1 You TextOut twice with different colors on the same rect - is this
what you want to do <g>

2 If you use the DrawText() API you avoid having to do that tedious
calculation of text size to position it ...

DrawText(DBGrid.Canvas.Handle, PChar(S), -1, Rect, DT_SINGLELINE or
DT_CENTER or DT_VCENTER);

... draws text centered vertically & horizontally. Look up MSDN
(Microsoft Developer Network) on their website for further details on
DrawText constants.

3 If you make a local abbreviated variable for the DBGrid.Canvas you
have less verbiage in your code (hence clearer) and you make the
procedure more self-contained (using only values passed in the
parameters) and hence better quality. eg ...

var
DBGC : TCanvas;
begin
DBGC := TDBGrid(Sender).Canvas;

DBGC.Font.Color := clBlack;
DBGC.Brush.Color := clWhite;
DBGC.TextRect(Rect, TextLeft, TextTop, S);

4 Don't forget that gdFocussed may be only one cell and may be in a
different row than gdSelected.

Alan Lloyd

[Fons]

Yes; it was a quickly made example but you seem to be missing the
purpose of this.

Fons.

[FrancoJommi]

I am using the BDE, but I guess that doesn't make a big difference. Or does
it? Thanks a lot if you can send me a zip file, but what's the difference
with what you have already typed in the message ?

"Fons" <fonz...@SPAMxs4allPLEASE.nl> ha scritto nel messaggio

news:468d0ef2$0$333$e4fe...@news.xs4all.nl...

[Fons]

If you can read this but did not receive my email you & me do have a
problem :-$

Fons.

[FrancoJommi]

I just received it. I am going to hhave a look at it. In the meantime,
thanks.

"Fons" <fonz...@SPAMxs4allPLEASE.nl> ha scritto nel messaggio

news:468eaadf$0$339$e4fe...@news.xs4all.nl...

[alexs...@gmail.com]

Hey guys,
by the way, did you have a problem with displaying of the Currency
type data in a colored DBGrid? I did the same you did thru
DBGridDrawColumnCell and got all the money numbers shown like 15000.00
instead of $15,000.00!
Thanks,
alex

[alang...@aol.com]

Look up TFloatField.Currency in Delphi Help. Lots of good stuff in
Help files <g>.

Alan Lloyd