pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Delete columns and rows from Worksheet and WorksheetGrid

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3571 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-09-16 15:03:17 +00:00
parent eb4dbd80e5
commit 10ad6b7a1a
5 changed files with 335 additions and 53 deletions
Download Patch File Download Diff File Expand all files Collapse all files

49
components/fpspreadsheet/examples/spready/mainform.lfm
View File

@ -123,7 +123,7 @@ object MainFrm: TMainFrm
Action = AcSaveAs
end
object ToolButton3: TToolButton
Left = 149
Left = 200
Top = 0
Action = AcQuit
end
@ -140,7 +140,7 @@ object MainFrm: TMainFrm
Action = AcEdit
end
object ToolButton6: TToolButton
Left = 144
Left = 98
Top = 0
Width = 5
Caption = 'ToolButton6'
@ -152,15 +152,32 @@ object MainFrm: TMainFrm
Action = AcNew
end
object ToolButton23: TToolButton
Left = 98
Left = 103
Top = 0
Action = AcAddColumn
end
object ToolButton27: TToolButton
Left = 121
Left = 126
Top = 0
Action = AcAddRow
end
object ToolButton29: TToolButton
Left = 149
Top = 0
Action = AcDeleteColumn
end
object ToolButton30: TToolButton
Left = 172
Top = 0
Action = AcDeleteRow
end
object ToolButton31: TToolButton
Left = 195
Top = 0
Width = 5
Caption = 'ToolButton31'
Style = tbsDivider
end
end
object FormatToolBar: TToolBar
Left = 0
@ -456,7 +473,6 @@ object MainFrm: TMainFrm
AutoAdvance = aaDown
BorderStyle = bsNone
ColCount = 27
ExtendedSelect = False
MouseWheelOption = mwGrid
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goRowSizing, goColSizing, goThumbTracking, goSmoothScroll, goFixedColSizing]
RowCount = 101
@ -800,6 +816,15 @@ object MainFrm: TMainFrm
FF00A2AE8EFF5F9771FF4F8E66FF49895FFFA2AE8EFFFFFFFF00
}
end
object MenuItem72: TMenuItem
Caption = '-'
end
object MenuItem73: TMenuItem
Action = AcDeleteColumn
end
object MenuItem74: TMenuItem
Action = AcDeleteRow
end
end
object mnuFormat: TMenuItem
Caption = 'Format'
@ -3036,6 +3061,20 @@ object MainFrm: TMainFrm
Hint = 'Show/hide grid lines'
OnExecute = AcShowGridlinesExecute
end
object AcDeleteColumn: TAction
Category = 'Edit'
Caption = 'Delete column'
Hint = 'Delete column'
ImageIndex = 38
OnExecute = AcDeleteColumnExecute
end
object AcDeleteRow: TAction
Category = 'Edit'
Caption = 'Delete row'
Hint = 'Delete row'
ImageIndex = 37
OnExecute = AcDeleteRowExecute
end
end
object FontDialog: TFontDialog
MinFontSize = 0

28
components/fpspreadsheet/examples/spready/mainform.pas
View File

@ -75,6 +75,8 @@ type
AcMergeCells: TAction;
AcShowHeaders: TAction;
AcShowGridlines: TAction;
AcDeleteColumn: TAction;
AcDeleteRow: TAction;
AcViewInspector: TAction;
AcWordwrap: TAction;
AcVAlignDefault: TAction;
@ -161,6 +163,9 @@ type
MenuItem69: TMenuItem;
MenuItem70: TMenuItem;
MenuItem71: TMenuItem;
MenuItem72: TMenuItem;
MenuItem73: TMenuItem;
MenuItem74: TMenuItem;
mnuInspector: TMenuItem;
mnuView: TMenuItem;
MnuFmtDateTimeMSZ: TMenuItem;
@ -223,6 +228,9 @@ type
ToolButton27: TToolButton;
CellInspector: TValueListEditor;
ToolButton28: TToolButton;
ToolButton29: TToolButton;
ToolButton30: TToolButton;
ToolButton31: TToolButton;
WorksheetGrid: TsWorksheetGrid;
ToolBar1: TToolBar;
FormatToolBar: TToolBar;
@ -256,6 +264,8 @@ type
procedure AcAddRowExecute(Sender: TObject);
procedure AcBorderExecute(Sender: TObject);
procedure AcCopyFormatExecute(Sender: TObject);
procedure AcDeleteColumnExecute(Sender: TObject);
procedure AcDeleteRowExecute(Sender: TObject);
procedure AcEditExecute(Sender: TObject);
procedure AcFontExecute(Sender: TObject);
procedure AcFontStyleExecute(Sender: TObject);
@ -473,6 +483,24 @@ begin
end;
end;
procedure TMainFrm.AcDeleteColumnExecute(Sender: TObject);
var
c: Integer;
begin
c := WorksheetGrid.Col;
WorksheetGrid.DeleteCol(c);
WorksheetGrid.Col := c;
end;
procedure TMainFrm.AcDeleteRowExecute(Sender: TObject);
var
r: Integer;
begin
r := WorksheetGrid.Row;
WorksheetGrid.DeleteRow(r);
WorksheetGrid.Row := r;
end;
{ Changes the font of the selected cell by calling a standard font dialog. }
procedure TMainFrm.AcFontExecute(Sender: TObject);
begin

2
components/fpspreadsheet/fpsopendocument.pas
View File

@ -3066,8 +3066,8 @@ begin
cell := ASheet.FindCell(r, c);
// Belongs to merged block?
// if (cell <> nil) and not FWorksheet.IsMergeBase(cell) and (cell^.MergedNeighbors <> []) then
if (cell <> nil) and not FWorksheet.IsMergeBase(cell) and (cell^.MergeBase <> nil) then
// this means: all cells of a merged block except for the merge base
begin
AppendToStream(AStream,
'<table:covered-table-cell />');

282
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -93,59 +93,13 @@ type
{ Functions - they are identified by their name }
fekFunc
);
(*
TFEKind = (
{ Basic operands }
fekCell, fekCellRef, fekCellRange, fekCellOffset, fekNum, fekInteger,
fekString, fekBool, fekErr, fekMissingArg,
{ Basic operations }
fekAdd, fekSub, fekMul, fekDiv, fekPercent, fekPower, fekUMinus, fekUPlus,
fekConcat, // string concatenation
fekEqual, fekGreater, fekGreaterEqual, fekLess, fekLessEqual, fekNotEqual,
fekParen,
{ Built-in/Worksheet Functions}
// math
fekABS, fekACOS, fekACOSH, fekASIN, fekASINH, fekATAN, fekATANH,
fekCOS, fekCOSH, fekDEGREES, fekEXP, fekINT, fekLN, fekLOG,
fekLOG10, fekPI, fekRADIANS, fekRAND, fekROUND,
fekSIGN, fekSIN, fekSINH, fekSQRT,
fekTAN, fekTANH,
// date/time
fekDATE, fekDATEDIF, fekDATEVALUE, fekDAY, fekHOUR, fekMINUTE, fekMONTH,
fekNOW, fekSECOND, fekTIME, fekTIMEVALUE, fekTODAY, fekWEEKDAY, fekYEAR,
// statistical
fekAVEDEV, fekAVERAGE, fekBETADIST, fekBETAINV, fekBINOMDIST, fekCHIDIST,
fekCHIINV, fekCOUNT, fekCOUNTA, fekCOUNTBLANK, fekCOUNTIF,
fekMAX, fekMEDIAN, fekMIN, fekPERMUT, fekPOISSON, fekPRODUCT,
fekSTDEV, fekSTDEVP, fekSUM, fekSUMIF, fekSUMSQ, fekVAR, fekVARP,
// financial
fekFV, fekNPER, fekPMT, fekPV, fekRATE,
// logical
fekAND, fekFALSE, fekIF, fekNOT, fekOR, fekTRUE,
// string
fekCHAR, fekCODE, fekLEFT, fekLOWER, fekMID, fekPROPER, fekREPLACE, fekRIGHT,
fekSUBSTITUTE, fekTRIM, fekUPPER,
// lookup/reference
fekCOLUMN, fekCOLUMNS, fekROW, fekROWS,
// info
fekCELLINFO, fekINFO, fekIsBLANK, fekIsERR, fekIsERROR,
fekIsLOGICAL, fekIsNA, fekIsNONTEXT, fekIsNUMBER, fekIsRef, fekIsTEXT,
fekValue,
{ Other operations }
fekOpSUM {Unary sum operation. Note: CANNOT be used for summing sell contents; use fekSUM}
);
*)
{@@ These tokens identify operands in RPN formulas. }
TOperandTokens = fekCell..fekMissingArg;
{@@ These tokens identify basic operations in RPN formulas. }
TBasicOperationTokens = fekAdd..fekParen;
(*
{@@ These tokens identify spreadsheet functions in RPN formulas. }
TFuncTokens = fekAbs..fekOpSum;
*)
{@@ Flags to mark the address or a cell or a range of cells to be absolute
or relative. They are used in the set TsRelFlags. }
TsRelFlag = (rfRelRow, rfRelCol, rfRelRow2, rfRelCol2);
@ -535,6 +489,8 @@ type
{ Callback procedures called when iterating through all cells }
procedure CalcFormulaCallback(data, arg: Pointer);
procedure CalcStateCallback(data, arg: Pointer);
procedure DeleteColCallback(data, arg: Pointer);
procedure DeleteRowCallback(data, arg: Pointer);
procedure InsertColCallback(data, arg: Pointer);
procedure InsertRowCallback(data, arg: Pointer);
procedure RemoveCallback(data, arg: pointer);
@ -545,6 +501,8 @@ type
procedure ChangedCell(ARow, ACol: Cardinal);
procedure ChangedFont(ARow, ACol: Cardinal);
procedure RemoveCell(ARow, ACol: Cardinal);
public
{@@ Name of the sheet. In the popular spreadsheet applications this is
displayed at the tab of the sheet. }
@ -758,6 +716,8 @@ type
function GetRowHeight(ARow: Cardinal): Single;
function GetCol(ACol: Cardinal): PCol;
function GetColWidth(ACol: Cardinal): Single;
procedure DeleteCol(ACol: Cardinal);
procedure DeleteRow(ARow: Cardinal);
procedure InsertCol(ACol: Cardinal);
procedure InsertRow(ARow: Cardinal);
procedure RemoveAllRows;
@ -2070,6 +2030,116 @@ begin
CopyFormat(AFormat, GetCell(AToRow, AToCol));
end;
{@@ Internal call-back procedure for looping through all cells when deleting
a specified column. Deletion happens in DeleteCol BEFORE this callback! }
procedure TsWorksheet.DeleteColCallback(data, arg: Pointer);
var
cell: PCell;
col: PtrInt;
fe: TsFormulaElement;
formula: TsRPNFormula;
i: Integer;
begin
col := PtrInt(arg);
cell := PCell(data);
if cell = nil then // This should not happen. Just to make sure...
exit;
// Update column index of moved cell
if (cell^.Col > col) then
dec(cell^.Col);
// Update formulas
if HasFormula(cell) then
begin
// (1) create an rpn formula
formula := BuildRPNFormula(cell);
// (2) update cell addresses affected by the deletion of the column
for i:=0 to High(formula) do
begin
fe := formula[i]; // "fe" means "formula element"
if (fe.ElementKind in [fekCell, fekCellRef, fekCellRange]) then
begin
if fe.Col = col then
begin
fe.ElementKind := fekErr;
fe.IntValue := ord(errIllegalRef);
end else
if fe.Col > col then
dec(fe.Col);
if (fe.ElementKind = fekCellRange) then
begin
if (fe.Col2 = col) then
begin
fe.ElementKind := fekErr;
fe.IntValue := ord(errIllegalRef);
end
else
if (fe.Col2 > col) then
dec(fe.Col2);
end;
end;
end;
// (3) convert rpn formula back to string formula
cell^.FormulaValue := ConvertRPNFormulaToStringFormula(formula);
end;
end;
{@@ Internal call-back procedure for looping through all cells when deleting
a specified row. Deletion happens in DeleteRow BEFORE this callback! }
procedure TsWorksheet.DeleteRowCallback(data, arg: Pointer);
var
cell: PCell;
row: PtrInt;
fe: TsFormulaElement;
formula: TsRPNFormula;
i: Integer;
begin
row := PtrInt(arg);
cell := PCell(data);
if cell = nil then // This should not happen. Just to make sure...
exit;
// Update row index of moved cell
if (cell^.Row > row) then
dec(cell^.Row);
// Update formulas
if HasFormula(cell) then
begin
// (1) create an rpn formula
formula := BuildRPNFormula(cell);
// (2) update cell addresses affected by the deletion of the column
for i:=0 to High(formula) do
begin
fe := formula[i]; // "fe" means "formula element"
if (fe.ElementKind in [fekCell, fekCellRef, fekCellRange]) then
begin
if fe.Row = row then
begin
fe.ElementKind := fekErr;
fe.IntValue := ord(errIllegalRef);
end else
if fe.Row > row then
dec(fe.Row);
if (fe.ElementKind = fekCellRange) then
begin
if (fe.Row2 = row) then
begin
fe.ElementKind := fekErr;
fe.IntValue := ord(errIllegalRef);
end
else
if (fe.Row2 > row) then
dec(fe.Row2);
end;
end;
end;
// (3) convert rpn formula back to string formula
cell^.FormulaValue := ConvertRPNFormulaToStringFormula(formula);
end;
end;
{@@
Tries to locate a Cell in the list of already written Cells
@ -3175,6 +3245,24 @@ begin
FCells.Clear;
end;
{@@
Removes a cell and releases its memory.
Just for internal usage since it does not modify the other cells affects
}
procedure TsWorksheet.RemoveCell(ARow, ACol: Cardinal);
var
cellnode: TAVLTreeNode;
cell: TCell;
begin
cell.Row := ARow;
cell.Col := ACol;
cellnode := FCells.Find(@cell);
if cellnode <> nil then begin
Dispose(PCell(cellnode.Data));
FCells.Delete(cellnode);
end;
end;
{@@
Helper method to update internal caching variables
}
@ -5064,6 +5152,106 @@ begin
end;
end;
{@@
Deletes the column at the index specified. Cells with greader column indexes are
moved one column to the left. Merged cell blocks and cell references in formulas
are considered as well.
@param ACol Index of the column to be deleted
}
procedure TsWorksheet.DeleteCol(ACol: Cardinal);
var
cellnode: TAVLTreeNode;
col: PCol;
i: Integer;
r, c, rr, cc: Cardinal;
r1, c1, r2, c2: Cardinal;
cell, nextcell: PCell;
begin
// Fix merged cells: If the deleted column is the first column of a merged
// block the merge base has to be set to the second cell.
for r := 0 to GetLastRowIndex do
begin
cell := FindCell(r, ACol);
if IsMergeBase(cell) then begin
FindMergedRange(cell, r1, c1, r2, c2);
nextCell := FindCell(r, c1 + 1);
for rr := r1 to r2 do
for cc := c1+1 to c2 do
begin
cell := FindCell(rr, cc);
cell^.MergeBase := nextcell;
end;
end;
end;
// Delete cells
for r := GetLastRowIndex downto 0 do
RemoveCell(r, ACol);
// Update column index of cell reocrds
cellnode := FCells.FindLowest;
while Assigned(cellnode) do begin
DeleteColCallback(cellnode.Data, pointer(PtrInt(ACol)));
cellnode := FCells.FindSuccessor(cellnode);
end;
// Update last column index
dec(FLastColIndex);
ChangedCell(0, ACol);
end;
{@@
Deletes the row at the index specified. Cells with greader row indexes are
moved one row up. Merged cell blocks and cell references in formulas
are considered as well.
@param ARow Index of the row to be deleted
}
procedure TsWorksheet.DeleteRow(ARow: Cardinal);
var
cellnode: TAVLTreeNode;
row: PRow;
i: Integer;
r, c, rr, cc: Cardinal;
r1, c1, r2, c2: Cardinal;
cell, nextcell: PCell;
begin
// Fix merged cells: If the deleted row is the first row of a merged
// block the merge base has to be set to the begin of the second row.
for c := 0 to GetLastRowIndex do
begin
cell := FindCell(ARow, c);
if IsMergeBase(cell) then begin
FindMergedRange(cell, r1, c1, r2, c2);
nextCell := FindCell(r1 + 1, c1);
for rr := r1+1 to r2 do
for cc := c1 to c2 do
begin
cell := FindCell(rr, cc);
cell^.MergeBase := nextcell;
end;
end;
end;
// Delete cells
for c := GetLastColIndex downto 0 do
RemoveCell(ARow, c);
// Update row index of cell reocrds
cellnode := FCells.FindLowest;
while Assigned(cellnode) do begin
DeleteRowCallback(cellnode.Data, pointer(PtrInt(ARow)));
cellnode := FCells.FindSuccessor(cellnode);
end;
// Update last row index
dec(FLastRowIndex);
ChangedCell(ARow, 0);
end;
{@@
Inserts a column BEFORE the index specified. Cells with greater column indexes are
moved one column to the right. Merged cell blocks and cell references in formulas

27
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -175,6 +175,8 @@ type
destructor Destroy; override;
procedure BeginUpdate;
procedure DefaultDrawCell(ACol, ARow: Integer; var ARect: TRect; AState: TGridDrawState); override;
procedure DeleteCol(AGridCol: Integer);
procedure DeleteRow(AGridRow: Integer);
procedure EditingDone; override;
procedure EndUpdate;
procedure GetSheets(const ASheets: TStrings);
@ -1033,6 +1035,31 @@ begin
end;
end;
{@@
Deletes the column specified.
}
procedure TsCustomWorksheetGrid.DeleteCol(AGridCol: Integer);
begin
if AGridCol < FHeaderCount then
exit;
FWorksheet.DeleteCol(GetWorksheetCol(AGridCol));
UpdateColWidths(AGridCol);
end;
{@@
Deletes the row specified.
}
procedure TsCustomWorksheetGrid.DeleteRow(AGridRow: Integer);
begin
if AGridRow < FHeaderCount then
exit;
FWorksheet.DeleteRow(GetWorksheetRow(AGridRow));
UpdateRowHeights(AGridRow);
end;
{@@
Creates a new empty workbook into which a file will be loaded. Destroys the
previously used workbook.