Forum > LCL

[SOLVED] TStringGrid : delete/insert cell (contents)

(1/2) > >>

perAspera:
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  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---{simple test program- Cells of TstringGrid are filled with some strings- CTRL + INSERT should insert an empty cell before the selected on and  shift up the cells above. This works.- CTRL + DELETE should delete the selected cell and shift down the cells above.  This does NOT work. The selected cell SHOULD show the content of the next cell,  but it shows empty.  workaround is to save the content and restore it on KeyUP, but this is weird.  (--> uncomment line in gridKeyUp)} unit gtest; {$MODE Delphi} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Grids,  LCLIntf, LCLType, StdCtrls, ExtCtrls, Types; type   Tgtest = class(TForm)    grid: TStringGrid;    Label1: TLabel;    procedure drawCell(Sender: TObject; ACol, ARow: Integer;       Rect: TRect; State: TGridDrawState);    procedure FormCreate(Sender: TObject);    procedure gridKeyDown(Sender: TObject; var Key: Word;       Shift: TShiftState);    procedure gridKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);   private    procedure ShiftCells(acol, arow, up: integer);  public    procedure Init;  end; var  gtest1: Tgtest;  savedcell: string; implementation {$R *.lfm} procedure Tgtest.Init;const  defcols=5;  np=20;  { some dummy content (Nietzsche, Nach neuen Meeren)}  poem : array[0..np] of string = ('Dorthin - ', 'will', 'ich;','und','ich','traue',    'mir', 'fortan', 'und', ' meinem', ' Griff.',    'Offen', ' liegt', ' das', ' Meer,', ' in''s', 'Blaue',    'treibt', 'mein', 'Genueser', 'Schiff.'); var  irow, icol, icount: word; begin// fill the poem into the cells and adjust grid size:  grid.Options:=[goVertLine, goHorzLine, goEditing{, goTabs}];  with grid do begin    ColCount:=defcols;// make sure to have enough rows:    RowCount:=np div defcols + 1;    icount:=0;    while icount <= np do begin      irow:=icount div ColCount;      icol:=icount mod ColCount;      Cells[icol, irow]:=poem[icount];      Inc(icount);    end;    for icount:=icol+1 to ColCount-1 do begin      Cells[icount, irow]:='';    end;  end;end;  procedure Tgtest.drawCell(Sender: TObject; ACol, ARow: Integer;  Rect: TRect; State: TGridDrawState);var  b, c: TColor;begin  with grid.Canvas do  begin//only for testing: show cell differently if it contains an 'a'...      if Pos('a', grid.Cells[Acol,Arow])>0 then begin      Brush.Color:=clFuchsia; Font.Color:=clWhite;    end else begin      Brush.Color:=clWhite; Font.Color:=clBlue;    end;    FillRect(Rect);    TextOut(Rect.Left+2, Rect.Top+2, grid.Cells[ACol, ARow]);  end;end; procedure Tgtest.FormCreate(Sender: TObject);begin  Init;end;  procedure Tgtest.ShiftCells(acol, arow, up: integer); var  cc, nac, nhi, nmx, n, r, c: integer;  tmp:string; label foundhighest, exit_all_empty; begin{ shift the content of cells above the selected one down or up, to delete or  insert a word from the content}  with grid do begin    cc:=ColCount;// find highest non empty cell    for r:=Rowcount-1 downto 0 do for c:=ColCount-1 downto 0 do begin      if length(Cells[c, r]) > 0 then goto foundhighest;    end;    goto exit_all_empty;     foundhighest:// cells are numbered by n = row*colcount + col    nhi :=r*cc+c;    nac :=arow*cc+acol;    nmx :=RowCount*cc;// delete: shift cells down    case up of    -1:begin        if nhi >=0 then begin// save content of cell which should go to deleted          if nac<nhi then savedcell:=Cells[(nac+1) mod cc, (nac+1) div cc];          for n:=nac to nhi-1 do begin            Cells[n mod cc, n div cc]:=Cells[(n+1) mod cc, (n+1) div cc];          end;          Cells[nhi mod cc, nhi div cc]:='';          RowCount:=nhi div cc+1;        end;      end;// insert: shift cells up     1:begin        RowCount:=(nhi+2) div cc +1;        for n:=nhi downto nac do begin          Cells[(n+1) mod cc, (n+1) div cc]:=Cells[n mod cc, n div cc];        end;        Cells[acol, arow]:='';       end;     else    end;     refresh;     exit_all_empty:  end;end; {--------------------------------------------------------------------} procedure Tgtest.gridKeyDown(Sender: TObject; var Key: Word;  Shift: TShiftState);// press CTRL INSERT / DELETE to insert or delete cells in tablebegin  if ssCtrl in Shift then begin    if Key  = VK_INSERT then begin      ShiftCells(grid.Col, grid.Row,1);    end;    if Key  = VK_DELETE then begin      ShiftCells(grid.Col, grid.Row,-1);    end;  end;end; procedure Tgtest.gridKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin  if (ssCtrl in Shift) and (Key  = VK_DELETE) then begin { uncommenting activates a the weird workaround to restore the content of the   selected cell, which otherwise becomes blank :}//    grid.Cells[grid.col,grid.row]:=savedCell;  end;end; {--------------------------------------------------------------------} end.  
--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---program project1; //{$mode objfpc}{$H+}  {$mode Delphi}uses  {$IFDEF UNIX}{$IFDEF UseCThreads}  cthreads,  {$ENDIF}{$ENDIF}  Interfaces, // this includes the LCL widgetset  Forms, gtest  { you can add units after this }; {$R *.res} begin  RequireDerivedFormResource:=True;  Application.Scaled:=True;  Application.Initialize;  Application.CreateForm(Tgtest, gtest1);  Application.Run;end.                    

wp:
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.

perAspera:
Thanks for the hint - here it is!

jamie:
One item that sticks out is that you are using Variables from the FOR Loop counter outside the loop later on in the source to calculate location.
 
   It's clearly documented in pascal rules to not rely on the value of those variables outside the loop because they are considered as undefined and the compiler can basically handle it as it wishes, meaning different optimizing levels that will only work within the loop will be valid and those counter values make be different than what you would think outside the loop.

 You first need to fix that to ensure your code isn't running into this. Delphi could be generating the values for that you expect just out of luck.

wp:
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  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---procedure Tgtest.gridKeyDown(Sender: TObject; var Key: Word;  Shift: TShiftState);// press CTRL INSERT / DELETE to insert or delete cells in tablebegin  if ssCtrl in Shift then begin    if Key  = VK_INSERT then begin      ShiftCells(grid.Col, grid.Row,1);      Key := 0;    end;    if Key  = VK_DELETE then begin      ShiftCells(grid.Col, grid.Row,-1);      Key := 0;    end;  end;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  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---procedure Tgtest.ShiftCells(acol, arow, up: integer);var  cc, nac, nhi, nmx, n, r, c: integer;  foundc, foundr: Integer;begin  with grid do begin    cc:=ColCount;     // find highest non empty cell    foundc := -1;    foundr := -1;    for r:=Rowcount-1 downto 0 do     begin      for c:=cc-1 downto 0 do begin        if (Cells[c, r] <> '' then        begin          foundc := c;          foundr := r;          break;        end;      end;      if (foundc <> -1) or (foundr <> -1) then break;    end;     if (foundc = -1) and (foundr = -1) then      exit;     // cells are numbered by n = row*colcount + col    (first horizontal, then vertical)    nhi := foundr*cc+foundc;    nac :=arow*cc+acol;    nmx :=RowCount*cc;   ...

Navigation

[0] Message Index

[#] Next page

Go to full version