unit fpsclasses; {$mode objfpc}{$H+} interface uses Classes, SysUtils, AVL_Tree, //avglvltree, fpstypes; type { forward declarations } TsRowColAVLTree = class; { TsRowCol } TsRowCol = record Row, Col: Cardinal; end; PsRowCol = ^TsRowCol; { TsRowColEnumerator } TsRowColEnumerator = class protected FCurrentNode: TAVLTreeNode; FTree: TsRowColAVLTree; FStartRow, FEndRow, FStartCol, FEndCol: Cardinal; FReverse: Boolean; function GetCurrent: PsRowCol; public constructor Create(ATree: TsRowColAVLTree; AStartRow, AStartCol, AEndRow, AEndCol: Cardinal; AReverse: Boolean); function GetEnumerator: TsRowColEnumerator; inline; function MoveNext: Boolean; property Current: PsRowCol read GetCurrent; property StartRow: Cardinal read FStartRow; property EndRow: Cardinal read FEndRow; property StartCol: Cardinal read FStartCol; property EndCol: Cardinal read FEndCol; end; { TsRowColAVLTree } TsRowColAVLTree = class(TAVLTree) private FOwnsData: Boolean; protected procedure DisposeData(var AData: Pointer); virtual; abstract; function NewData: Pointer; virtual; abstract; public constructor Create(AOwnsData: Boolean = true); destructor Destroy; override; function Add(ARow, ACol: Cardinal): PsRowCol; overload; procedure Clear; procedure Delete(ANode: TAVLTreeNode); overload; procedure Delete(ARow, ACol: Cardinal); overload; procedure DeleteRowOrCol(AIndex: Cardinal; IsRow: Boolean); virtual; procedure Exchange(ARow1, ACol1, ARow2, ACol2: Cardinal); virtual; function Find(ARow, ACol: Cardinal): PsRowCol; overload; function GetData(ANode: TAVLTreeNode): PsRowCol; function GetFirst: PsRowCol; function GetLast: PsRowCol; procedure InsertRowOrCol(AIndex: Cardinal; IsRow: Boolean); procedure Remove(ARow, ACol: Cardinal); overload; end; { TsCells } TsCellEnumerator = class(TsRowColEnumerator) protected function GetCurrent: PCell; public function GetEnumerator: TsCellEnumerator; inline; property Current: PCell read GetCurrent; end; TsCells = class(TsRowColAVLTree) private FWorksheet: Pointer; // Must be cast to TsWorksheet protected procedure DisposeData(var AData: Pointer); override; function NewData: Pointer; override; public constructor Create(AWorksheet: Pointer; AOwnsData: Boolean = true); function AddCell(ARow, ACol: Cardinal): PCell; procedure DeleteCell(ARow, ACol: Cardinal); function FindCell(ARow, ACol: Cardinal): PCell; function GetFirstCell: PCell; function GetFirstCellOfRow(ARow: Cardinal): PCell; function GetLastCell: PCell; function GetLastCellOfRow(ARow: Cardinal): PCell; // enumerators function GetEnumerator: TsCellEnumerator; function GetReverseEnumerator: TsCellEnumerator; function GetColEnumerator(ACol: Cardinal; AStartRow: Cardinal = 0; AEndRow: Cardinal = $7FFFFFFF): TsCellEnumerator; function GetRangeEnumerator(AStartRow, AStartCol, AEndRow, AEndCol: Cardinal): TsCellEnumerator; function GetRowEnumerator(ARow: Cardinal; AStartCol:Cardinal = 0; AEndCol: Cardinal = $7FFFFFFF): TsCellEnumerator; function GetReverseColEnumerator(ACol: Cardinal; AStartRow: Cardinal = 0; AEndRow: Cardinal = $7FFFFFFF): TsCellEnumerator; function GetReverseRangeEnumerator(AStartRow, AStartCol, AEndRow, AEndCol: Cardinal): TsCellEnumerator; function GetReverseRowEnumerator(ARow: Cardinal; AStartCol:Cardinal = 0; AEndCol: Cardinal = $7FFFFFFF): TsCellEnumerator; end; { TsComments } TsCommentEnumerator = class(TsRowColEnumerator) protected function GetCurrent: PsComment; public function GetEnumerator: TsCommentEnumerator; inline; property Current: PsComment read GetCurrent; end; TsComments = class(TsRowColAVLTree) protected procedure DisposeData(var AData: Pointer); override; function NewData: Pointer; override; public function AddComment(ARow, ACol: Cardinal; AComment: String): PsComment; procedure DeleteComment(ARow, ACol: Cardinal); // enumerators function GetEnumerator: TsCommentEnumerator; function GetRangeEnumerator(AStartRow, AStartCol, AEndRow, AEndCol: Cardinal): TsCommentEnumerator; end; { TsHyperlinks } TsHyperlinkEnumerator = class(TsRowColEnumerator) protected function GetCurrent: PsHyperlink; public function GetEnumerator: TsHyperlinkEnumerator; inline; property Current: PsHyperlink read GetCurrent; end; TsHyperlinks = class(TsRowColAVLTree) protected procedure DisposeData(var AData: Pointer); override; function NewData: Pointer; override; public function AddHyperlink(ARow, ACol: Cardinal; ATarget: String; ATooltip: String = ''): PsHyperlink; procedure DeleteHyperlink(ARow, ACol: Cardinal); // enumerators function GetEnumerator: TsHyperlinkEnumerator; function GetRangeEnumerator(AStartRow, AStartCol, AEndRow, AEndCol: Cardinal): TsHyperlinkEnumerator; end; { TsMergedCells } TsCellRangeEnumerator = class(TsRowColEnumerator) protected function GetCurrent: PsCellRange; public function GetEnumerator: TsCellRangeEnumerator; inline; property Current: PsCellRange read GetCurrent; end; 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; procedure Exchange(ARow1, ACol1, ARow2, ACol2: Cardinal); override; function FindRangeWithCell(ARow, ACol: Cardinal): PsCellRange; // enumerators function GetEnumerator: TsCellRangeEnumerator; end; implementation uses {%H-}Math, fpsUtils; { Helper function for sorting } function CompareRowCol(Item1, Item2: Pointer): Integer; begin Result := Longint(PsRowCol(Item1)^.Row) - PsRowCol(Item2)^.Row; if Result = 0 then Result := Longint(PsRowCol(Item1)^.Col) - PsRowCol(Item2)^.Col; end; {******************************************************************************} { TsRowColEnumerator: A specialized enumerator for TsRowColAVLTree using the } { pointers to the data records. } {******************************************************************************} constructor TsRowColEnumerator.Create(ATree: TsRowColAVLTree; AStartRow, AStartCol, AEndRow, AEndCol: Cardinal; AReverse: Boolean); begin FTree := ATree; FReverse := AReverse; // Rearrange col/row indexes such that iteration always begins with "StartXXX" if AStartRow <= AEndRow then begin FStartRow := IfThen(AReverse, AEndRow, AStartRow); FEndRow := IfThen(AReverse, AStartRow, AEndRow); end else begin FStartRow := IfThen(AReverse, AStartRow, AEndRow); FEndRow := IfThen(AReverse, AEndRow, AStartRow); end; if AStartCol <= AEndCol then begin FStartCol := IfThen(AReverse, AEndCol, AStartCol); FEndCol := IfThen(AReverse, AStartCol, AEndCol); end else begin FStartCol := IfThen(AReverse, AStartCol, AEndCol); FEndCol := IfThen(AReverse, AEndCol, AStartCol); end; end; function TsRowColEnumerator.GetCurrent: PsRowCol; begin if Assigned(FCurrentNode) then Result := PsRowCol(FCurrentNode.Data) else Result := nil; end; function TsRowColEnumerator.GetEnumerator: TsRowColEnumerator; begin Result := self; end; function TsRowColEnumerator.MoveNext: Boolean; begin if FCurrentNode <> nil then begin if FReverse then begin FCurrentNode := FTree.FindPrecessor(FCurrentNode); while (FCurrentNode <> nil) and ( (Current^.Col < FEndCol) or (Current^.Col > FStartCol) or (Current^.Row < FEndRow) or (Current^.Row > FStartRow) ) do FCurrentNode := FTree.FindPrecessor(FCurrentNode); end else begin FCurrentNode := FTree.FindSuccessor(FCurrentNode); while (FCurrentNode <> nil) and ( (Current^.Col < FStartCol) or (Current^.Col > FEndCol) or (Current^.Row < FStartRow) or (Current^.Row > FEndRow) ) do FCurrentNode := FTree.FindSuccessor(FCurrentNode); end; end else begin if FReverse then begin FCurrentNode := FTree.FindHighest; while (FCurrentNode <> nil) and ( (Current^.Row < FEndRow) or (Current^.Row > FStartRow) or (Current^.Col < FEndCol) or (Current^.Col > FStartCol) ) do FCurrentNode := FTree.FindPrecessor(FCurrentNode); end else begin FCurrentNode := FTree.FindLowest; while (FCurrentNode <> nil) and ( (Current^.Row < FStartRow) or (Current^.Row > FEndRow) or (Current^.Col < FStartCol) or (Current^.Col > FEndCol) ) do FCurrentNode := FTree.FindSuccessor(FCurrentNode); end; end; Result := FCurrentNode <> nil; end; {******************************************************************************} { TsRowColAVLTree: A specialized AVLTree working with records containing } { row and column indexes. } {******************************************************************************} {@@ ---------------------------------------------------------------------------- Constructor of the AVLTree. Installs a compare procedure for row and column indexes. If AOwnsData is true then the tree automatically destroys the data records attached to the tree nodes. -------------------------------------------------------------------------------} constructor TsRowColAVLTree.Create(AOwnsData: Boolean = true); begin inherited Create(@CompareRowCol); FOwnsData := AOwnsData; end; {@@ ---------------------------------------------------------------------------- Destructor of the AVLTree. Clears the tree nodes and, if the tree has been created with AOwnsData=true, destroys the data records -------------------------------------------------------------------------------} destructor TsRowColAVLTree.Destroy; begin Clear; inherited; end; {@@ ---------------------------------------------------------------------------- Adds a new node to the tree identified by the specified row and column indexes. -------------------------------------------------------------------------------} function TsRowColAVLTree.Add(ARow, ACol: Cardinal): PsRowCol; begin Result := NewData; Result^.Row := ARow; Result^.Col := ACol; inherited Add(Result); end; {@@ ---------------------------------------------------------------------------- Clears the tree, i.e, destroys the data records (if the tree has been created with AOwnsData = true) and removes all nodes. -------------------------------------------------------------------------------} procedure TsRowColAVLTree.Clear; var node, nextnode: TAVLTreeNode; begin node := FindLowest; while node <> nil do begin nextnode := FindSuccessor(node); Delete(node); node := nextnode; end; end; {@@ ---------------------------------------------------------------------------- Removes the specified node from the tree. If the tree has been created with AOwnsData = true then the data record is destroyed as well -------------------------------------------------------------------------------} procedure TsRowColAVLTree.Delete(ANode: TAVLTreeNode); begin if FOwnsData and Assigned(ANode) then DisposeData(PsRowCol(ANode.Data)); inherited Delete(ANode); end; procedure TsRowColAVLTree.Delete(ARow, ACol: Cardinal); var node: TAVLTreeNode; cell: TCell; begin cell.Row := ARow; cell.Col := ACol; node := inherited Find(@cell); if Assigned(node) then Delete(node); 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 TsRowColAVLTree.DeleteRowOrCol(AIndex: Cardinal; IsRow: Boolean); var node, nextnode: TAVLTreeNode; item: PsRowCol; begin node := FindLowest; while Assigned(node) do begin nextnode := FindSuccessor(node); item := PsRowCol(node.Data); if IsRow then begin // Update all RowCol records at row indexes above the deleted row if item^.Row > AIndex then dec(item^.Row) else // Remove and destroy the RowCol record if it is in the deleted row if item^.Row = AIndex then Delete(node); end else begin // Update all RowCol records at column indexes above the deleted column if item^.Col > AIndex then dec(item^.Col) else // Remove the RowCol record if it is in the deleted column if item^.Col = AIndex then Delete(node); end; node := nextnode; end; end; {@@ ---------------------------------------------------------------------------- Exchanges two nodes -------------------------------------------------------------------------------} procedure TsRowColAVLTree.Exchange(ARow1, ACol1, ARow2, ACol2: Cardinal); var item1, item2: PsRowCol; begin item1 := Find(ARow1, ACol1); item2 := Find(ARow2, ACol2); // There are entries for both locations: Exchange row/col indexes if (item1 <> nil) and (item2 <> nil) then begin Remove(item1); Remove(item2); item1^.Row := ARow2; item1^.Col := ACol2; item2^.Row := ARow1; item2^.Col := ACol1; inherited Add(item1); // The items are sorted to the correct position inherited Add(item2); // when they are added to the tree end else // Only the 1st item exists --> give it the row/col indexes of the 2nd item if (item1 <> nil) then begin Remove(item1); item1^.Row := ARow2; item1^.Col := ACol2; inherited Add(item1); end else // Only the 2nd item exists --> give it the row/col indexes of the 1st item if (item2 <> nil) then begin Remove(item2); item2^.Row := ARow1; item2^.Col := ACol1; inherited Add(item2); // just adds the existing item at the new position end; end; {@@ ---------------------------------------------------------------------------- Seeks the entire tree for a node of the specified row and column indexes and returns a pointer to the data record. Returns nil if such a node does not exist -------------------------------------------------------------------------------} function TsRowColAVLTree.Find(ARow, ACol: Cardinal): PsRowCol; var data: TsRowCol; node: TAVLTreeNode; begin Result := nil; if (Count = 0) then exit; data.Row := ARow; data.Col := ACol; node := inherited Find(@data); if Assigned(node) then Result := PsRowCol(node.Data); end; {@@ ---------------------------------------------------------------------------- Extracts the pointer to the data record from a tree node -------------------------------------------------------------------------------} function TsRowColAVLTree.GetData(ANode: TAVLTreeNode): PsRowCol; begin if ANode <> nil then Result := PsRowCol(ANode.Data) else Result := nil; end; {@@ ---------------------------------------------------------------------------- The combination of the methods GetFirst and GetNext allow a fast iteration through all nodes of the tree. -------------------------------------------------------------------------------} function TsRowColAVLTree.GetFirst: PsRowCol; begin Result := GetData(FindLowest); end; function TsRowColAVLTree.GetLast: PsRowCol; begin Result := GetData(FindHighest); 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. @param AIndex Index of the row (if IsRow=true) or column (if IsRow=false) to be inserted @param IsRow Identifies whether AIndex refers to a row or column index -------------------------------------------------------------------------------} procedure TsRowColAVLTree.InsertRowOrCol(AIndex: Cardinal; IsRow: Boolean); var node: TAVLTreeNode; item: PsRowCol; begin node := FindLowest; while Assigned(node) do begin item := PsRowCol(node.Data); if IsRow then begin if item^.Row >= AIndex then inc(item^.Row); end else begin if item^.Col >= AIndex then inc(item^.Col); end; node := FindSuccessor(node); end; end; {@@ ---------------------------------------------------------------------------- Removes the node, but does NOT destroy the associated data reocrd -------------------------------------------------------------------------------} procedure TsRowColAVLTree.Remove(ARow, ACol: Cardinal); var node: TAVLTreeNode; item: TsRowCol; begin item.Row := ARow; item.Col := ACol; node := inherited Find(@item); Remove(node); // Delete(node); end; {******************************************************************************} { TsCellEnumerator: enumerator for the TsCells AVLTree } {******************************************************************************} function TsCellEnumerator.GetEnumerator: TsCellEnumerator; begin Result := self; end; function TsCellEnumerator.GetCurrent: PCell; begin Result := PCell(inherited GetCurrent); end; {******************************************************************************} { TsCells: an AVLTree to store spreadsheet cells } {******************************************************************************} constructor TsCells.Create(AWorksheet: Pointer; AOwnsData: Boolean = true); begin inherited Create(AOwnsData); FWorksheet := AWorksheet; end; {@@ ---------------------------------------------------------------------------- Adds a node with a new TCell record to the tree. Returns a pointer to the cell record. NOTE: It must be checked first that there ia no other record at the same col/row. (Check omitted for better performance). -------------------------------------------------------------------------------} function TsCells.AddCell(ARow, ACol: Cardinal): PCell; begin Result := PCell(Add(ARow, ACol)); end; {@@ ---------------------------------------------------------------------------- Deletes the node for the specified row and column index along with the associated cell data record. -------------------------------------------------------------------------------} procedure TsCells.DeleteCell(ARow, ACol: Cardinal); begin Delete(ARow, ACol); end; {@@ ---------------------------------------------------------------------------- Helper procedure which disposes the memory occupied by the cell data record attached to a tree node. -------------------------------------------------------------------------------} procedure TsCells.DisposeData(var AData: Pointer); begin if AData <> nil then Dispose(PCell(AData)); AData := nil; end; {@@ ---------------------------------------------------------------------------- Checks whether a specific cell already exists -------------------------------------------------------------------------------} function TsCells.FindCell(ARow, ACol: Cardinal): PCell; begin Result := PCell(Find(ARow, ACol)); end; {@@ ---------------------------------------------------------------------------- Cell enumerators (use in "for ... in" syntax) -------------------------------------------------------------------------------} function TsCells.GetEnumerator: TsCellEnumerator; begin Result := TsCellEnumerator.Create(self, 0, 0, $7FFFFFFF, $7FFFFFFF, false); end; function TsCells.GetColEnumerator(ACol: Cardinal; AStartRow: Cardinal = 0; AEndRow: Cardinal = $7FFFFFFF): TsCellEnumerator; begin Result := TsCellEnumerator.Create(Self, AStartRow, ACol, AEndRow, ACol, false); end; function TsCells.GetRangeEnumerator(AStartRow, AStartCol, AEndRow, AEndCol: Cardinal): TsCellEnumerator; begin Result := TsCellEnumerator.Create(Self, AStartRow, AStartCol, AEndRow, AEndCol, false); end; function TsCells.GetRowEnumerator(ARow: Cardinal; AStartCol: Cardinal = 0; AEndCol: Cardinal = $7FFFFFFF): TsCellEnumerator; begin Result := TsCellEnumerator.Create(Self, ARow, AStartCol, ARow, AEndCol, false); end; function TsCells.GetReverseColEnumerator(ACol: Cardinal; AStartRow: Cardinal = 0; AEndRow: Cardinal = $7FFFFFFF): TsCellEnumerator; begin Result := TsCellEnumerator.Create(Self, AStartRow, ACol, AEndRow, ACol, true); end; function TsCells.GetReverseEnumerator: TsCellEnumerator; begin Result := TsCellEnumerator.Create(self, 0, 0, $7FFFFFFF, $7FFFFFFF, true); end; function TsCells.GetReverseRangeEnumerator(AStartRow, AStartCol, AEndRow, AEndCol: Cardinal): TsCellEnumerator; begin Result := TsCellEnumerator.Create(Self, AStartRow, AStartCol, AEndRow, AEndCol, true); end; function TsCells.GetReverseRowEnumerator(ARow: Cardinal; AStartCol: Cardinal = 0; AEndCol: Cardinal = $7FFFFFFF): TsCellEnumerator; begin Result := TsCellEnumerator.Create(Self, ARow, AStartCol, ARow, AEndCol, true); end; {@@ ---------------------------------------------------------------------------- Returns a pointer to the first cell of the tree. -------------------------------------------------------------------------------} function TsCells.GetFirstCell: PCell; begin Result := PCell(GetFirst); end; {@@ ---------------------------------------------------------------------------- Returns a pointer to the first cell in a specified row -------------------------------------------------------------------------------} function TsCells.GetFirstCellOfRow(ARow: Cardinal): PCell; begin Result := nil; // Creating the row enumerator automatically finds the first cell of the row for Result in GetRowEnumerator(ARow) do exit; end; {@@ ---------------------------------------------------------------------------- Returns a pointer to the last cell of the tree. -------------------------------------------------------------------------------} function TsCells.GetLastCell: PCell; begin Result := PCell(GetLast); end; {@@ ---------------------------------------------------------------------------- Returns a pointer to the last cell of a specified row -------------------------------------------------------------------------------} function TsCells.GetLastCellOfRow(ARow: Cardinal): PCell; begin Result := nil; // Creating the reverse row enumerator finds the last cell of the row for Result in GetReverseRowEnumerator(ARow) do exit; end; {@@ ---------------------------------------------------------------------------- Alloates memory for a cell data record. -------------------------------------------------------------------------------} function TsCells.NewData: Pointer; var cell: PCell; begin New(cell); InitCell(cell^); cell^.Worksheet := FWorksheet; Result := cell; end; {******************************************************************************} { TsCommentEnumerator: enumerator for the TsComments AVLTree } {******************************************************************************} function TsCommentEnumerator.GetEnumerator: TsCommentEnumerator; begin Result := self; end; function TsCommentEnumerator.GetCurrent: PsComment; begin Result := PsComment(inherited GetCurrent); end; {******************************************************************************} { TsComments: an AVLTree to store comment records for cells } {******************************************************************************} {@@ ---------------------------------------------------------------------------- Adds a node with a new comment record to the tree. If a node already exists then its data will be replaced by the specified ones. Returns a pointer to the comment record. -------------------------------------------------------------------------------} function TsComments.AddComment(ARow, ACol: Cardinal; AComment: String): PsComment; begin Result := PsComment(Find(ARow, ACol)); if Result = nil then Result := PsComment(Add(ARow, ACol)); Result^.Text := AComment; end; {@@ ---------------------------------------------------------------------------- Deletes the node for the specified row and column index along with the associated comment data record. -------------------------------------------------------------------------------} procedure TsComments.DeleteComment(ARow, ACol: Cardinal); begin Delete(ARow, ACol); end; {@@ ---------------------------------------------------------------------------- Helper procedure which disposes the memory occupied by the comment data record attached to a tree node. -------------------------------------------------------------------------------} procedure TsComments.DisposeData(var AData: Pointer); begin if AData <> nil then Dispose(PsComment(AData)); AData := nil; end; {@@ ---------------------------------------------------------------------------- Alloates memory of a comment data record. -------------------------------------------------------------------------------} function TsComments.NewData: Pointer; var comment: PsComment; begin New(comment); Result := comment; end; {@@ ---------------------------------------------------------------------------- Comments enumerators (use in "for ... in" syntax) -------------------------------------------------------------------------------} function TsComments.GetEnumerator: TsCommentEnumerator; begin Result := TsCommentEnumerator.Create(self, 0, 0, $7FFFFFFF, $7FFFFFFF, false); end; function TsComments.GetRangeEnumerator(AStartRow, AStartCol, AEndRow, AEndCol: Cardinal): TsCommentEnumerator; begin Result := TsCommentEnumerator.Create(Self, AStartRow, AStartCol, AEndRow, AEndCol, false); end; {******************************************************************************} { TsHyperlinkEnumerator: enumerator for the TsHyperlinks AVLTree } {******************************************************************************} function TsHyperlinkEnumerator.GetEnumerator: TsHyperlinkEnumerator; begin Result := self; end; function TsHyperlinkEnumerator.GetCurrent: PsHyperlink; begin Result := PsHyperlink(inherited GetCurrent); end; {******************************************************************************} { TsHyperlinks: an AVLTree to store hyperlink records for cells } {******************************************************************************} {@@ ---------------------------------------------------------------------------- Adds a node with a new hyperlink record to the tree. If a node already exists then its data will be replaced by the specified ones. Returns a pointer to the hyperlink record. -------------------------------------------------------------------------------} function TsHyperlinks.AddHyperlink(ARow, ACol: Cardinal; ATarget: String; ATooltip: String = ''): PsHyperlink; begin Result := PsHyperlink(Find(ARow, ACol)); if Result = nil then Result := PsHyperlink(Add(ARow, ACol)); Result^.Target := ATarget; Result^.Tooltip := ATooltip; end; {@@ ---------------------------------------------------------------------------- Deletes the node for the specified row and column index along with the associated hyperlink data record. -------------------------------------------------------------------------------} procedure TsHyperlinks.DeleteHyperlink(ARow, ACol: Cardinal); begin Delete(ARow, ACol); end; {@@ ---------------------------------------------------------------------------- Helper procedure which disposes the memory occupied by the hyperlink data record attached to a tree node. -------------------------------------------------------------------------------} procedure TsHyperlinks.DisposeData(var AData: Pointer); begin if AData <> nil then Dispose(PsHyperlink(AData)); AData := nil; end; {@@ ---------------------------------------------------------------------------- Hyperlink enumerators (use in "for ... in" syntax) -------------------------------------------------------------------------------} function TsHyperlinks.GetEnumerator: TsHyperlinkEnumerator; begin Result := TsHyperlinkEnumerator.Create(self, 0, 0, $7FFFFFFF, $7FFFFFFF, false); end; function TsHyperlinks.GetRangeEnumerator(AStartRow, AStartCol, AEndRow, AEndCol: Cardinal): TsHyperlinkEnumerator; begin Result := TsHyperlinkEnumerator.Create(Self, AStartRow, AStartCol, AEndRow, AEndCol, false); end; {@@ ---------------------------------------------------------------------------- Alloates memory of a hyperlink data record. -------------------------------------------------------------------------------} function TsHyperlinks.NewData: Pointer; var hyperlink: PsHyperlink; begin New(hyperlink); Result := hyperlink; end; {******************************************************************************} { TsCellRangeEnumerator: enumerator for the cell range records } {******************************************************************************} function TsCellRangeEnumerator.GetEnumerator: TsCellRangeEnumerator; begin Result := self; end; function TsCellRangeEnumerator.GetCurrent: PsCellRange; begin Result := PsCellRange(inherited GetCurrent); end; {******************************************************************************} { TsMergedCells: 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(Find(ARow1, ACol1)); if Result = nil then 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 Delete(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: PsCellRange; R: TsCellRange; node, nextnode: TAVLTreeNode; begin node := FindLowest; while Assigned(node) do begin rng := PsCellRange(node.Data); nextnode := FindSuccessor(node); 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 R := rng^; // Store range parameters Delete(node); // Delete node from tree, adapt the row indexes, ... AddRange(R.Row1-1, R.Col1, R.Row2-1, R.Col2); // ... and re-insert to get it sorted correctly 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); // no need to remove & re-insert because Row1 does not change 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 R := rng^; Delete(node); AddRange(R.Row1, R.Col1-1, R.Row2, R.Col2-1); 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 node := nextnode; 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; procedure TsMergedCells.Exchange(ARow1, ACol1, ARow2, ACol2: Cardinal); var rng: PsCellrange; dr, dc: Cardinal; begin rng := PsCellrange(Find(ARow1, ACol1)); if rng <> nil then begin dr := rng^.Row2 - rng^.Row1; dc := rng^.Col2 - rng^.Col1; rng^.Row1 := ARow2; rng^.Col1 := ACol2; rng^.Row2 := ARow2 + dr; rng^.Col2 := ACol2 + dc; end; rng := PsCellRange(Find(ARow2, ACol2)); if rng <> nil then begin dr := rng^.Row2 - rng^.Row1; dc := rng^.Col2 - rng^.Col1; rng^.Row1 := ARow1; rng^.Col1 := ACol1; rng^.Row2 := ARow1 + dr; rng^.Col2 := ACol1 + dc; end; inherited Exchange(ARow1, ACol1, ARow2, ACol2); 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; {@@ ---------------------------------------------------------------------------- Cell range enumerator (use in "for ... in" syntax) -------------------------------------------------------------------------------} function TsMergedCells.GetEnumerator: TsCellRangeEnumerator; begin Result := TsCellRangeEnumerator.Create(self, 0, 0, $7FFFFFFF, $7FFFFFFF, false); end; {@@ ---------------------------------------------------------------------------- Alloates memory of a merged cell range data record. -------------------------------------------------------------------------------} function TsMergedCells.NewData: Pointer; var range: PsCellRange; begin New(range); Result := range; end; end.