{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 table
begin
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.