[SOLVED] TStringGrid color cells with duplicate values

[Hansvb]

Hi,

I have a string grid with 2 columns. You can enter text in the second column. I would like to color the cell red if the text already exists in the same column. How do I approach that? I only want to color the cells with the same value red and not the entire column.
And Ondraw cell triggers to early  i think.

[Handoko]

No problem. TStringGrid is capable to handle the things you said. You only need to write code for TStringGrid.OnPrepareCanvas event.

Not exactly what you want, but in the link below in the User Interface section, you can find 2 demos in Searchable StringGrid. There you can study how to write conditions and set colors for it:

https://wiki.freepascal.org/Portal:HowTo_Demos

[jamie]

I believe the poster would like this to happen while in EDIT mode entering the text.

If so, this means interaction with existing, or a custom cell editor is required.

Of course, the final results can be done via the prepare canvas route.

[Handoko]

If your guess is right, he wants that feature in edit mode. I don't think that is possible in TStringGrid.

[jamie]

yes, it's possible. I am working up something here.

[Hansvb]

I now created this 'monster'. It even almost works. When there is a duplicate value in the stringgrid in column 2 the cel gets red. But the red disapears after the finally free part. i am wrong. i think OnDrawCell removes the red color

Code: Pascal  [Select][+][-]

1. procedure TFrmMain.StringgridOnEditingDone (Sender : TObject );
2. var
3.   _stringGrid : TStringGrid;
4.   strUnique, strDuplicate : TStringList;
5.   i,j, k, level : Integer;
6.   cellText, searchString : String;
7.   duplicates : TStringArray;
8. begin
9.   if sender is TStringGrid then begin
10.     _stringGrid := TStringGrid(sender);
11.  
12.     strUnique := TStringList.Create;
13.     strUnique.Sorted := True;
14.     strUnique.Duplicates := dupError;
15.     strDuplicate := TStringList.Create;
16.  
17.     try
18.     for i := 0 to _stringGrid.RowCount-1 do begin
19.       if _stringGrid.Cells[2,i] <> '' then begin
20.         cellText := IntToStr(FCurLevelNumber) + '_' + _stringGrid.Cells[2,i];
21.         try
22.           strUnique.Add(cellText);
23.         except
24.           on E : EStringListError do begin
25.             strDuplicate.Add(cellText);
26.           end;
27.         end;
28.       end;
29.     end;
30.  
31.  
32.     if strDuplicate.Count > 0 then begin
33.       for i := 0 to strDuplicate.Count-1 do begin
34.         // prepare the search string
35.         duplicates := strDuplicate[i].Split('_');
36.         level := StrToInt(duplicates[0]);
37.  
38.         if StrToInt(GetNumbers(_stringGrid.Name)) = FCurLevelNumber then begin
39.           searchString := duplicates[1];
40.           for j := 0 to _stringgrid.RowCount-1 do begin
41.             for k := 0 to _stringGrid.ColCount-1 do begin
42.               if _stringGrid.Cells[k, j] = searchString then begin
43.                 _stringGrid.Canvas.Brush.Color := clRed;
44.                 _stringGrid.Canvas.FillRect(_stringGrid.CellRect(k, j));
45.                 _stringGrid.Canvas.TextOut(_stringGrid.CellRect(i, j).Left + 2, _stringGrid.CellRect(i, j).Top + 2, _stringGrid.Cells[k, j]);
46.               end;
47.             end;
48.           end;
49.         end;
50.       end;
51.     end;
52.  
53.     finally
54.        strUnique.Free;     //< wrong here?
55.        strDuplicate.Free;
56.     end;
57.   end;
58. end;  
59.  

[Hansvb]

I think i found it. I will clean up a bit and then post it

[Hansvb]

This works see attachement. If you add duplicate text in the "edit this" column the cells get red. It took me all afternoon to figure this out

I don't know if this will be very slow if there are many cells in 1 column.

Code: Pascal  [Select][+][-]

1. procedure TForm1.FormCreate(Sender: TObject);
2. begin
3.   // Ceate stringlist which hold the stringgrid data entry.
4.   FstrListUnique := TStringList.Create;
5.   FstrListUnique.Sorted := true;
6.   FstrListUnique.Duplicates := dupError;
7.   FstrListDuplicates := TStringList.Create;
8.  
9. end;
10.  
11. procedure TForm1.StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer;
12.   aRect: TRect; aState: TGridDrawState);
13. var
14.   _stringgrid : TStringGrid;
15.    i, j, k : Integer;
16. begin
17.   if sender is TStringGrid then begin
18.     _stringgrid := TStringGrid(sender);
19.  
20.     if FstrListDuplicates.Count > 0 then begin
21.       for i := 0 to FstrListDuplicates.Count-1 do begin     // Go through de stringlist with duplicates
22.         for j := 0 to _stringgrid.RowCount-1 do begin       // Go through the StringGrid rows
23.             for k := 0 to _stringGrid.ColCount-1 do begin   // Go through the StringGrid cols. (Not needed, there is only one data col)
24.               if _stringGrid.Cells[k, j] = FstrListDuplicates[i] then begin
25.                 _stringGrid.Canvas.Brush.Color := clRed;
26.                 _stringGrid.Canvas.FillRect(_stringGrid.CellRect(k, j));
27.                 //_stringGrid.Canvas.TextOut(_stringGrid.CellRect(k, j).Left + 2, _stringGrid.CellRect(k, j).Top + 2, _stringGrid.Cells[k, j]);
28.                 _stringGrid.Canvas.TextOut(_stringGrid.CellRect(k, j).Left + 2, _stringGrid.CellRect(k, j).Top + 2, _stringGrid.Cells[k, j]);
29.               end;
30.             end;
31.           end;
32.       end;
33.     end;
34.   end;
35. end;
36.  
37. procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
38. begin
39.   FstrListDuplicates.Free;
40.   FstrListUnique.Free;
41. end;
42.  
43. procedure TForm1.StringGrid1EditingDone(Sender: TObject);
44. var
45.   _stringGrid : TStringGrid;
46.   i : Integer;
47. begin
48.   if sender is TStringGrid then begin
49.     _stringGrid := TStringGrid(sender);
50.  
51.     FstrListUnique.Clear;
52.     FstrListDuplicates.Clear;
53.  
54.     for i := 0 to _stringGrid.RowCount-1 do begin
55.       if _stringGrid.Cells[2,i] <> '' then begin;
56.         try
57.           FstrListUnique.Add(_stringGrid.Cells[2,i]);
58.         except
59.           on E : EStringListError do begin
60.             FstrListDuplicates.Add(_stringGrid.Cells[2,i]);
61.           end;
62.         end;
63.       end;
64.     end;
65.   end;
66. end;  
67.  

[Handoko]

Why not use OnPrepareCanvas? It is much simpler and fast:

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Grids;
9.  
10. type
11.  
12.   { TForm1 }
13.  
14.   TForm1 = class(TForm)
15.     StringGrid1: TStringGrid;
16.     procedure FormCreate(Sender: TObject);
17.     procedure StringGrid1PrepareCanvas(Sender: TObject; aCol, aRow: Integer;
18.       aState: TGridDrawState);
19.   end;
20.  
21. var
22.   Form1: TForm1;
23.  
24. implementation
25.  
26. {$R *.lfm}
27.  
28. { TForm1 }
29.  
30. procedure TForm1.FormCreate(Sender: TObject);
31. begin
32.   StringGrid1.Options      := StringGrid1.Options + [goEditing];
33.   StringGrid1.FixedCols    := 0;
34.   StringGrid1.ColCount     := 1;
35.   StringGrid1.ColWidths[0] := 200;
36.   StringGrid1.FixedRows    := 0;
37.   StringGrid1.RowCount     := 100;
38.   StringGrid1.Cells[0, 0]  := 'cat';
39.   StringGrid1.Cells[0, 1]  := 'bird';
40.   StringGrid1.Cells[0, 2]  := 'dog';
41. end;
42.  
43. procedure TForm1.StringGrid1PrepareCanvas(Sender: TObject; aCol, aRow: Integer;
44.   aState: TGridDrawState);
45. var
46.   i: Integer;
47. begin
48.   for i := 0 to StringGrid1.RowCount-1 do
49.     if (i <> aRow) and (StringGrid1.Cells[0, aRow] <> '') then
50.       if StringGrid1.Cells[0, i] = StringGrid1.Cells[0, aRow] then
51.       begin
52.         StringGrid1.Canvas.Brush.Color := clRed;
53.         Break;
54.       end;
55. end;
56.  
57. end.

[Hansvb]

@Handoko, that's much better. thanks.