diff --git a/components/fpspreadsheet/examples/spready/mainform.lfm b/components/fpspreadsheet/examples/spready/mainform.lfm index d795025fa..806fe0c85 100644 --- a/components/fpspreadsheet/examples/spready/mainform.lfm +++ b/components/fpspreadsheet/examples/spready/mainform.lfm @@ -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 diff --git a/components/fpspreadsheet/examples/spready/mainform.pas b/components/fpspreadsheet/examples/spready/mainform.pas index 85f7ffe8e..d648a33f4 100644 --- a/components/fpspreadsheet/examples/spready/mainform.pas +++ b/components/fpspreadsheet/examples/spready/mainform.pas @@ -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 diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index 62c325586..061fec41a 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -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, ''); diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index a70438237..f22d96a21 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -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 diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas index 003848b3a..c938c0530 100644 --- a/components/fpspreadsheet/fpspreadsheetgrid.pas +++ b/components/fpspreadsheet/fpspreadsheetgrid.pas @@ -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.