diff --git a/components/fpspreadsheet/fpsclasses.pas b/components/fpspreadsheet/fpsclasses.pas index 894af9d4e..b03420510 100644 --- a/components/fpspreadsheet/fpsclasses.pas +++ b/components/fpspreadsheet/fpsclasses.pas @@ -19,6 +19,7 @@ type TsRowColAVLTree = class(TAVLTree) private FOwnsData: Boolean; + FCurrentNode: TAVLTreeNode; protected procedure DisposeData(var AData: Pointer); virtual; abstract; function NewData: Pointer; virtual; abstract; @@ -28,8 +29,10 @@ type function Add(ARow, ACol: Cardinal): PsRowCol; procedure Clear; procedure Delete(ANode: TAVLTreeNode); - procedure DeleteRowOrCol(AIndex: Cardinal; IsRow: Boolean); + procedure DeleteRowOrCol(AIndex: Cardinal; IsRow: Boolean); virtual; function Find(ARow, ACol: Cardinal): PsRowCol; + function GetFirst: PsRowCol; + function GetNext: PsRowCol; procedure InsertRowOrCol(AIndex: Cardinal; IsRow: Boolean); procedure Remove(ARow, ACol: Cardinal); end; @@ -54,6 +57,17 @@ type procedure DeleteHyperlink(ARow, ACol: Cardinal); end; + { TsMergedCells } + TsMergedCells = class(TsRowColAVLTree) + protected + procedure DisposeData(var AData: Pointer); override; + function NewData: Pointer; override; + public + function AddRange(ARow1, ACol1, ARow2, ACol2: Cardinal): PsCellRange; + procedure DeleteRange(ARow, ACol: Cardinal); + procedure DeleteRowOrCol(AIndex: Cardinal; IsRow: Boolean); override; + function FindRangeWithCell(ARow, ACol: Cardinal): PsCellRange; + end; implementation @@ -196,6 +210,28 @@ begin Result := PsRowCol(node.Data); end; +{@@ ---------------------------------------------------------------------------- + The combination of the methods GetFirst and GetNext allow a fast iteration + through all nodes of the tree. +-------------------------------------------------------------------------------} +function TsRowColAVLTree.GetFirst: PsRowCol; +begin + FCurrentNode := FindLowest; + if FCurrentNode <> nil then + Result := PsRowCol(FCurrentNode.Data) + else + Result := nil; +end; + +function TsRowColAVLTree.GetNext: PsRowCol; +begin + FCurrentNode := FindSuccessor(FCurrentNode); + if FCurrentNode <> nil then + Result := PsRowCol(FCurrentNode.Data) + else + Result := nil; +end; + {@@ ---------------------------------------------------------------------------- This procedure adjusts row or column indexes stored in the tree nodes if a row or column will be inserted into the underlying worksheet. @@ -335,5 +371,128 @@ begin Result := hyperlink; end; + +{******************************************************************************} +{ TsMergedCell: a AVLTree to store merged cell range records for cells } +{******************************************************************************} + +{@@ ---------------------------------------------------------------------------- + Adds a node with a new merge cell range record to the tree. If a node already + exists then its data will be replaced by the specified ones. + Returns a pointer to the cell range record. +-------------------------------------------------------------------------------} +function TsMergedCells.AddRange(ARow1, ACol1, ARow2, ACol2: Cardinal): PsCellRange; +begin + Result := PsCellRange(Add(ARow1, ACol1)); + Result^.Row2 := ARow2; + Result^.Col2 := ACol2; +end; + +{@@ ---------------------------------------------------------------------------- + Deletes the node for which the top/left corner of the cell range matches the + specified parameters. There is only a single range fulfilling this criterion. +-------------------------------------------------------------------------------} +procedure TsMergedCells.DeleteRange(ARow, ACol: Cardinal); +begin + Remove(ARow, ACol); +end; + +{@@ ---------------------------------------------------------------------------- + This procedure adjusts row or column indexes stored in the tree nodes if a + row or column will be deleted from the underlying worksheet. + + @param AIndex Index of the row (if IsRow=true) or column (if IsRow=false) + to be deleted + @param IsRow Identifies whether AIndex refers to a row or column index +-------------------------------------------------------------------------------} +procedure TsMergedCells.DeleteRowOrCol(AIndex: Cardinal; IsRow: Boolean); +var + rng, nextrng: PsCellRange; +begin + rng := PsCellRange(GetFirst); + while Assigned(rng) do begin + nextrng := PsCellRange(GetNext); + if IsRow then + begin + // Deleted row is above the merged range --> Shift entire range up by 1 + // NOTE: + // The "merged" flags do not have to be changed, they move with the cells. + if (AIndex < rng^.Row1) then begin + dec(rng^.Row1); + dec(rng^.Row2); + end else + // Single-row merged block coincides with row to be deleted + if (AIndex = rng^.Row1) and (rng^.Row1 = rng^.Row2) then + DeleteRange(rng^.Row1, rng^.Col1) + else + // Deleted row runs through the merged block --> Shift bottom row up by 1 + // NOTE: The "merged" flags disappear with the deleted cells + if (AIndex >= rng^.Row1) and (AIndex <= rng^.Row2) then + dec(rng^.Row2); + end else + begin + // Deleted column is at the left of the merged range + // --> Shift entire merged range to the left by 1 + // NOTE: + // The "merged" flags do not have to be changed, they move with the cells. + if (AIndex < rng^.Col1) then begin + dec(rng^.Col1); + dec(rng^.Col2); + end else + // Single-column block coincides with the column to be deleted + // NOTE: The "merged" flags disappear with the deleted cells + if (AIndex = rng^.Col1) and (rng^.Col1 = rng^.Col2) then + DeleteRange(rng^.Row1, rng^.Col1) + else + // Deleted column runs through the merged block + // --> Shift right column to the left by 1 + if (AIndex >= rng^.Col1) and (AIndex <= rng^.Col2) then + dec(rng^.Col2); + end; + // Proceed with next merged range + rng := nextrng; + end; +end; + +{@@ ---------------------------------------------------------------------------- + Helper procedure which disposes the memory occupied by the merged cell range + data record attached to a tree node. +-------------------------------------------------------------------------------} +procedure TsMergedCells.DisposeData(var AData: Pointer); +begin + if AData <> nil then + Dispose(PsCellRange(AData)); + AData := nil; +end; + +{@@ ---------------------------------------------------------------------------- + Finds the cell range which contains the cell specified by its row and column + index +-------------------------------------------------------------------------------} +function TsMergedCells.FindRangeWithCell(ARow, ACol: Cardinal): PsCellRange; +var + node: TAVLTreeNode; +begin + node := FindLowest; + while Assigned(node) do + begin + Result := PsCellRange(node.Data); + if (ARow >= Result^.Row1) and (ARow <= Result^.Row2) and + (ACol >= Result^.Col1) and (ACol <= Result^.Col2) then exit; + node := FindSuccessor(node); + end; +end; + +{@@ ---------------------------------------------------------------------------- + Alloates memory of a merged cell range data record. +-------------------------------------------------------------------------------} +function TsMergedCells.NewData: Pointer; +var + range: PsCellRange; +begin + New(range); + Result := range; +end; + end. diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index e3078c8d5..e7ec5afc1 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -126,7 +126,7 @@ type FName: String; // Name of the worksheet (displayed at the tab) FCells: TAvlTree; // Items are TCell FComments: TsComments; - FMergedCells: TAvlTree; // Items are TsCellRange + FMergedCells: TsMergedCells; FHyperlinks: TsHyperlinks; FCurrentNode: TAVLTreeNode; // for GetFirstCell and GetNextCell FRows, FCols: TIndexedAVLTree; // This lists contain only rows or cols with styles different from default @@ -159,10 +159,7 @@ type procedure DeleteRowCallback(data, arg: Pointer); procedure InsertColCallback(data, arg: Pointer); procedure InsertRowCallback(data, arg: Pointer); - procedure RemoveCellRangesCallback(data, arg: pointer); procedure RemoveCellsCallback(data, arg: pointer); -// procedure RemoveCommentsCallback(data, arg: pointer); -// procedure RemoveHyperlinksCallback(data, arg: pointer); protected function CellUsedInFormula(ARow, ACol: Cardinal): Boolean; @@ -172,13 +169,6 @@ type function RemoveCell(ARow, ACol: Cardinal): PCell; procedure RemoveAndFreeCell(ARow, ACol: Cardinal); - // Merged cells - function CellIsInMergedRange(ARow, ACol: Cardinal; ARange: PsCellRange): Boolean; - function FindMergedRangeForBase(ABaseRow, ABaseCol: Cardinal): PsCellRange; - function FindMergedRangeForCell(ARow, ACol: Cardinal): PsCellRange; - procedure RemoveAllMergedRanges; - procedure RemoveMergedRange(ABaseRow, ABaseCol: Cardinal); - // Sorting function DoCompareCells(ARow1, ACol1, ARow2, ACol2: Cardinal; ASortOptions: TsSortOptions): Integer; @@ -486,16 +476,15 @@ type ATooltip: String = ''); overload; { Merged cells } - procedure MergeCells(ARow1, ACol1, ARow2, ACol2: Cardinal); overload; - procedure MergeCells(ARange: String); overload; - procedure UnmergeCells(ARow, ACol: Cardinal); overload; - procedure UnmergeCells(ARange: String); overload; function FindMergeBase(ACell: PCell): PCell; function FindMergedRange(ACell: PCell; out ARow1, ACol1, ARow2, ACol2: Cardinal): Boolean; - procedure GetMergedCellRanges(out AList: TsCellRangeArray); + procedure MergeCells(ARow1, ACol1, ARow2, ACol2: Cardinal); overload; + procedure MergeCells(ARange: String); overload; function InSameMergedRange(ACell1, ACell2: PCell): Boolean; function IsMergeBase(ACell: PCell): Boolean; function IsMerged(ACell: PCell): Boolean; + procedure UnmergeCells(ARow, ACol: Cardinal); overload; + procedure UnmergeCells(ARange: String); overload; // Notification of changed cells content and format procedure ChangedCell(ARow, ACol: Cardinal); @@ -511,7 +500,7 @@ type {@@ List of all comment records } property Comments: TsComments read FComments; {@@ List of merged cells (contains TsCellRange records) } - property MergedCells: TAVLTree read FMergedCells; + property MergedCells: TsMergedCells read FMergedCells; {@@ List of hyperlink information records } property Hyperlinks: TsHyperlinks read FHyperlinks; {@@ FormatSettings for localization of some formatting strings } @@ -1150,7 +1139,7 @@ begin FRows := TIndexedAVLTree.Create(@CompareRows); FCols := TIndexedAVLTree.Create(@CompareCols); FComments := TsComments.Create; - FMergedCells := TAVLTree.Create(@CompareMergedCells); + FMergedCells := TsMergedCells.Create; FHyperlinks := TsHyperlinks.Create; FDefaultColWidth := 12; @@ -1178,7 +1167,6 @@ begin RemoveAllCells; RemoveAllRows; RemoveAllCols; - RemoveAllMergedRanges; FCells.Free; FRows.Free; @@ -3235,74 +3223,28 @@ begin end; end; -{@@ ---------------------------------------------------------------------------- - Checks whether the cell at ARow/ACol is in the specified merged cell block --------------------------------------------------------------------------------} -function TsWorksheet.CellIsInMergedRange(ARow, ACol: Cardinal; - ARange: PsCellRange): Boolean; -begin - Result := (ARange <> nil) and - (ARow >= ARange^.Row1) and (ARow <= ARange^.Row2) and - (ACol >= ARange^.Col1) and (ACol <= ARange^.Col2); -end; + +{ Merged cells } {@@ ---------------------------------------------------------------------------- - Retrieves the pointer to the cell range record of the merged block - which has the specified cell as base. - Returns nil if the specified cell is not the base of a merged block. + Finds the upper left cell of a merged block to which a specified cell belongs. + This is the "merge base". Returns nil if the cell is not merged. + + @param ACell Cell under investigation + @return A pointer to the cell in the upper left corner of the merged block + to which ACell belongs. + If ACell is isolated then the function returns nil. -------------------------------------------------------------------------------} -function TsWorksheet.FindMergedRangeForBase(ABaseRow, ABaseCol: Cardinal): PsCellRange; +function TsWorksheet.FindMergeBase(ACell: PCell): PCell; var - lCellRange: TsCellRange; - AVLNode: TAVLTreeNode; + rng: PsCellRange; begin Result := nil; - if FMergedCells.Count = 0 then - exit; - - lCellRange.Row1 := ABaseRow; - lCellRange.Col1 := ABaseCol; - AVLNode := FMergedCells.Find(@lCellRange); - if Assigned(AVLNode) then - Result := PsCellRange(AVLNode.Data); -end; - -{@@ ---------------------------------------------------------------------------- - Finds the pointer to a merged range record in the FMergedCells list to - which the specified cell belongs --------------------------------------------------------------------------------} -function TsWorksheet.FindMergedRangeForCell(ARow, ACol: Cardinal): PsCellRange; -var - AVLNode: TAVLTreeNode; -begin - // Iterate through all merged blocks in the list FMergedCells... - AVLNode := FMergedCells.FindLowest; - while AVLNode <> nil do begin - Result := PsCellRange(AVLNode.Data); - // ... and check if the current block contains the specified cell - if CellIsInMergedRange(ARow, ACol, Result) then - exit; - AVLNode := FMergedCells.FindSuccessor(AVLNode); - end; - Result := nil; -end; - -{@@ ---------------------------------------------------------------------------- - Removes and destroys a merged cell range record (i.e. unmerges the cells) --------------------------------------------------------------------------------} -procedure TsWorksheet.RemoveMergedRange(ABaseRow, ABaseCol: Cardinal); -var - lCellRange: TsCellRange; - AVLNode: TAVLTreeNode; -begin - lCellRange.Row1 := ABaseRow; - lCellRange.Col1 := ABaseCol; - AVLNode := FMergedCells.Find(@lCellRange); - if Assigned(AVLNode) then begin - // Destroy the cell range record - Dispose(PsCellRange(AVLNode.Data)); - // Delete the avl tree node. - FMergedCells.Delete(AVLNode); + if IsMerged(ACell) then + begin + rng := FMergedCells.FindRangeWithCell(ACell^.Row, ACell^.Col); + if rng <> nil then + Result := FindCell(rng^.Row1, rng^.Col1); end; end; @@ -3325,17 +3267,11 @@ begin exit; // Is cell ARow1/ACol1 already the base of a merged range? ... - rng := FindMergedRangeForBase(ARow1, ACol1); + rng := PsCellRange(FMergedCells.Find(ARow1, ACol1)); // ... no: --> Add a new merged range if rng = nil then - begin - New(rng); - rng^.Row1 := ARow1; - rng^.Col1 := ACol1; - rng^.Row2 := ARow2; - rng^.Col2 := ACol2; - FMergedCells.Add(rng); - end else + FMergedCells.AddRange(ARow1, ACol1, ARow2, ACol2) + else // ... yes: --> modify the merged range accordingly begin // unmark previously merged range @@ -3344,7 +3280,7 @@ begin begin cell := FindCell(r, c); if cell <> nil then // nil happens when col/row is inserted... - cell^.Flags := cell^.Flags - [cfMerged]; + Exclude(cell^.Flags, cfMerged); end; // Define new limits of merged range rng^.Row2 := ARow2; @@ -3356,7 +3292,7 @@ begin for c := ACol1 to ACol2 do begin cell := GetCell(r, c); // if not existent create new cell - cell^.Flags := cell^.Flags + [cfMerged]; + Include(cell^.Flags, cfMerged); end; ChangedCell(ARow1, ACol1); @@ -3390,7 +3326,7 @@ var r, c: Cardinal; cell: PCell; begin - rng := FindMergedRangeForCell(ARow, ACol); + rng := FMergedCells.FindRangeWithCell(ARow, ACol); if rng <> nil then begin // Remove the "merged" flag from the cells in the merged range to make them @@ -3399,9 +3335,9 @@ begin for c := rng^.Col1 to rng^.Col2 do begin cell := FindCell(r, c); - cell^.Flags := cell^.Flags - [cfMerged]; + Exclude(cell^.Flags, cfMerged); end; - RemoveMergedRange(rng^.Row1, rng^.Col1); + FMergedCells.DeleteRange(rng^.Row1, rng^.Col1); end; ChangedCell(ARow, ACol); @@ -3417,36 +3353,13 @@ end; -------------------------------------------------------------------------------} procedure TsWorksheet.UnmergeCells(ARange: String); var - r1, r2, c1, c2: Cardinal; + sheet: TsWorksheet; + rng: TsCellRange; begin - if (pos(':', ARange) = 0) and ParseCellString(ARange, r1, c1) then - UnmergeCells(r1, c1) - else - if ParseCellRangeString(ARange, r1, c1, r2, c2) then - UnmergeCells(r1, c1); + if Workbook.TryStrToCellRange(ARange, sheet, rng) then + UnmergeCells(rng.Row1, rng.Col1); end; -{@@ ---------------------------------------------------------------------------- - Finds the upper left cell of a merged block to which a specified cell belongs. - This is the "merge base". Returns nil if the cell is not merged. - - @param ACell Cell under investigation - @return A pointer to the cell in the upper left corner of the merged block - to which ACell belongs, If ACell is isolated then the function returns - nil. --------------------------------------------------------------------------------} -function TsWorksheet.FindMergeBase(ACell: PCell): PCell; -var - rng: PsCellRange; -begin - Result := nil; - if (ACell <> nil) and IsMerged(ACell) then - begin - rng := FindMergedRangeForCell(ACell^.Row, ACell^.Col); - if rng <> nil then - Result := FindCell(rng^.Row1, rng^.Col1); - end; -end; {@@ ---------------------------------------------------------------------------- Finds the upper left cell of a shared formula block to which the specified @@ -3482,9 +3395,9 @@ function TsWorksheet.FindMergedRange(ACell: PCell; var rng: PsCellRange; begin - if (ACell <> nil) and IsMerged(ACell) then + if IsMerged(ACell) then begin - rng := FindMergedRangeForCell(ACell^.Row, ACell^.Col); + rng := FMergedCells.FindRangeWithCell(ACell^.Row, ACell^.Col); if rng <> nil then begin ARow1 := rng^.Row1; @@ -3498,6 +3411,47 @@ begin Result := false; end; +{@@ ---------------------------------------------------------------------------- + Checks whether the two specified cells belong to the same merged cell block. + + @param ACell1 Pointer to the first cell + @param ACell2 Pointer to the second cell + @reult TRUE if both cells belong to the same merged cell block + FALSE if the cells are not merged or are in different blocks +-------------------------------------------------------------------------------} +function TsWorksheet.InSameMergedRange(ACell1, ACell2: PCell): Boolean; +begin + Result := IsMerged(ACell1) and IsMerged(ACell2) and + (FindMergeBase(ACell1) = FindMergeBase(ACell2)); +end; + +{@@ ---------------------------------------------------------------------------- + Returns true if the specified cell is the base of a merged cell range, i.e. + the upper left corner of that range. + + @param ACell Pointer to the cell being considered + @return True if the cell is the upper left corner of a merged range + False if not +-------------------------------------------------------------------------------} +function TsWorksheet.IsMergeBase(ACell: PCell): Boolean; +begin + Result := (ACell <> nil) and (ACell = FindMergeBase(ACell)); +end; + +{@@ ---------------------------------------------------------------------------- + Returns TRUE if the specified cell belongs to a merged block + + @param ACell Pointer to the cell of interest + @return TRUE if the cell belongs to a merged block, FALSE if not. +-------------------------------------------------------------------------------} +function TsWorksheet.IsMerged(ACell: PCell): Boolean; +begin + Result := (ACell <> nil) and (cfMerged in ACell^.Flags); +end; + + +{ Shared formulas } + {@@ ---------------------------------------------------------------------------- Determines the cell block sharing the same formula which is used by a given cell @@ -3575,78 +3529,6 @@ begin end; end; -{@@ ---------------------------------------------------------------------------- - Collects all ranges of merged cells that can be found in the worksheet - - @param AList Array containing TsCellRange records of the merged cells --------------------------------------------------------------------------------} -procedure TsWorksheet.GetMergedCellRanges(out AList: TsCellRangeArray); -var - AVLNode: TAVLTreeNode; - rng: PsCellRange; - i: Integer; -begin - SetLength(AList, FMergedCells.Count); - i := 0; - AVLNode := FMergedCells.FindLowest; - while AVLNode <> nil do begin - rng := PsCellRange(AVLNode.Data); - AList[i].Row1 := rng^.Row1; - AList[i].Col1 := rng^.Col1; - AList[i].Row2 := rng^.Row2; - AList[i].Col2 := rng^.Col2; - inc(i); - AVLNode := FMergedCells.FindSuccessor(AVLNode); - end; -end; - -{@@ ---------------------------------------------------------------------------- - Checks whether the two specified cells belong to the same merged cell block. - - @param ACell1 Pointer to the first cell - @param ACell2 Pointer to the second cell - @reult TRUE if both cells belong to the same merged cell block - FALSE if the cells are not merged or are in different blocks --------------------------------------------------------------------------------} -function TsWorksheet.InSameMergedRange(ACell1, ACell2: PCell): Boolean; -begin - Result := IsMerged(ACell1) and IsMerged(ACell2) and - (FindMergeBase(ACell1) = FindMergeBase(ACell2)); -end; - -{@@ ---------------------------------------------------------------------------- - Returns true if the specified cell is the base of a merged cell range, i.e. - the upper left corner of that range. - - @param ACell Pointer to the cell being considered - @return True if the cell is the upper left corner of a merged range - False if not --------------------------------------------------------------------------------} -function TsWorksheet.IsMergeBase(ACell: PCell): Boolean; -begin - Result := (ACell <> nil) and (ACell = FindMergeBase(ACell)); -end; - -{@@ ---------------------------------------------------------------------------- - Returns TRUE if the specified cell belongs to a merged block - - @param ACell Pointer to the cell of interest - @return TRUE if the cell belongs to a merged block, FALSE if not. --------------------------------------------------------------------------------} -function TsWorksheet.IsMerged(ACell: PCell): Boolean; -begin - Result := (ACell <> nil) and (cfMerged in ACell^.Flags); -end; - -{@@ ---------------------------------------------------------------------------- - Helper method for clearing the merged cell records in a spreadsheet. --------------------------------------------------------------------------------} -procedure TsWorksheet.RemoveCellRangesCallback(data, arg: pointer); -begin - Unused(arg); - Dispose(PsCellRange(data)); -end; - {@@ ---------------------------------------------------------------------------- Helper method for clearing the cell records in a spreadsheet. -------------------------------------------------------------------------------} @@ -3664,16 +3546,6 @@ begin RemoveAllAvlTreeNodes(FCells, RemoveCellsCallback); end; -{@@ ---------------------------------------------------------------------------- - Empties the list of merged cell ranges. - Is called from the destructor of the worksheet. - NOTE: The cells are left intact. They are still marked as merged!!! --------------------------------------------------------------------------------} -procedure TsWorksheet.RemoveAllMergedRanges; -begin - RemoveAllAvlTreeNodes(FMergedCells, RemoveCellRangesCallback); -end; - {@@ ---------------------------------------------------------------------------- Removes the comment from a cell and releases the memory occupied by the node. -------------------------------------------------------------------------------} @@ -6217,15 +6089,13 @@ end; -------------------------------------------------------------------------------} procedure TsWorksheet.DeleteCol(ACol: Cardinal); var - AVLNode, nextAVLNode: TAVLTreeNode; + AVLNode: TAVLTreeNode; col: PCol; i: Integer; r, rr, cc: Cardinal; cell, basecell, nextcell: PCell; firstRow, lastCol, lastRow: Cardinal; rng: PsCellRange; - comment: PsComment; - hyperlink: PsHyperlink; begin lastCol := GetLastColIndex; lastRow := GetLastOccupiedRowIndex; @@ -6261,23 +6131,7 @@ begin end; // Fix merged cells - AVLNode := FMergedCells.FindLowest; - while Assigned(AVLNode) do begin - rng := PsCellRange(AVLNode.Data); - // Deleted column is at the left of the merged range - // --> Shift entire merged range to the left by 1 - // The "merged" flags do not have to be changed. They move with the cells. - if (ACol < rng^.Col1) then begin - dec(rng^.Col1); - dec(rng^.Col2); - end else - // Deleted column runs through the merged block - // --> Shift right column to the left by 1 - if (ACol >= rng^.Col1) and (ACol <= rng^.Col2) then - dec(rng^.Col2); - // Proceed with next merged range - AVLNode := FMergedCells.FindSuccessor(AVLNode); - end; + FMergedCells.DeleteRowOrCol(ACol, false); // Fix comments FComments.DeleteRowOrCol(ACol, false); @@ -6320,15 +6174,13 @@ end; -------------------------------------------------------------------------------} procedure TsWorksheet.DeleteRow(ARow: Cardinal); var - AVLNode, nextAVLNode: TAVLTreeNode; + AVLNode: TAVLTreeNode; row: PRow; i: Integer; c, rr, cc: Cardinal; firstCol, lastCol, lastRow: Cardinal; cell, nextcell, basecell: PCell; rng: PsCellRange; - comment: PsComment; - hyperlink: PsHyperlink; begin firstCol := GetFirstColIndex; lastCol := GetLastOccupiedColIndex; @@ -6363,22 +6215,7 @@ begin end; // Fix merged cells - AVLNode := FMergedCells.FindLowest; - while Assigned(AVLNode) do begin - rng := PsCellRange(AVLNode.Data); - // Deleted row is ABOVE the merged range - // --> Shift entire merged range up by 1 - if (ARow < rng^.Row1) then begin - dec(rng^.Row1); - dec(rng^.Row2); - end else - // Deleted row runs through the merged block - // --> Shift bottom row up by 1 - if (ARow >= rng^.Row1) and (ARow <= rng^.Row2) then - dec(rng^.Row2); - // Proceed with next merged range - AVLNode := FMergedCells.FindSuccessor(AVLNode); - end; + FMergedCells.DeleteRowOrCol(ARow, true); // Fix comments FComments.DeleteRowOrCol(ARow, true); @@ -6428,8 +6265,6 @@ var cell: PCell; AVLNode: TAVLTreeNode; rng: PsCellRange; - comment: PsComment; - hyperlink: PsHyperlink; begin // Handling of shared formula references is too complicated for me... // Split them into isolated cell formulas @@ -6463,10 +6298,9 @@ begin UpdateCaches; // Fix merged cells - AVLNode := FMergedCells.FindLowest; - while AVLNode <> nil do + rng := PsCellRange(FMergedCells.GetFirst); + while rng <> nil do begin - rng := PsCellRange(AVLNode.Data); // The new column is at the LEFT of the merged block // --> Shift entire range to the right by 1 column if (ACol < rng^.Col1) then @@ -6475,7 +6309,8 @@ begin for r := rng^.Row1 to rng^.Row2 do begin cell := FindCell(r, rng^.Col1); - if cell <> nil then cell^.Flags := cell^.Flags - [cfMerged]; + if cell <> nil then + Exclude(cell^.Flags, cfMerged); end; // Shift merged block to the right // Don't call "MergeCells" here - this would add a new merged block @@ -6486,7 +6321,8 @@ begin for r := rng^.Row1 to rng^.Row2 do begin cell := FindCell(R, rng^.Col2); - if cell <> nil then cell^.Flags := cell^.Flags + [cfMerged]; + if cell <> nil then + Include(cell^.Flags, cfMerged); end; end else // The new column goes through this cell block --> Shift only the right @@ -6494,7 +6330,7 @@ begin if (ACol >= rng^.Col1) and (ACol <= rng^.Col2) then MergeCells(rng^.Row1, rng^.Col1, rng^.Row2, rng^.Col2+1); // Continue with next merged block - AVLNode := FMergedCells.FindSuccessor(AVLNode); + rng := PsCellRange(FMergedCells.GetNext); end; ChangedCell(0, ACol); @@ -6554,8 +6390,6 @@ var cell: PCell; AVLNode: TAVLTreeNode; rng: PsCellRange; - comment: PsComment; - hyperlink: PsHyperlink; begin // Handling of shared formula references is too complicated for me... // Splits them into isolated cell formulas @@ -6589,10 +6423,9 @@ begin UpdateCaches; // Fix merged cells - AVLNode := FMergedCells.FindLowest; - while AVLNode <> nil do + rng := PsCellRange(FMergedCells.GetFirst); + while rng <> nil do begin - rng := PsCellRange(AVLNode.Data); // The new row is ABOVE the merged block --> Shift entire range down by 1 row if (ARow < rng^.Row1) then begin @@ -6600,7 +6433,8 @@ begin for c := rng^.Col1 to rng^.Col2 do begin cell := FindCell(rng^.Row1, c); - if cell <> nil then cell^.Flags := cell^.Flags - [cfMerged]; + if cell <> nil then + Exclude(cell^.Flags, cfMerged); end; // Shift merged block down // (Don't call "MergeCells" here - this would add a new merged block @@ -6611,7 +6445,8 @@ begin for c := rng^.Col1 to rng^.Col2 do begin cell := FindCell(rng^.Row2, c); - if cell <> nil then cell^.Flags := cell^.Flags + [cfMerged]; + if cell <> nil then + Include(cell^.Flags, cfMerged); end; end else // The new row goes through this cell block --> Shift only the bottom row @@ -6619,7 +6454,7 @@ begin if (ARow >= rng^.Row1) and (ARow <= rng^.Row2) then MergeCells(rng^.Row1, rng^.Col1, rng^.Row2+1, rng^.Col2); // Continue with next block - AVLNode := FMergedCells.FindSuccessor(AVLNode); + rng := PsCellRange(FMergedCells.GetNext); end; ChangedCell(ARow, 0); diff --git a/components/fpspreadsheet/fpspreadsheetctrls.pas b/components/fpspreadsheet/fpspreadsheetctrls.pas index 04374e7c1..557771edd 100644 --- a/components/fpspreadsheet/fpspreadsheetctrls.pas +++ b/components/fpspreadsheet/fpspreadsheetctrls.pas @@ -2815,6 +2815,9 @@ begin AStrings.Add(Format('Last column=%d', [ASheet.GetLastColIndex])); AStrings.Add(Format('Active cell=%s', [GetCellString(ASheet.ActiveCellRow, ASheet.ActiveCellCol)])); AStrings.Add(Format('Selection=%s', [ASheet.GetSelectionAsString])); + AStrings.Add(Format('Comments=%d items', [ASheet.Comments.Count])); + AStrings.Add(Format('Hyperlinks=%d items', [ASheet.Hyperlinks.Count])); + AStrings.Add(Format('MergedCells=%d items', [ASheet.MergedCells.Count])); end; end; diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas index 7da1e9aa2..a32ae5c68 100755 --- a/components/fpspreadsheet/xlsbiff8.pas +++ b/components/fpspreadsheet/xlsbiff8.pas @@ -2611,12 +2611,10 @@ procedure TsSpreadBIFF8Writer.WriteMergedCells(AStream: TStream; const MAX_PER_RECORD = 1026; var - i, n0, n: Integer; - rngList: TsCellRangeArray; + n0, n: Integer; + rng: PsCellRange; begin - AWorksheet.GetMergedCellRanges(rngList); - n0 := Length(rngList); - i := 0; + n0 := AWorksheet.MergedCells.Count; while n0 > 0 do begin n := Min(n0, MAX_PER_RECORD); @@ -2625,17 +2623,18 @@ begin { BIFF record header } WriteBIFFHeader(AStream, INT_EXCEL_ID_MERGEDCELLS, 2 + n*8); - // Count of cell ranges in this record + { Number of cell ranges in this record } AStream.WriteWord(WordToLE(n)); - // Loop writing the merged cell ranges - while (n > 0) and (i < Length(rngList)) do begin - AStream.WriteWord(WordToLE(rngList[i].Row1)); - AStream.WriteWord(WordToLE(rngList[i].Row2)); - AStream.WriteWord(WordToLE(rngList[i].Col1)); - AStream.WriteWord(WordToLE(rngList[i].Col2)); - inc(i); + { Loop for writing the merged cell ranges } + rng := PsCellRange(AWorksheet.MergedCells.GetFirst); + while (n > 0) do begin + AStream.WriteWord(WordToLE(rng^.Row1)); + AStream.WriteWord(WordToLE(rng^.Row2)); + AStream.WriteWord(WordToLE(rng^.Col1)); + AStream.WriteWord(WordToLE(rng^.Col2)); dec(n); + rng := PsCellRange(AWorksheet.MergedCells.GetNext); end; dec(n0, MAX_PER_RECORD); diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index 3f5fd8e84..38db147ce 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/components/fpspreadsheet/xlsxooxml.pas @@ -2232,17 +2232,20 @@ end; procedure TsSpreadOOXMLWriter.WriteMergedCells(AStream: TStream; AWorksheet: TsWorksheet); var - rng: TsCellRangeArray; - i: Integer; + rng: PsCellRange; + n: Integer; begin - AWorksheet.GetMergedCellRanges(rng); - if Length(rng) = 0 then + n := AWorksheet.MergedCells.Count; + if n = 0 then exit; AppendToStream(AStream, Format( - '', [Length(rng)]) ); - for i:=0 to Length(rng)-1 do begin + '', [n]) ); + rng := PsCellRange(AWorksheet.MergedCells.GetFirst); + while Assigned(rng) do + begin AppendToStream(AStream, Format( - '', [GetCellRangeString(rng[i].Row1, rng[i].Col1, rng[i].Row2, rng[i].Col2)])); + '', [GetCellRangeString(rng.Row1, rng.Col1, rng.Row2, rng.Col2)])); + rng := PsCellRange(AWorksheet.MergedCells.GetNext); end; AppendToStream(AStream, '');