Avatar of ejla51

asked on 

DBGrid Row Color

I'm looking solution  to change DBGrid Rowcolor - based to dataset record number alt. "2-field match"
1.  select range based to Field1 = srcWord1
2. if (Field1 = srcWord1) and (Field2 = srcWord2) then recNum := Table.RecordNumber
3. if recNum <>  nil then ChangeRowcolor(recNum)

Avatar of undefined
Last Comment
Avatar of Geert G
Geert G
Flag of Belgium image

it's a bit cryptic your question ... :)

here is how to change color for a row in a dbgrid:

for the matches ... you could use a calculated field which does the actual math and sets a value in that field
check the field in the DrawColumnCell event
Avatar of ejla51


Well... I'll try define more exact...
1. Display all records matching one field (select subrange)
2. if this subrange having one (or more) record matching another field too, change rowcolor (duplicate found)
Coloring is not  any problem, only how to found right record  on the dbgrid (on, eg. by record number.  
Suggestion: Add Dataset RecordNumber to OnDrawColumnCell

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol, RecordNumber: Integer; Column: TColumn; State: TGridDrawState);

you can't change the events parameters
you can use DBGrid.DataSource.DataSet.RecNo to know which record is being drawn (or directly the dataset.recno you are using), as when drawing a row, the cursor is positioned accordingly in the dataset
Avatar of Geert G
Geert G
Flag of Belgium image

what database is it ?

if you want to find duplicates within a group in oracle, easiest is to use lag/lead

select a,b,c,d, decode(next_d, d, 1, 0) is_next_duplicate
from (
  select a,b,c,d, lag(d) over (partition by a,b,c order by a,b,c) next_d
  from table)

this shows 1 in the field is_next_duplicate

if you want 1 in both rows:

select a,b,c,d,
  case when next_d = d or prev_d = d then 1 else 0 end is_duplicate
from (
  select a,b,c,d,
    lag(d) over (partition by a,b,c order by a,b,c) next_d
    lead(d) over (partition by a,b,c order by a,b,c) prev_d
  from table)

but that's the power of oracle :)
oh yeah, I remember using lag once a very long time. Pretty advanced stuff, I'm not sure I still understand what you wrote, or I'll have to read it twice again.
Let me try to summarize, in your last example

here is some documentation by the way :
and I also found that to be clarifying :

lag(d) will try to find the previous d value when the table is sorted by all the other columns (so Geert, correct me if I'm wrong but you should have called that one prev_d, not next_d ?)
lead will try to find the next one.
And both are executed on the same result set, like if it was ordered, but without changing the result order of your dataset.  

Then, when those are calculated, you do a test to set a field to 0 or 1 if either the previous or next 'd' value is the same as the current one :
case when (next_d = d or prev_d = d)
  then 1
 else 0

would translate in delphi like :
if  (next_d = d or prev_d = d) Then is_duplicate:=1 Else is_duplicate:=0 ;

Another note for Geert : I'm not sure about the partition : I would think you have to sort the partition by D field, not a,b,c ? How are you certain that you have the previous row with same D field if not sorting by D ?
Avatar of ejla51


In this project I'm using TkbmMemTable. Because of Delphi 7  I'm not able to  use any type of SQL... kbmSQL is supported in Delphi 2010 and XE.  
Just now I'm using following concept, see code.

First select database subrange and
at last make controll in the DupeGridDrawColumCell..

That works, but I think its a little bit slowly and ugly way. Have to found some more  sophisticated way to make this dupecheck.

procedure TfrmMain.DupeGridDrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
var c1,c2,b1,b2 : string;  {TODO : Dupe - DupeGrid Color }
    r : integer;
    oldc, oldEdcl, oldEdFontCl, oldBrushColor : TColor;
    p, Sp : boolean;

 c1 := Trim(DM1.Dupe.FieldByName('CallSign').AsString);
 c2 := Trim(frmMain.edCallSign.Text);
 b1 := Trim(DM1.Du.FieldByName('Area').AsString);
 b2 := Trim(edArea.Text);

 oldc  := DupeGrid.Canvas.Font.Color;
 oldBrushColor := DupeGrid.Canvas.Brush.Color;
 oldEdcl := clLime; //edCall.Color;
 oldEdFontCl := edCall.Font.Color;

 if  ( c1 = c2 )  // CallSign Match
 and (b1 = b2) // Area Match
      DupeGrid.Canvas.Brush.Color := clRed;
      DupeGrid.Canvas.Font.Color  := clYellow;
      DupeGrid.Canvas.Brush.Color := oldBrushColor; //$00FFD9B3;
      DupeGrid.Canvas.Font.Color  := oldc;
       if length(Trim(edCallSign.Text)) = 0 then
        DupeGrid.Canvas.Font.Color := DupeGrid.Canvas.Brush.Color;

Open in new window

Avatar of Emmanuel PASQUIER
Flag of France image

Blurred text
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
Avatar of Scay7
Flag of South Africa image

below code works on the fly and changes the row/font colour as you work with your queries...

procedure TForm1.DBGridDrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
recNum := Table.RecordNumber;
If recnum <> nul then
dbgrid.canvas.Font.Color := clcream;
dbgrid.canvas.brush.color := clred;
dbgrid.DefaultDrawColumnCell(rect,DataCol,Column,State); //important to draw the colour in
Hi !

Have you found a way to implement things as I proposed ? or do you need help ?
If that is the case, then consider posting your whole code, so that we might boil it down to the fastest solution possible
Avatar of ejla51


Thanks for tips...  No  problems, but have some madness with then MemTable code.
Have optimized syntax and the result is not good :(
Number of overall changes is quite large.

Code example...

procedure TDM1.tblLogBeforeEdit(DataSet: TDataSet);
// These works well...
 OldValues.Date  := tblLog.FieldByName('DATE').AsString;
 OldValues.UTC  := tblLog.FieldByName('UTC').AsString;

// but NOT these
 OldValues.Date  := tblLogDATE.AsString;  
 OldValues.UTC  := tblLogUTC.AsString;

None compiling errors -  but AV on execution.
All Fieldtypes are String type.
Now that is strange...

Compare both way of accessing fields :

ShowMessageFmt(' DATE ByName = %x , Ref = %x ', [Integer( tblLog.FieldByName('DATE') ), Integer(tblLogDATE ) ] );
They should not be different, and if not different they should both work...
So if you have a pb, then it is probably different, and then we have to know why. But first test to be sure
or maybe you change the structure of your table since you designed it, and tblLogDATE is no longer valid.

Well, in essence it is merely a variable to store FieldByName('DATE') so you can just update its value after a change of fields definitions

tblLogDATE := FieldByName('DATE');  // do that only on the critical place you changed table structure

then anywhere else in your code you only use tblLogDate

same for all othe fields
Avatar of ejla51


Well, of course I have changed table structure many times after designed it :)
All changes has been done on designtime and whole project has been rebuild too.
I tried "re-assign" values as below without any success.
I'm not sure if I understand  what you  mean with "do  that only on  the critical place you changed table structure"
procedure TDM1.DataModuleCreate(Sender: TObject);
   with tblLog do
    tblLogDATE.AsString := FieldByName('DATE').AsString;
    tblLogUTC.AsString := FieldByName('UTC').AsString;

I debugged field values and the results is "Expression illegal in evaluator"
Avatar of ejla51


> ShowMessageFmt(' DATE ByName = %x , Ref = %x ', [Integer( tblLog.FieldByName('DATE') ), Integer(tblLogDATE ) ] );

Ref = always return 0 in all 21 fields in the table
ok, then you know why it is not working.

probably  you didn't initialize it correctly
Avatar of ejla51


Found solution... I had missed to set property:

 DM1.tblLog.AutoUpdateFieldVariables := true;
- default value is false!

Lot of job for nothing...
TkbmMemTable is a great component, but taking a bit latitude with DB standards. I'm not surprise that it has a few *dark* spots like this one.
Glad you found it !
Avatar of ejla51


Yes, agree ... I was very happy when I found TDbf and TkbmMemTable instead of BDE! It was nice to have a rather large database application on a 1.4 MB floppy disk!
When a table component is very easy to use, it can happen what happened to me ... have not looked at the help files for years, hi!

Referring to the original question so I'll accept your proposal. Apparently, I have still been on track to show duplicates in real time when entering text in the input fields. I has had thought of doing this any other way to avoid a lot of unnecessary work while write to the inputs.
Important point has been SetRange, which thins out the number of records to a few dozen. Then DrawColumnCell does not burden too much, especially if unimportant columns are ignored for content check.
My thought was to search  and mark recordnumber of duplicate. The only problem there would be if there may be several duplicates, and then we should have one more SetRange. As a disadvantage, that it takes away the first subrange (partial match is still intrested).
I think I'll be happy with this. Of course there are more nuts to crack, but I'll take them in another thread!
Thanks for the help!

Delphi is the most powerful Object Pascal IDE and component library for cross-platform Native App Development with flexible Cloud services and broad IoT connectivity. It provides powerful VCL controls for Windows 10 and enables FMX development for Windows, Mac and Mobile. Delphi is your choice for ultrafast Enterprise Strong Development™. Look for increased memory for large projects, extended multi-monitor support, improved Object Inspector and much more. Delphi is 5x faster for development and deployment across multiple desktop, mobile, cloud and database platforms including 32-bit and 64-bit Windows 10.

Top Experts
Get a personalized solution from industry experts
Ask the experts
Read over 600 more reviews


IBM logoIntel logoMicrosoft logoUbisoft logoSAP logo
Qualcomm logoCitrix Systems logoWorkday logoErnst & Young logo
High performer badgeUsers love us badge
LinkedIn logoFacebook logoX logoInstagram logoTikTok logoYouTube logo