Recent

Author Topic: [SOLVED] TStringGrid : delete/insert cell (contents)  (Read 2561 times)

perAspera

  • New Member
  • *
  • Posts: 11
[SOLVED] TStringGrid : delete/insert cell (contents)
« on: December 01, 2021, 11:25:52 am »
Hello,
this is a simplified excerpt from a converted Delphi project:
I have a sequence of strings ("words" of a text) in a TStringGrid and want to edit or delete/ insert "words" by pressing CTRL + DELETE/INSERT keys: so I have to shift down or up all cell contents above my selected cell.
In Delphi this worked well. In Lazarus, inserting works too, but when I delete a cell, it becomes empty instead of showing the content of the adjacent, upper cell.
(I found a kind of workaround by saving the content of the adjacent cell on delete, and restore it on keyUp, but this is weird!)
Maybe somebody knows how to fix this - probably the way I did it is stupid anyway and there are much better solutions to this problem. Thanks in advance for any suggestion!
(Laz 2.0.6 on W10)

Code: Pascal  [Select][+][-]
  1. {simple test program
  2. - Cells of TstringGrid are filled with some strings
  3. - CTRL + INSERT should insert an empty cell before the selected on and
  4.   shift up the cells above. This works.
  5. - CTRL + DELETE should delete the selected cell and shift down the cells above.
  6.   This does NOT work. The selected cell SHOULD show the content of the next cell,
  7.   but it shows empty.
  8.   workaround is to save the content and restore it on KeyUP, but this is weird.
  9.   (--> uncomment line in gridKeyUp)
  10. }
  11.  
  12. unit gtest;
  13.  
  14. {$MODE Delphi}
  15.  
  16. interface
  17.  
  18. uses
  19.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Grids,
  20.   LCLIntf, LCLType, StdCtrls, ExtCtrls, Types;
  21.  
  22. type
  23.  
  24.   Tgtest = class(TForm)
  25.     grid: TStringGrid;
  26.     Label1: TLabel;
  27.     procedure drawCell(Sender: TObject; ACol, ARow: Integer;
  28.        Rect: TRect; State: TGridDrawState);
  29.     procedure FormCreate(Sender: TObject);
  30.     procedure gridKeyDown(Sender: TObject; var Key: Word;
  31.        Shift: TShiftState);
  32.     procedure gridKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
  33.  
  34.   private
  35.     procedure ShiftCells(acol, arow, up: integer);
  36.   public
  37.     procedure Init;
  38.   end;
  39.  
  40. var
  41.   gtest1: Tgtest;
  42.   savedcell: string;
  43.  
  44. implementation
  45.  
  46. {$R *.lfm}
  47.  
  48. procedure Tgtest.Init;
  49. const
  50.   defcols=5;
  51.   np=20;
  52.   { some dummy content (Nietzsche, Nach neuen Meeren)}
  53.   poem : array[0..np] of string = ('Dorthin - ', 'will', 'ich;','und','ich','traue',
  54.     'mir', 'fortan', 'und', ' meinem', ' Griff.',
  55.     'Offen', ' liegt', ' das', ' Meer,', ' in''s', 'Blaue',
  56.     'treibt', 'mein', 'Genueser', 'Schiff.');
  57.  
  58. var
  59.   irow, icol, icount: word;
  60.  
  61. begin
  62. // fill the poem into the cells and adjust grid size:
  63.   grid.Options:=[goVertLine, goHorzLine, goEditing{, goTabs}];
  64.   with grid do begin
  65.     ColCount:=defcols;
  66. // make sure to have enough rows:
  67.     RowCount:=np div defcols + 1;
  68.     icount:=0;
  69.     while icount <= np do begin
  70.       irow:=icount div ColCount;
  71.       icol:=icount mod ColCount;
  72.       Cells[icol, irow]:=poem[icount];
  73.       Inc(icount);
  74.     end;
  75.     for icount:=icol+1 to ColCount-1 do begin
  76.       Cells[icount, irow]:='';
  77.     end;
  78.   end;
  79. end;
  80.  
  81.  
  82. procedure Tgtest.drawCell(Sender: TObject; ACol, ARow: Integer;
  83.   Rect: TRect; State: TGridDrawState);
  84. var
  85.   b, c: TColor;
  86. begin
  87.   with grid.Canvas do  begin
  88. //only for testing: show cell differently if it contains an 'a'...
  89.       if Pos('a', grid.Cells[Acol,Arow])>0 then begin
  90.       Brush.Color:=clFuchsia; Font.Color:=clWhite;
  91.     end else begin
  92.       Brush.Color:=clWhite; Font.Color:=clBlue;
  93.     end;
  94.     FillRect(Rect);
  95.     TextOut(Rect.Left+2, Rect.Top+2, grid.Cells[ACol, ARow]);
  96.   end;
  97. end;
  98.  
  99. procedure Tgtest.FormCreate(Sender: TObject);
  100. begin
  101.   Init;
  102. end;
  103.  
  104.  
  105. procedure Tgtest.ShiftCells(acol, arow, up: integer);
  106.  
  107. var
  108.   cc, nac, nhi, nmx, n, r, c: integer;
  109.   tmp:string;
  110.  
  111. label foundhighest, exit_all_empty;
  112.  
  113. begin
  114. { shift the content of cells above the selected one down or up, to delete or
  115.   insert a word from the content
  116. }
  117.   with grid do begin
  118.     cc:=ColCount;
  119. // find highest non empty cell
  120.     for r:=Rowcount-1 downto 0 do for c:=ColCount-1 downto 0 do begin
  121.       if length(Cells[c, r]) > 0 then goto foundhighest;
  122.     end;
  123.     goto exit_all_empty;
  124.  
  125.     foundhighest:
  126. // cells are numbered by n = row*colcount + col
  127.     nhi :=r*cc+c;
  128.     nac :=arow*cc+acol;
  129.     nmx :=RowCount*cc;
  130. // delete: shift cells down
  131.     case up of
  132.     -1:begin
  133.         if nhi >=0 then begin
  134. // save content of cell which should go to deleted
  135.           if nac<nhi then savedcell:=Cells[(nac+1) mod cc, (nac+1) div cc];
  136.           for n:=nac to nhi-1 do begin
  137.             Cells[n mod cc, n div cc]:=Cells[(n+1) mod cc, (n+1) div cc];
  138.           end;
  139.           Cells[nhi mod cc, nhi div cc]:='';
  140.           RowCount:=nhi div cc+1;
  141.         end;
  142.       end;
  143. // insert: shift cells up
  144.      1:begin
  145.         RowCount:=(nhi+2) div cc +1;
  146.         for n:=nhi downto nac do begin
  147.           Cells[(n+1) mod cc, (n+1) div cc]:=Cells[n mod cc, n div cc];
  148.         end;
  149.         Cells[acol, arow]:='';
  150.        end;
  151.      else
  152.     end;
  153.  
  154.     refresh;
  155.  
  156.     exit_all_empty:
  157.   end;
  158. end;
  159.  
  160. {--------------------------------------------------------------------}
  161.  
  162. procedure Tgtest.gridKeyDown(Sender: TObject; var Key: Word;
  163.   Shift: TShiftState);
  164. // press CTRL INSERT / DELETE to insert or delete cells in table
  165. begin
  166.   if ssCtrl in Shift then begin
  167.     if Key  = VK_INSERT then begin
  168.       ShiftCells(grid.Col, grid.Row,1);
  169.     end;
  170.     if Key  = VK_DELETE then begin
  171.       ShiftCells(grid.Col, grid.Row,-1);
  172.     end;
  173.   end;
  174. end;
  175.  
  176. procedure Tgtest.gridKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
  177.  
  178. begin
  179.   if (ssCtrl in Shift) and (Key  = VK_DELETE) then begin
  180.  { uncommenting activates a the weird workaround to restore the content of the
  181.    selected cell, which otherwise becomes blank :}
  182. //    grid.Cells[grid.col,grid.row]:=savedCell;
  183.   end;
  184. end;
  185.  
  186. {--------------------------------------------------------------------}
  187.  
  188. end.
  189.  
  190.  
Code: Pascal  [Select][+][-]
  1. program project1;
  2.  
  3. //{$mode objfpc}{$H+}
  4.   {$mode Delphi}
  5. uses
  6.   {$IFDEF UNIX}{$IFDEF UseCThreads}
  7.   cthreads,
  8.   {$ENDIF}{$ENDIF}
  9.   Interfaces, // this includes the LCL widgetset
  10.   Forms, gtest
  11.   { you can add units after this };
  12.  
  13. {$R *.res}
  14.  
  15. begin
  16.   RequireDerivedFormResource:=True;
  17.   Application.Scaled:=True;
  18.   Application.Initialize;
  19.   Application.CreateForm(Tgtest, gtest1);
  20.   Application.Run;
  21. end.
  22.                    
  23.  
« Last Edit: December 01, 2021, 03:43:22 pm by perAspera »

wp

  • Hero Member
  • *****
  • Posts: 9588
Re: TStringGrid : delete/insert cell (contents)
« Reply #1 on: December 01, 2021, 11:50:58 am »
Please pack .pas, .lfm, .lpi and .lpr files into a common .zip which you can upload under "Attachments and other options". (You can even create the zip easily inside the IDE by using the "Project" > "Publish project" menu). This way we do not need to reconstruct a compilable project from your snippets, an operation where many thing can run differently from what you are doing.
Mainly Lazarus trunk / fpc 3.2.0 / all 32-bit on Win-10, but many more...

perAspera

  • New Member
  • *
  • Posts: 11
Re: TStringGrid : delete/insert cell (contents)
« Reply #2 on: December 01, 2021, 12:10:15 pm »
Thanks for the hint - here it is!

wp

  • Hero Member
  • *****
  • Posts: 9588
Re: TStringGrid : delete/insert cell (contents)
« Reply #3 on: December 01, 2021, 02:49:11 pm »
The main problem is that you call ShiftCells in the OnKeyDown event, but do not reset the pressed Key to zero to indicate to the following routines that the key already has been handled and should not be processed any more. Without this you shift the cells up but the DELETE key is still active and the grid finally will delete the contents of the current cell.

Code: Pascal  [Select][+][-]
  1. procedure Tgtest.gridKeyDown(Sender: TObject; var Key: Word;
  2.   Shift: TShiftState);
  3. // press CTRL INSERT / DELETE to insert or delete cells in table
  4. begin
  5.   if ssCtrl in Shift then begin
  6.     if Key  = VK_INSERT then begin
  7.       ShiftCells(grid.Col, grid.Row,1);
  8.       Key := 0;
  9.     end;
  10.     if Key  = VK_DELETE then begin
  11.       ShiftCells(grid.Col, grid.Row,-1);
  12.       Key := 0;
  13.     end;
  14.   end;
  15. end;

Apart from what jamie is saying I would also like to encourage you to replace the goto commands by the more modern commands like "break" (to exit a look), "continue" (to skip the rest of a loop and continue with the next index), or "exit" (to return from a subroutine)

Code: Pascal  [Select][+][-]
  1. procedure Tgtest.ShiftCells(acol, arow, up: integer);
  2. var
  3.   cc, nac, nhi, nmx, n, r, c: integer;
  4.   foundc, foundr: Integer;
  5. begin
  6.   with grid do begin
  7.     cc:=ColCount;
  8.  
  9.     // find highest non empty cell
  10.     foundc := -1;
  11.     foundr := -1;
  12.     for r:=Rowcount-1 downto 0 do
  13.     begin
  14.       for c:=cc-1 downto 0 do begin
  15.         if (Cells[c, r] <> '' then
  16.         begin
  17.           foundc := c;
  18.           foundr := r;
  19.           break;
  20.         end;
  21.       end;
  22.       if (foundc <> -1) or (foundr <> -1) then break;
  23.     end;
  24.  
  25.     if (foundc = -1) and (foundr = -1) then
  26.       exit;
  27.  
  28.     // cells are numbered by n = row*colcount + col    (first horizontal, then vertical)
  29.     nhi := foundr*cc+foundc;
  30.     nac :=arow*cc+acol;
  31.     nmx :=RowCount*cc;
  32.   ...
Mainly Lazarus trunk / fpc 3.2.0 / all 32-bit on Win-10, but many more...

perAspera

  • New Member
  • *
  • Posts: 11
Re: TStringGrid : delete/insert cell (contents)
« Reply #4 on: December 01, 2021, 03:25:14 pm »
Thanks for the immediate help!
Key:=0 fixed the problem, wp! I didn't know how to "eat" the Key to avoid that it is no longer handled by KeyPressed. But of course, it's a variable, so I can change it! Now the code behaves as it should  :)

Thank you too for pointing to the flaws of my ugly "goto" construction and for the elegant rewrite of the code. I had assumed that the variables remain defined when jumping out of a for-loop, but I understand, it's better to change this in all places. Parts of this code are quite old...
Thank you very much!





perAspera

  • New Member
  • *
  • Posts: 11
Re: TStringGrid : delete/insert cell (contents)
« Reply #5 on: December 01, 2021, 03:28:51 pm »
... and a silly Newbie question: is there a button to set the topic to [SOLVED] or do I have to modify the entry?

dsiders

  • Hero Member
  • *****
  • Posts: 634
Re: TStringGrid : delete/insert cell (contents)
« Reply #6 on: December 01, 2021, 03:40:14 pm »
... and a silly Newbie question: is there a button to set the topic to [SOLVED] or do I have to modify the entry?

Not silly at all. The forum software does not have that feature. You have to modify the original post to include '[SOLVED]'.
Lazarus 2.0.12, 2.2.0, 2.2.2, 2.3.0 (Git) / FPC 3.2.0, 3.2.2, 3.3.1 / x86 64-bit / Windows 8.1
Preview Lazarus 2.3.0 documentation at: https://dsiders.gitlab.io/lazdocsnext

perAspera

  • New Member
  • *
  • Posts: 11
Re: [SOLVED] TStringGrid : delete/insert cell (contents)
« Reply #7 on: December 01, 2021, 03:43:55 pm »
Done. Thank you!

 

TinyPortal © 2005-2018