From 7ad2d347eaa7f2637592a25c6cf37609ae5e2ba0 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Mon, 2 Mar 2015 12:23:52 +0000 Subject: [PATCH] fpspreadsheet: Begin migration of code related to AVLTrees to new unit fpsclasses. Hyperlinks and comments trees already migrated. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3978 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/fpspreadsheet/fpsclasses.pas | 339 +++++++++++++++ components/fpspreadsheet/fpspreadsheet.pas | 391 ++++-------------- .../fpspreadsheet/fpspreadsheetgrid.pas | 2 +- components/fpspreadsheet/fpsutils.pas | 25 ++ .../fpspreadsheet/laz_fpspreadsheet.lpk | 6 +- .../fpspreadsheet/laz_fpspreadsheet.pas | 4 +- components/fpspreadsheet/xlsbiff8.pas | 4 +- components/fpspreadsheet/xlsxooxml.pas | 2 +- 8 files changed, 444 insertions(+), 329 deletions(-) create mode 100644 components/fpspreadsheet/fpsclasses.pas diff --git a/components/fpspreadsheet/fpsclasses.pas b/components/fpspreadsheet/fpsclasses.pas new file mode 100644 index 000000000..894af9d4e --- /dev/null +++ b/components/fpspreadsheet/fpsclasses.pas @@ -0,0 +1,339 @@ +unit fpsclasses; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, AVL_Tree, avglvltree, + fpstypes; + +type + { TsRowCol } + TsRowCol = record + Row, Col: Cardinal; + end; + PsRowCol = ^TsRowCol; + + { 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; + procedure Clear; + procedure Delete(ANode: TAVLTreeNode); + procedure DeleteRowOrCol(AIndex: Cardinal; IsRow: Boolean); + function Find(ARow, ACol: Cardinal): PsRowCol; + procedure InsertRowOrCol(AIndex: Cardinal; IsRow: Boolean); + procedure Remove(ARow, ACol: Cardinal); + end; + + { TsComments } + 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); + end; + + { TsHyperlinks } + 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); + end; + + +implementation + +uses + fpspreadsheet; + +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; + + +{******************************************************************************} +{ 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 := Find(ARow, ACol); + if Result = nil then + 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; + +{@@ ---------------------------------------------------------------------------- + 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 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; + +{@@ ---------------------------------------------------------------------------- + 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; + +{@@ ---------------------------------------------------------------------------- + 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 and destroys the associated data reocrd (if the tree has + been created with AOwnsData=true) for the specified row and column indexes. +-------------------------------------------------------------------------------} +procedure TsRowColAVLTree.Remove(ARow, ACol: Cardinal); +var + node: TAVLTreeNode; + item: TsRowCol; +begin + item.Row := ARow; + item.Col := ACol; + node := inherited Find(@item); + Delete(node); +end; + + +{******************************************************************************} +{ TsComments: a 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(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 + Remove(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; + + +{******************************************************************************} +{ TsHyperlinks: a 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(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 + Remove(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; + +{@@ ---------------------------------------------------------------------------- + Alloates memory of a hyperlink data record. +-------------------------------------------------------------------------------} +function TsHyperlinks.NewData: Pointer; +var + hyperlink: PsHyperlink; +begin + New(hyperlink); + Result := hyperlink; +end; + +end. + diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 2e32b90b3..e3078c8d5 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -23,7 +23,7 @@ uses clocale, {$endif}{$endif}{$endif} Classes, SysUtils, fpimage, AVL_Tree, avglvltree, lconvencoding, - fpsTypes; + fpsTypes, fpsClasses; type { Forward declarations } @@ -125,9 +125,9 @@ type FWorkbook: TsWorkbook; FName: String; // Name of the worksheet (displayed at the tab) FCells: TAvlTree; // Items are TCell - FComments: TAvlTree; // Items are TsComment + FComments: TsComments; FMergedCells: TAvlTree; // Items are TsCellRange - FHyperlinks: TAvlTree; // Items are TsHyperlink + FHyperlinks: TsHyperlinks; FCurrentNode: TAVLTreeNode; // for GetFirstCell and GetNextCell FRows, FCols: TIndexedAVLTree; // This lists contain only rows or cols with styles different from default FActiveCellRow: Cardinal; @@ -161,8 +161,8 @@ type 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); +// procedure RemoveCommentsCallback(data, arg: pointer); +// procedure RemoveHyperlinksCallback(data, arg: pointer); protected function CellUsedInFormula(ARow, ACol: Cardinal): Boolean; @@ -172,12 +172,6 @@ type function RemoveCell(ARow, ACol: Cardinal): PCell; procedure RemoveAndFreeCell(ARow, ACol: Cardinal); - // Hyperlinks - procedure RemoveAllHyperlinks; - - // Comments - procedure RemoveAllComments; - // Merged cells function CellIsInMergedRange(ARow, ACol: Cardinal; ARange: PsCellRange): Boolean; function FindMergedRangeForBase(ABaseRow, ABaseCol: Cardinal): PsCellRange; @@ -472,8 +466,7 @@ type procedure SetSelection(const ASelection: TsCellRangeArray); // Comments - function FindComment(ARow, ACol: Cardinal): PsComment; overload; - function FindComment(ACell: PCell): PsComment; overload; + function FindComment(ACell: PCell): PsComment; function HasComment(ACell: PCell): Boolean; function ReadComment(ARow, ACol: Cardinal): String; overload; function ReadComment(ACell: PCell): string; overload; @@ -482,13 +475,10 @@ type procedure WriteComment(ACell: PCell; AText: String); overload; // Hyperlinks - function FindHyperlink(ARow, ACol: Cardinal): PsHyperlink; overload; - function FindHyperlink(ACell: PCell): PsHyperlink; overload; + function FindHyperlink(ACell: PCell): PsHyperlink; function HasHyperlink(ACell: PCell): Boolean; - function ReadHyperlink(ARow, ACol: Cardinal): TsHyperlink; overload; function ReadHyperlink(ACell: PCell): TsHyperlink; procedure RemoveHyperlink(ACell: PCell); - procedure SplitHyperlink(AValue: String; out ATarget, ABookmark: String); function ValidHyperlink(AValue: String; out AErrMsg: String): Boolean; function WriteHyperlink(ARow, ACol: Cardinal; ATarget: String; ATooltip: String = ''): PCell; overload; @@ -519,11 +509,11 @@ type {@@ List of all column records of the worksheet having a non-standard column width } property Cols: TIndexedAVLTree read FCols; {@@ List of all comment records } - property Comments: TAVLTree read FComments; + property Comments: TsComments read FComments; {@@ List of merged cells (contains TsCellRange records) } property MergedCells: TAVLTree read FMergedCells; {@@ List of hyperlink information records } - property Hyperlinks: TAVLTree read FHyperlinks; + property Hyperlinks: TsHyperlinks read FHyperlinks; {@@ FormatSettings for localization of some formatting strings } property FormatSettings: TFormatSettings read GetFormatSettings; {@@ Name of the sheet. In the popular spreadsheet applications this is @@ -1102,13 +1092,6 @@ begin Result := LongInt(PCol(Item1).Col) - PCol(Item2).Col; end; -function CompareCommentCells(Item1, Item2: Pointer): Integer; -begin - result := LongInt(PsComment(Item1).Row) - PsComment(Item2).Row; - if Result = 0 then - Result := LongInt(PsComment(Item1).Col) - PsComment(Item2).Col; -end; - function CompareMergedCells(Item1, Item2: Pointer): Integer; begin Result := LongInt(PsCellRange(Item1)^.Row1) - PsCellRange(Item2)^.Row1; @@ -1116,13 +1099,6 @@ begin Result := LongInt(PsCellRange(Item1)^.Col1) - PsCellRange(Item2)^.Col1; end; -function CompareHyperlinks(Item1, Item2: Pointer): Integer; -begin - Result := LongInt(PsHyperlink(Item1)^.Row) - PsHyperlink(Item2)^.Row; - if Result = 0 then - Result := LongInt(PsHyperlink(Item1)^.Col) - PsHyperlink(Item2)^.Col; -end; - {@@ ---------------------------------------------------------------------------- Write the fonts stored for a given workbook to a file. @@ -1173,9 +1149,9 @@ begin FCells := TAVLTree.Create(@CompareCells); FRows := TIndexedAVLTree.Create(@CompareRows); FCols := TIndexedAVLTree.Create(@CompareCols); - FComments := TAVLTree.Create(@CompareCommentCells); + FComments := TsComments.Create; FMergedCells := TAVLTree.Create(@CompareMergedCells); - FHyperlinks := TAVLTree.Create(@CompareHyperlinks); + FHyperlinks := TsHyperlinks.Create; FDefaultColWidth := 12; FDefaultRowHeight := 1; @@ -1202,9 +1178,7 @@ begin RemoveAllCells; RemoveAllRows; RemoveAllCols; - RemoveAllComments; RemoveAllMergedRanges; - RemoveAllHyperlinks; FCells.Free; FRows.Free; @@ -1449,31 +1423,6 @@ begin SetLength(rpnFormula, 0); end; -{@@ ---------------------------------------------------------------------------- - Checks whether the cell at a specified row/column contains a comment and - returns a pointer to the comment data. - - @param ARow (0-based) index to the row - @param ACol (0-based) index to the column - @return Pointer to the TsComment record (nil, if the cell does not have a - comment) --------------------------------------------------------------------------------} -function TsWorksheet.FindComment(ARow, ACol: Cardinal): PsComment; -var - comment: TsComment; - AVLNode: TAVLTreeNode; -begin - Result := nil; - if FComments.Count = 0 then - exit; - - comment.Row := ARow; - comment.Col := ACol; - AVLNode := FComments.Find(@comment); - if Assigned(AVLNode) then - result := PsComment(AVLNode.Data); -end; - {@@ ---------------------------------------------------------------------------- Checks whether a cell contains a comment and returns a pointer to the comment data. @@ -1484,10 +1433,10 @@ end; -------------------------------------------------------------------------------} function TsWorksheet.FindComment(ACell: PCell): PsComment; begin - if ACell = nil then - Result := nil + if HasComment(ACell) then + Result := PsComment(FComments.Find(ACell^.Row, ACell^.Col)) else - Result := FindComment(ACell^.Row, ACell^.Col); + Result := nil; end; {@@ ---------------------------------------------------------------------------- @@ -1510,7 +1459,7 @@ var comment: PsComment; begin Result := ''; - comment := FindComment(ARow, ACol); + comment := PsComment(FComments.Find(ARow, ACol)); if comment <> nil then Result := comment^.Text; end; @@ -1559,46 +1508,24 @@ begin if ACell = nil then exit; - // Remove the comment of an empty string is passed + // Remove the comment if an empty string is passed if AText = '' then begin - if (cfHasComment) in ACell^.Flags then - begin - RemoveComment(ACell); - ACell^.Flags := ACell^.Flags - [cfHasComment]; - end; - end else - begin - comment := FindComment(ACell); // Is there already a comment at this cell? - addNew := (comment = nil); - if addNew then - New(comment); // No: create a new one; yes: update existing one - comment^.Row := ACell^.Row; - comment^.Col := ACell^.Col; - comment^.Text := AText; - if addNew then - FComments.Add(comment); - ACell^.Flags := ACell^.Flags + [cfHasComment]; + RemoveComment(ACell); + exit; end; + + // Add new comment record + comment := FComments.AddComment(ACell^.Row, ACell^.Col, AText); + Include(ACell^.Flags, cfHasComment); + + ChangedCell(ACell^.Row, ACell^.Col); + end; { Hyperlinks } -{@@ ---------------------------------------------------------------------------- - Checks whether the cell at a specified row/column contains a hyperlink and - returns a pointer to the hyperlink data. - - @param ARow (0-based) row index of the cell - @param ACol (0-based) column index of the cell - @return Pointer to the TsHyperlink record (nil, if the cell does not contain - a hyperlink). --------------------------------------------------------------------------------} -function TsWorksheet.FindHyperlink(ARow, ACol: Cardinal): PsHyperlink; -begin - Result := FindHyperlink(FindCell(ARow, ACol)); -end; - {@@ ---------------------------------------------------------------------------- Checks whether the specified cell contains a hyperlink and returns a pointer to the hyperlink data. @@ -1608,19 +1535,11 @@ end; a hyperlink. -------------------------------------------------------------------------------} function TsWorksheet.FindHyperlink(ACell: PCell): PsHyperlink; -var - hyperlink: TsHyperlink; - AVLNode: TAVLTreeNode; begin - Result := nil; - if not HasHyperlink(ACell) or (FHyperlinks.Count = 0) then - exit; - - hyperlink.Row := ACell^.Row; - hyperlink.Col := ACell^.Col; - AVLNode := FHyperlinks.Find(@hyperlink); - if Assigned(AVLNode) then - result := PsHyperlink(AVLNode.Data); + if HasHyperlink(ACell) then + Result := PsHyperlink(FHyperlinks.Find(ACell^.Row, ACell^.Col)) + else + Result := nil; end; {@@ ---------------------------------------------------------------------------- @@ -1631,19 +1550,6 @@ begin Result := (ACell <> nil) and (cfHyperlink in ACell^.Flags); end; -{@@ ---------------------------------------------------------------------------- - Reads the hyperlink information of a specified cell. - - @param ARow Row index of the cell considered - @param ACol Column index of the cell considered - @returns Record with the hyperlink data assigned to the cell - If the cell is not a hyperlink the result field Kind is hkNone. --------------------------------------------------------------------------------} -function TsWorksheet.ReadHyperlink(ARow, ACol: Cardinal): TsHyperlink; -begin - Result := ReadHyperlink(FindCell(ARow, ACol)); -end; - {@@ ---------------------------------------------------------------------------- Reads the hyperlink information of a specified cell. @@ -1673,42 +1579,14 @@ end; cctUTF8String. -------------------------------------------------------------------------------} procedure TsWorksheet.RemoveHyperlink(ACell: PCell); -var - hyperlink: TsHyperlink; - AVLNode: TAvlTreeNode; begin - if not HasHyperlink(ACell) then - exit; - - hyperlink.Row := ACell^.Row; - hyperlink.Col := ACell^.Col; - AVLNode := FHyperlinks.Find(@hyperlink); - if AVLNode <> nil then begin - Dispose(PsHyperlink(AVLNode.Data)); - FHyperlinks.Delete(AVLNode); + if HasHyperlink(ACell) then + begin + FHyperlinks.DeleteHyperlink(ACell^.Row, ACell^.Col); Exclude(ACell^.Flags, cfHyperlink); end; end; -{@@ ---------------------------------------------------------------------------- - Separates the target and bookmark parts of a hyperlink (separated by '#'). --------------------------------------------------------------------------------} -procedure TsWorksheet.SplitHyperlink(AValue: String; out ATarget, ABookmark: String); -var - p: Integer; -begin - p := pos('#', AValue); - if p = 0 then - begin - ATarget := AValue; - ABookmark := ''; - end else - begin - ATarget := Copy(AValue, 1, p-1); - ABookmark := Copy(AValue, p+1, Length(AValue)); - end; -end; - {@@ ---------------------------------------------------------------------------- Checks whether the passed string represents a valid hyperlink target @@ -1788,57 +1666,38 @@ procedure TsWorksheet.WriteHyperlink(ACell: PCell; ATarget: String; ATooltip: String = ''); var hyperlink: PsHyperlink; - addNew: Boolean; - row, col: Cardinal; - r, c: Cardinal; fmt: TsCellFormat; fn: String; - err: String; begin if ACell = nil then exit; - row := ACell^.Row; - col := ACell^.Col; - - // Remove the hyperlink if an empty destination is passed - if (ATarget = '') then - RemoveHyperlink(ACell) - else - begin - { - if not ValidHyperlink(ATarget, err) then - raise Exception.Create(err); - } - hyperlink := FindHyperlink(ACell); - addNew := (hyperlink = nil); - if addNew then New(hyperlink); - hyperlink^.Row := row; - hyperlink^.Col := col; - hyperlink^.Target := ATarget; - hyperlink^.Tooltip := ATooltip; - if addNew then FHyperlinks.Add(hyperlink); - Include(ACell^.Flags, cfHyperlink); - - if ACell^.ContentType = cctEmpty then - begin - ACell^.ContentType := cctUTF8String; - if UriToFileName(hyperlink^.Target, fn) then - ACell^.UTF8StringValue := fn - else - ACell^.UTF8StringValue := hyperlink^.Target; - end; - - fmt := ReadCellFormat(ACell); - if fmt.FontIndex = DEFAULT_FONTINDEX then - begin - fmt.FontIndex := HYPERLINK_FONTINDEX; - Include(fmt.UsedFormattingFields, uffFont); - ACell^.FormatIndex := FWorkbook.AddCellFormat(fmt); - end; + if ATarget = '' then begin + RemoveHyperlink(ACell); + exit; end; - ChangedCell(row, col); + hyperlink := FHyperlinks.AddHyperlink(ACell^.Row, ACell^.Col, ATarget, ATooltip); + Include(ACell^.Flags, cfHyperlink); + + if ACell^.ContentType = cctEmpty then + begin + ACell^.ContentType := cctUTF8String; + if UriToFileName(hyperlink^.Target, fn) then + ACell^.UTF8StringValue := fn + else + ACell^.UTF8StringValue := hyperlink^.Target; + end; + + fmt := ReadCellFormat(ACell); + if fmt.FontIndex = DEFAULT_FONTINDEX then + begin + fmt.FontIndex := HYPERLINK_FONTINDEX; + Include(fmt.UsedFormattingFields, uffFont); + ACell^.FormatIndex := FWorkbook.AddCellFormat(fmt); + end; + + ChangedCell(ACell^.Row, ACell^.Col); end; {@@ ---------------------------------------------------------------------------- @@ -3797,24 +3656,6 @@ begin Dispose(PCell(data)); end; -{@@ ---------------------------------------------------------------------------- - Helper method for clearing the cell comments in a spreadsheet. --------------------------------------------------------------------------------} -procedure TsWorksheet.RemoveCommentsCallback(data, arg: pointer); -begin - Unused(arg); - Dispose(PsComment(data)); -end; - -{@@ ---------------------------------------------------------------------------- - Helper method for clearing the hyperlink information --------------------------------------------------------------------------------} -procedure TsWorksheet.RemoveHyperlinksCallback(data, arg: pointer); -begin - Unused(arg); - Dispose(PsHyperlink(data)); -end; - {@@ ---------------------------------------------------------------------------- Clears the list of cells and releases their memory. -------------------------------------------------------------------------------} @@ -3823,22 +3664,6 @@ begin RemoveAllAvlTreeNodes(FCells, RemoveCellsCallback); end; -{@@ ---------------------------------------------------------------------------- - Clears the list of comments and releases their memory --------------------------------------------------------------------------------} -procedure TsWorksheet.RemoveAllComments; -begin - RemoveAllAvlTreeNodes(FComments, RemoveCommentsCallback); -end; - -{@@ ---------------------------------------------------------------------------- - Clears the list of hyperlinks and releases their memory --------------------------------------------------------------------------------} -procedure TsWorksheet.RemoveAllHyperlinks; -begin - RemoveAllAvlTreeNodes(FHyperlinks, RemoveHyperlinksCallback); -end; - {@@ ---------------------------------------------------------------------------- Empties the list of merged cell ranges. Is called from the destructor of the worksheet. @@ -3853,20 +3678,11 @@ end; Removes the comment from a cell and releases the memory occupied by the node. -------------------------------------------------------------------------------} procedure TsWorksheet.RemoveComment(ACell: PCell); -var - comment: TsComment; - commentNode: TAvlTreeNode; begin - if ACell = nil then - exit; - - comment.Row := ACell^.Row; - comment.Col := ACell^.Col; - commentNode := FComments.Find(@comment); - if commentNode <> nil then begin - Dispose(PsComment(commentNode.Data)); - FComments.Delete(commentNode); - ACell^.Flags := ACell^.Flags - [cfHasComment]; + if HasComment(ACell) then + begin + FComments.DeleteComment(ACell^.Row, ACell^.Col); + Exclude(ACell^.Flags, cfHasComment); end; end; @@ -6464,35 +6280,10 @@ begin end; // Fix comments - AVLNode := FComments.FindLowest; - while Assigned(AVLNode) do begin - nextAVLNode := FComments.FindSuccessor(AVLNode);; - comment := PsComment(AVLNode.Data); - // Update all comment column indexes to the right of the deleted column - if comment^.Col > ACol then - dec(comment^.Col) - else - // Remove the comment if it is in the deleted column - if comment^.Col = ACol then - WriteComment(comment^.Row, ACol, ''); - AVLNode := nextAVLNode; - end; + FComments.DeleteRowOrCol(ACol, false); // Fix hyperlinks - AVLNode := FHyperlinks.FindLowest; - while Assigned(AVLNode) do begin - nextAVLNode := FHyperlinks.FindSuccessor(AVLNode); - hyperlink := PsHyperlink(AVLNode.Data); - // Update all hyperlink column indexes to the right of the deleted column - if hyperlink^.Col > ACol then - dec(hyperlink^.Col) - else - // Remove the hyperlink if it is in the deleted column - if hyperlink^.Col = ACol then - WriteHyperlink(hyperlink^.Row, ACol, ''); - AVLNode := nextAVLNode; - end; - + FHyperlinks.DeleteRowOrCol(ACol, false); // Delete cells for r := lastRow downto firstRow do @@ -6590,40 +6381,16 @@ begin end; // Fix comments - AVLNode := FComments.FindLowest; - while Assigned(AVLNode) do begin - nextAVLNode := FComments.FindSuccessor(AVLNode);; - comment := PsComment(AVLNode.Data); - // Update all comment row indexes below the deleted row - if comment^.Row > ARow then - dec(comment^.Row) - else - // Remove the comment if it is in the deleted row - if comment^.Row = ARow then - WriteComment(ARow, comment^.Col, ''); - AVLNode := nextAVLNode; - end; + FComments.DeleteRowOrCol(ARow, true); // Fix hyperlinks - AVLNode := FHyperlinks.FindLowest; - while Assigned(AVLNode) do begin - nextAVLNode := FHyperlinks.FindSuccessor(AVLNode);; - hyperlink := PsHyperlink(AVLNode.Data); - // Update all hyperlink row indexes below the deleted row - if hyperlink^.Row > ARow then - dec(hyperlink^.Row) - else - // Remove the hyperlink if it is in the deleted row - if hyperlink^.Row = ARow then - WriteHyperlink(ARow, hyperlink^.Col, ''); - AVLNode := nextAVLNode; - end; + FHyperlinks.DeleteRowOrCol(ARow, true); // Delete cells for c := lastCol downto 0 do RemoveAndFreeCell(ARow, c); - // Update row index of cell reocrds + // Update row index of cell records AVLNode := FCells.FindLowest; while Assigned(AVLNode) do begin DeleteRowCallback(AVLNode.Data, {%H-}pointer(PtrInt(ARow))); @@ -6674,20 +6441,10 @@ begin end; // Update column index of comments - AVLNode := FComments.FindLowest; - while Assigned(AVLNode) do begin - comment := PsComment(AVLNode.Data); - if comment^.Col >= ACol then inc(comment^.Col); - AVLNode := FComments.FindSuccessor(AVLNode); - end; + FComments.InsertRowOrCol(ACol, false); // Update column index of hyperlinks - AVLNode := FHyperlinks.FindLowest; - while Assigned(AVLNode) do begin - hyperlink := PsHyperlink(AVLNode.Data); - if hyperlink^.Col >= ACol then inc(hyperlink^.Col); - AVLNode := FHyperlinks.FindSuccessor(AVLNode); - end; + FHyperlinks.InsertRowOrCol(ACol, false); // Update column index of cell records AVLNode := FCells.FindLowest; @@ -6810,20 +6567,10 @@ begin end; // Update row index of cell comments - AVLNode := FComments.FindLowest; - while Assigned(AVLNode) do begin - comment := PsComment(AVLNode.Data); - if comment^.Row >= ARow then inc(comment^.Row); - AVLNode := FComments.FindSuccessor(AVLNode); - end; + FComments.InsertRowOrCol(ARow, true); // Update row index of cell hyperlinks - AVLNode := FHyperlinks.FindLowest; - while Assigned(AVLNode) do begin - hyperlink := PsHyperlink(AVLNode.Data); - if hyperlink^.Row >= ARow then inc(hyperlink^.Row); - AVLNode := FHyperlinks.FindSuccessor(AVLNode); - end; + FHyperlinks.InsertRowOrCol(ARow, true); // Update row index of cell records AVLNode := FCells.FindLowest; diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas index fb0026e4b..867b722e2 100644 --- a/components/fpspreadsheet/fpspreadsheetgrid.pas +++ b/components/fpspreadsheet/fpspreadsheetgrid.pas @@ -2170,7 +2170,7 @@ begin exit; hyperlink := Worksheet.ReadHyperlink(FHyperlinkCell); - Worksheet.SplitHyperlink(hyperlink.Target, target, bookmark); + SplitHyperlink(hyperlink.Target, target, bookmark); if target = '' then begin // Goes to a cell within the current workbook if ParseSheetCellString(bookmark, sheetname, r, c) then diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index 5c186f71d..b9dbd335d 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/components/fpspreadsheet/fpsutils.pas @@ -146,6 +146,8 @@ function AnalyzeCompareStr(AString: String; out ACompareOp: TsCompareOperation): function InitSortParams(ASortByCols: Boolean = true; ANumSortKeys: Integer = 1; ASortPriority: TsSortPriority = spNumAlpha): TsSortParams; +procedure SplitHyperlink(AValue: String; out ATarget, ABookmark: String); + procedure AppendToStream(AStream: TStream; const AString: String); inline; overload; procedure AppendToStream(AStream: TStream; const AString1, AString2: String); inline; overload; procedure AppendToStream(AStream: TStream; const AString1, AString2, AString3: String); inline; overload; @@ -2026,6 +2028,29 @@ begin end; end; +{@@ ---------------------------------------------------------------------------- + Splits a hyperlink string at the # character. + + @param AValue Hyperlink string to be processed + @param ATarget Part before the # ("Target") + @param ABookmark Part after the # ("Bookmark") +-------------------------------------------------------------------------------} +procedure SplitHyperlink(AValue: String; out ATarget, ABookmark: String); +var + p: Integer; +begin + p := pos('#', AValue); + if p = 0 then + begin + ATarget := AValue; + ABookmark := ''; + end else + begin + ATarget := Copy(AValue, 1, p-1); + ABookmark := Copy(AValue, p+1, Length(AValue)); + end; +end; + {@@ ---------------------------------------------------------------------------- Appends a string to a stream diff --git a/components/fpspreadsheet/laz_fpspreadsheet.lpk b/components/fpspreadsheet/laz_fpspreadsheet.lpk index fddc48cde..6e93bc79c 100644 --- a/components/fpspreadsheet/laz_fpspreadsheet.lpk +++ b/components/fpspreadsheet/laz_fpspreadsheet.lpk @@ -28,7 +28,7 @@ This package is all you need if you don't want graphical components (like grids and charts)."/> - + @@ -157,6 +157,10 @@ This package is all you need if you don't want graphical components (like grids + + + + diff --git a/components/fpspreadsheet/laz_fpspreadsheet.pas b/components/fpspreadsheet/laz_fpspreadsheet.pas index 9dd4df3ca..5cfb45055 100644 --- a/components/fpspreadsheet/laz_fpspreadsheet.pas +++ b/components/fpspreadsheet/laz_fpspreadsheet.pas @@ -12,8 +12,8 @@ uses fpsutils, fpszipper, uvirtuallayer_types, uvirtuallayer, uvirtuallayer_ole, uvirtuallayer_ole_helpers, uvirtuallayer_ole_types, uvirtuallayer_stream, fpolebasic, wikitable, fpsNumFormatParser, fpsfunc, fpsRPN, fpsStrings, - fpscsv, fpsCsvDocument, fpspatches, fpsTypes, xlsEscher, fpsreaderwriter, - fpsNumFormat; + fpscsv, fpsCsvDocument, fpspatches, fpsTypes, xlsEscher, fpsReaderWriter, + fpsNumFormat, fpsclasses; implementation diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas index c9675181b..7da1e9aa2 100755 --- a/components/fpspreadsheet/xlsbiff8.pas +++ b/components/fpspreadsheet/xlsbiff8.pas @@ -1585,7 +1585,7 @@ begin for row := row1 to row2 do for col := col1 to col2 do begin - hyperlink := FWorksheet.FindHyperlink(row, col); + hyperlink := PsHyperlink(FWorksheet.Hyperlinks.Find(row, col)); if hyperlink <> nil then hyperlink^.ToolTip := txt; end; @@ -2370,7 +2370,7 @@ begin exit; descr := AWorksheet.ReadAsUTF8Text(cell); // Hyperlink description - AWorksheet.SplitHyperlink(AHyperlink^.Target, target, bookmark); + SplitHyperlink(AHyperlink^.Target, target, bookmark); isInternal := (target = ''); // Since the length of the record is not known in the first place we write diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index 7ee15e9f6..3f5fd8e84 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/components/fpspreadsheet/xlsxooxml.pas @@ -2206,7 +2206,7 @@ begin AVLNode := AWorksheet.Hyperlinks.FindLowest; while AVLNode <> nil do begin hyperlink := PsHyperlink(AVLNode.Data); - AWorksheet.SplitHyperlink(hyperlink^.Target, target, bookmark); + SplitHyperlink(hyperlink^.Target, target, bookmark); s := Format('ref="%s"', [GetCellString(hyperlink^.Row, hyperlink^.Col)]); if target <> '' then begin