Recent

Author Topic: [SOLVED] TStringGrid color cells with duplicate values  (Read 973 times)

Hansvb

  • Hero Member
  • *****
  • Posts: 593
[SOLVED] TStringGrid color cells with duplicate values
« on: December 02, 2023, 04:40:56 pm »
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.
« Last Edit: December 03, 2023, 11:49:52 am by Hansvb »

Handoko

  • Hero Member
  • *****
  • Posts: 5101
  • My goal: build my own game engine using Lazarus
Re: TStringGrid color cells with duplicate values
« Reply #1 on: December 02, 2023, 04:57:13 pm »
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

  • Hero Member
  • *****
  • Posts: 6024
Re: TStringGrid color cells with duplicate values
« Reply #2 on: December 02, 2023, 05:43:30 pm »
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.

The only true wisdom is knowing you know nothing

Handoko

  • Hero Member
  • *****
  • Posts: 5101
  • My goal: build my own game engine using Lazarus
Re: TStringGrid color cells with duplicate values
« Reply #3 on: December 02, 2023, 05:54:38 pm »
If your guess is right, he wants that feature in edit mode. I don't think that is possible in TStringGrid.

jamie

  • Hero Member
  • *****
  • Posts: 6024
Re: TStringGrid color cells with duplicate values
« Reply #4 on: December 02, 2023, 06:02:57 pm »
yes, it's possible. I am working up something here.
The only true wisdom is knowing you know nothing

Hansvb

  • Hero Member
  • *****
  • Posts: 593
Re: TStringGrid color cells with duplicate values
« Reply #5 on: December 02, 2023, 06:21:06 pm »
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.  
« Last Edit: December 02, 2023, 06:35:49 pm by Hansvb »

Hansvb

  • Hero Member
  • *****
  • Posts: 593
Re: TStringGrid color cells with duplicate values
« Reply #6 on: December 02, 2023, 06:40:35 pm »
I think i found it. I will clean up a bit and then post it

Hansvb

  • Hero Member
  • *****
  • Posts: 593
Re: TStringGrid color cells with duplicate values
« Reply #7 on: December 02, 2023, 07:16:36 pm »
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

  • Hero Member
  • *****
  • Posts: 5101
  • My goal: build my own game engine using Lazarus
Re: TStringGrid color cells with duplicate values
« Reply #8 on: December 03, 2023, 07:41:33 am »
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

  • Hero Member
  • *****
  • Posts: 593
Re: TStringGrid color cells with duplicate values
« Reply #9 on: December 03, 2023, 10:33:43 am »
@Handoko, that's much better. thanks.

 

TinyPortal © 2005-2018