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

fpspreadsheet: Begin migration of code related to AVLTrees to new unit fpsclasses. Hyperlinks and comments trees already migrated.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3978 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-03-02 12:23:52 +00:00
parent fbe591128c
commit 7ad2d347ea
8 changed files with 444 additions and 329 deletions
Download Patch File Download Diff File Expand all files Collapse all files

339
components/fpspreadsheet/fpsclasses.pas Normal file
View File

@ -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.

391
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -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;

2
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -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

25
components/fpspreadsheet/fpsutils.pas
View File

@ -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

6
components/fpspreadsheet/laz_fpspreadsheet.lpk
View File

@ -28,7 +28,7 @@
This package is all you need if you don't want graphical components (like grids and charts)."/>
<License Value="LGPL with static linking exception. This is the same license as is used in the LCL (Lazarus Component Library)."/>
<Version Major="1" Minor="5"/>
<Files Count="32">
<Files Count="33">
<Item1>
<Filename Value="fpolestorage.pas"/>
<UnitName Value="fpolestorage"/>
@ -157,6 +157,10 @@ This package is all you need if you don't want graphical components (like grids
<Filename Value="fpsnumformat.pas"/>
<UnitName Value="fpsNumFormat"/>
</Item32>
<Item33>
<Filename Value="fpsclasses.pas"/>
<UnitName Value="fpsclasses"/>
</Item33>
</Files>
<RequiredPkgs Count="2">
<Item1>

4
components/fpspreadsheet/laz_fpspreadsheet.pas
View File

@ -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

4
components/fpspreadsheet/xlsbiff8.pas
View File

@ -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

2
components/fpspreadsheet/xlsxooxml.pas
View File

@ -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