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

fpspreadsheet: Rearrange cell comment architecture: to save memory cell comments are now stored in the worksheet's avltree "Comments". Replace cell's "CalcState" by more general "Flags" which signals that a cell contains a comment (to be extended...)

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3943 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-02-15 11:45:08 +00:00
parent 8e7a3b741a
commit 03efde6cab
10 changed files with 451 additions and 143 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
components/fpspreadsheet/examples/other/demo_recursive_calc.pas
View File

@ -36,22 +36,10 @@ begin
worksheet.WriteUTF8Text(0, 0, '=B2+1');
// B1
worksheet.WriteFormula(0, 1, 'B2+1');
{
worksheet.WriteRPNFormula(0, 1, CreateRPNFormula(
RPNCellValue('B2',
RPNInteger(1,
RPNFunc(fekAdd, nil)))));
}
// A2
worksheet.WriteUTF8Text(1, 0, '=B3+1');
// B2
worksheet.WriteFormula(1, 1, 'B3+1');
{
worksheet.WriteRPNFormula(1, 1, CreateRPNFormula(
RPNCellValue('B3',
RPNInteger(1,
RPNFunc(fekAdd, nil)))));
}
// A3
worksheet.WriteUTF8Text(2, 0, '(not dependent)');
// B3

5
components/fpspreadsheet/fps.inc
View File

@ -9,7 +9,6 @@
If this is not wanted, define FPS_DONT_USE_CLOCALE. }
{.$DEFINE FPS_DONT_USE_CLOCALE}
{ In older versions of fpspreadsheet, the formatting fields had belonged to the
cell record. This has been given up to reduce memory consumption.
For fpc >2.6, however, record helpers allow to get this feature back. In case
@ -17,6 +16,10 @@
methods can only be used to change cell formatting then. }
{.$DEFINE FPS_NO_RECORD_HELPERS}
{ In new versions of fpc, records can contain private fields. Activate the
define FPS_NO_PRIVATE_FIELDS_IN_RECORDS if this is not supported. }
{.$DEFINE FPS_NO_PRIVATE_FIELDS_IN_RECORDS}
{ The next defines activate code duplicated from new compiler versions in case
an old compiler is used. }

10
components/fpspreadsheet/fpsexprparser.pas
View File

@ -3843,7 +3843,7 @@ begin
cell := FCell;
if (cell <> nil) and HasFormula(cell) then
case cell^.CalcState of
case FWorksheet.GetCalcState(cell) of
csNotCalculated:
Worksheet.CalcFormula(cell);
csCalculating:
@ -3942,9 +3942,11 @@ begin
begin
cell := FWorksheet.FindCell(r, c);
if HasFormula(cell) then
case cell^.CalcState of
csNotCalculated: FWorksheet.CalcFormula(cell);
csCalculating : raise Exception.Create(SErrCircularReference);
case FWorksheet.GetCalcState(cell) of
csNotCalculated:
FWorksheet.CalcFormula(cell);
csCalculating:
raise ECalcEngine.Create(SErrCircularReference);
end;
end;

14
components/fpspreadsheet/fpsopendocument.pas
View File

@ -3442,7 +3442,7 @@ begin
Unused(ARow, ACol);
// Comment
comment := WriteCommentXMLAsString(ACell^.Comment);
comment := WriteCommentXMLAsString(FWorksheet.ReadComment(ACell));
// Merged?
if FWorksheet.IsMergeBase(ACell) then
@ -3494,7 +3494,7 @@ begin
lStyle := '';
// Comment
comment := WriteCommentXMLAsString(ACell^.Comment);
comment := WriteCommentXMLAsString(FWorksheet.ReadComment(ACell));
// Merged?
if FWorksheet.IsMergeBase(ACell) then
@ -3971,7 +3971,7 @@ begin
lStyle := '';
// Comment
comment := WriteCommentXMLAsString(ACell^.Comment);
comment := WriteCommentXMLAsString(FWorksheet.ReadComment(ACell));
// Merged?
if FWorksheet.IsMergeBase(ACell) then
@ -4044,7 +4044,7 @@ begin
{ We are writing a very rudimentary formula here without result and result
data type. Seems to work... }
if ACell^.CalcState=csCalculated then
if FWorksheet.GetCalcState(ACell) = csCalculated then
AppendToStream(AStream, Format(
'<table:table-cell table:formula="=%s" office:value-type="%s" %s %s %s>' +
comment +
@ -4093,7 +4093,7 @@ begin
lStyle := '';
// Comment
comment := WriteCommentXMLAsString(ACell^.Comment);
comment := WriteCommentXMLAsString(FWorksheet.ReadComment(ACell));
// Merged?
if FWorksheet.IsMergeBase(ACell) then
@ -4153,7 +4153,7 @@ begin
lStyle := '';
// Comment
comment := WriteCommentXMLAsString(ACell^.Comment);
comment := WriteCommentXMLAsString(FWorksheet.ReadComment(ACell));
// Merged?
if FWorksheet.IsMergeBase(ACell) then
@ -4225,7 +4225,7 @@ begin
lStyle := '';
// Comment
comment := WriteCommentXMLAsString(ACell^.Comment);
comment := WriteCommentXMLAsString(FWorksheet.ReadComment(ACell));
// nfTimeInterval is a special case - let's handle it first:

381
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -46,18 +46,24 @@ type
@see ReadAsUTF8Text }
TCell = record
{$IFNDEF NO_PRIVATE_FIELDS_IN_RECORDS}
private
{$ENDIF}
{ Status flags }
Flags: TsCellFlags;
{$IFNDEF NO_PRIVATE_FIELDS_IN_RECORDS}
public
{$ENDIF}
{ Location of the cell }
Worksheet: TsWorksheet;
Col: Cardinal; // zero-based
Row: Cardinal; // zero-based
{ Index of format record }
FormatIndex: Integer;
{ Status flags }
CalcState: TsCalcState;
{ Special information }
SharedFormulaBase: PCell; // Cell containing the shared formula
MergeBase: PCell; // Upper left cell of a merged range
Comment: String; // Comment attached to the cell
{ Cell content }
UTF8StringValue: String; // Strings cannot be part of a variant record
FormulaValue: String;
@ -96,6 +102,18 @@ type
{@@ Pointer to a TCol record }
PCol = ^TCol;
{@@ The record TsComment contains a comment attached to a cell.
@param Row (0-based) index of the row containing the cell with the comment
@param Col (0-based) index of the column containing the coll with the comment
@param Text Comment text }
TsComment = record
Row, Col: Cardinal;
Text: String;
end;
{@@ Pointer to a TsComment record }
PsComment = ^TsComment;
{@@ Worksheet user interface options:
@param soShowGridLines Show or hide the grid lines in the spreadsheet
@param soShowHeaders Show or hide the column or row headers of the spreadsheet
@ -127,6 +145,7 @@ type
FWorkbook: TsWorkbook;
FName: String; // Name of the worksheet (displayed at the tab)
FCells: TAvlTree; // Items are TCell
FComments: TAvlTree; // Items are TsComment
FCurrentNode: TAVLTreeNode; // For GetFirstCell and GetNextCell
FRows, FCols: TIndexedAVLTree; // This lists contain only rows or cols with styles different from default
FActiveCellRow: Cardinal;
@ -158,10 +177,12 @@ type
procedure DeleteRowCallback(data, arg: Pointer);
procedure InsertColCallback(data, arg: Pointer);
procedure InsertRowCallback(data, arg: Pointer);
procedure RemoveCallback(data, arg: pointer);
procedure RemoveCellsCallback(data, arg: pointer);
procedure RemoveCommentsCallback(data, arg: pointer);
protected
function CellUsedInFormula(ARow, ACol: Cardinal): Boolean;
procedure RemoveAllAVLTreeNodes(ATree: TAvlTree; ARemoveCallback: TsCallback);
// Remove and delete cells
function RemoveCell(ARow, ACol: Cardinal): PCell;
@ -196,7 +217,7 @@ type
function ReadAsDateTime(ACell: PCell; out AResult: TDateTime): Boolean; overload;
function ReadFormulaAsString(ACell: PCell; ALocalized: Boolean = false): String;
function ReadNumericValue(ACell: PCell; out AValue: Double): Boolean;
function ReadComment(ACell: PCell): String;
// function ReadComment(ACell: PCell): String;
{ Reading of cell attributes }
function GetDisplayedDecimals(ACell: PCell): Byte;
@ -238,8 +259,8 @@ type
function WriteCellValueAsString(ARow, ACol: Cardinal; AValue: String): PCell; overload;
procedure WriteCellValueAsString(ACell: PCell; AValue: String); overload;
function WriteComment(ARow, ACol: Cardinal; const AComment: String): PCell; overload;
procedure WriteComment(ACell: PCell; const AComment: String); overload;
// function WriteComment(ARow, ACol: Cardinal; const AComment: String): PCell; overload;
// procedure WriteComment(ACell: PCell; const AComment: String); overload;
function WriteCurrency(ARow, ACol: Cardinal; AValue: Double;
ANumFormat: TsNumberFormat = nfCurrency; ADecimals: Integer = 2;
@ -379,6 +400,8 @@ type
procedure FixSharedFormulas;
procedure SplitSharedFormula(ACell: PCell);
function UseSharedFormula(ARow, ACol: Cardinal; ASharedFormulaBase: PCell): PCell;
function GetCalcState(ACell: PCell): TsCalcState;
procedure SetCalcState(ACell: PCell; AValue: TsCalcState);
{ Data manipulation methods - For Cells }
procedure CopyCell(AFromCell, AToCell: PCell); overload;
@ -452,6 +475,17 @@ type
function GetSelectionCount: Integer;
procedure SetSelection(const ASelection: TsCellRangeArray);
// Comments
function FindComment(ARow, ACol: Cardinal): PsComment; overload;
function FindComment(ACell: PCell): PsComment; overload;
function HasComment(ACell: PCell): Boolean;
function ReadComment(ARow, ACol: Cardinal): String; overload;
function ReadComment(ACell: PCell): string; overload;
procedure RemoveAllComments;
procedure RemoveComment(ACell: PCell);
function WriteComment(ARow, ACol: Cardinal; AText: String): PCell; overload;
procedure WriteComment(ACell: PCell; AText: String); overload;
// Notification of changed cells content and format
procedure ChangedCell(ARow, ACol: Cardinal);
procedure ChangedFont(ARow, ACol: Cardinal);
@ -463,6 +497,8 @@ type
property Cells: TAVLTree read FCells;
{@@ 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;
{@@ FormatSettings for localization of some formatting strings }
property FormatSettings: TFormatSettings read GetFormatSettings;
{@@ Name of the sheet. In the popular spreadsheet applications this is
@ -880,8 +916,11 @@ type
{@@ Callback function when iterating cells while accessing a stream }
TCellsCallback = procedure (ACell: PCell; AStream: TStream) of object;
{@@
Custom writer of spreadsheet files. "Custom" means that it provides only
{@@ Callback function when iterating comments while accessing a stream }
TCommentsCallback = procedure (AComment: PsComment; ACommentIndex: Integer;
AStream: TStream) of object;
{@@ Custom writer of spreadsheet files. "Custom" means that it provides only
the basic functionality. The main implementation is done in derived classes
for each individual file format. }
TsCustomSpreadWriter = class(TsCustomSpreadReaderWriter)
@ -920,11 +959,16 @@ type
{@@ Abstract method for writing a number value to a cell. Must be overridden by descendent classes. }
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: double; ACell: PCell); virtual; abstract;
public
constructor Create(AWorkbook: TsWorkbook); override;
{ General writing methods }
procedure IterateThroughCells(AStream: TStream; ACells: TAVLTree; ACallback: TCellsCallback);
procedure WriteToFile(const AFileName: string; const AOverwriteExisting: Boolean = False); virtual;
procedure IterateThroughCells(AStream: TStream; ACells: TAVLTree;
ACallback: TCellsCallback);
procedure IterateThroughComments(AStream: TStream; AComments: TAVLTree;
ACallback: TCommentsCallback);
procedure WriteToFile(const AFileName: string;
const AOverwriteExisting: Boolean = False); virtual;
procedure WriteToStream(AStream: TStream); virtual;
procedure WriteToStrings(AStrings: TStrings); virtual;
end;
@ -1247,6 +1291,12 @@ 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;
{@@ ----------------------------------------------------------------------------
Write the fonts stored for a given workbook to a file.
@ -1297,6 +1347,7 @@ begin
FCells := TAVLTree.Create(@CompareCells);
FRows := TIndexedAVLTree.Create(@CompareRows);
FCols := TIndexedAVLTree.Create(@CompareCols);
FComments := TAVLTree.Create(@CompareCommentCells);
FDefaultColWidth := 12;
FDefaultRowHeight := 1;
@ -1323,10 +1374,12 @@ begin
RemoveAllCells;
RemoveAllRows;
RemoveAllCols;
RemoveAllComments;
FCells.Free;
FRows.Free;
FCols.Free;
FComments.Free;
inherited Destroy;
end;
@ -1393,7 +1446,7 @@ var
formula: String;
cell: PCell;
begin
ACell^.CalcState := csCalculating;
ACell^.Flags := ACell^.Flags + [cfCalculating] - [cfCalculated];
parser := TsSpreadsheetParser.Create(self);
try
@ -1443,7 +1496,7 @@ begin
parser.Free;
end;
ACell^.CalcState := csCalculated;
ACell^.Flags := ACell^.Flags + [cfCalculated] - [cfCalculating];
end;
{@@ ----------------------------------------------------------------------------
@ -1494,9 +1547,8 @@ var
begin
Unused(arg);
cell := PCell(data);
if HasFormula(cell) then
cell^.CalcState := csNotCalculated;
SetCalcState(cell, csNotCalculated);
end;
{@@ ----------------------------------------------------------------------------
@ -1565,6 +1617,133 @@ 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.
@param ACell Pointer to the cell
@return Pointer to the TsComment record (nil, if the cell does not have a
comment)
-------------------------------------------------------------------------------}
function TsWorksheet.FindComment(ACell: PCell): PsComment;
begin
if ACell = nil then
Result := nil
else
Result := FindComment(ACell^.Row, ACell^.Col);
end;
{@@ ----------------------------------------------------------------------------
Checks whether a specific cell contains a comment
-------------------------------------------------------------------------------}
function TsWorksheet.HasComment(ACell: PCell): Boolean;
begin
Result := (ACell <> nil) and (cfHasComment in ACell^.Flags);
end;
{@@ ----------------------------------------------------------------------------
Returns the comment text attached to a specific cell
@param ARow (0-based) index to the row
@param ACol (0-based) index to the column
@return Text assigned to the cell as a comment
-------------------------------------------------------------------------------}
function TsWorksheet.ReadComment(ARow, ACol: Cardinal): String;
var
comment: PsComment;
begin
Result := '';
comment := FindComment(ARow, ACol);
if comment <> nil then
Result := comment^.Text;
end;
{@@ ----------------------------------------------------------------------------
Returns the comment text attached to a specific cell
@param ACell Pointer to the cell
@return Text assigned to the cell as a comment
-------------------------------------------------------------------------------}
function TsWorksheet.ReadComment(ACell: PCell): String;
var
comment: PsComment;
begin
Result := '';
comment := FindComment(ACell);
if comment <> nil then
Result := comment^.Text;
end;
{@@ ----------------------------------------------------------------------------
Adds a comment to a specific cell
@param ARow (0-based) index to the row
@param ACol (0-based) index to the column
@param AText Comment text
@return Pointer to the cell containing the comment
-------------------------------------------------------------------------------}
function TsWorksheet.WriteComment(ARow, ACol: Cardinal; AText: String): PCell;
begin
Result := GetCell(ARow, ACol);
WriteComment(Result, AText);
end;
{@@ ----------------------------------------------------------------------------
Adds a comment to a specific cell
@param ACell Pointer to the cell
@param AText Comment text
-------------------------------------------------------------------------------}
procedure TsWorksheet.WriteComment(ACell: PCell; AText: String);
var
comment: PsComment;
begin
if ACell = nil then
exit;
if AText = '' then
begin
if (cfHasComment) in ACell^.Flags then
begin
RemoveComment(ACell);
ACell^.Flags := ACell^.Flags - [cfHasComment];
end;
end else
begin
New(comment);
comment.Row := ACell^.Row;
comment.Col := ACell^.Col;
comment.Text := AText;
FComments.Add(comment);
ACell^.Flags := ACell^.Flags + [cfHasComment];
end;
end;
{@@ ----------------------------------------------------------------------------
Is called whenever a cell value or formatting has changed. Fires an event
"OnChangeCell". This is handled by TsWorksheetGrid to update the grid cell.
@ -2744,7 +2923,7 @@ begin
end else
Result := False;
end;
(*
{@@ ----------------------------------------------------------------------------
Returns the comment assigned to a cell
@ -2757,7 +2936,7 @@ begin
Result := ACell^.Comment
else
Result := '';
end;
end; *)
{@@ ----------------------------------------------------------------------------
Converts an RPN formula (as read from an xls biff file, for example) to a
@ -2781,6 +2960,60 @@ begin
end;
end;
{@@ ----------------------------------------------------------------------------
Returns the CalcState flag of the specified cell. This flag tells whether a
formula in the cell has not yet been calculated (csNotCalculated), is
currently being calculated (csCalculating), or has already been calculated
(csCalculated.
@param ACell Pointer to cell considered
@return Enumerated value of the cell's calculation state
(csNotCalculated, csCalculating, csCalculated)
-------------------------------------------------------------------------------}
function TsWorksheet.GetCalcState(ACell: PCell): TsCalcState;
var
calcState: TsCellFlags;
begin
Result := csNotCalculated;
if (ACell = nil) then
exit;
calcState := ACell^.Flags * [cfCalculating, cfCalculated];
if calcState = [] then
Result := csNotCalculated
else
if calcState = [cfCalculating] then
Result := csCalculating
else
if calcState = [cfCalculated] then
Result := csCalculated
else
raise Exception.Create('[TsWorksheet.GetCalcState] Illegal cell flags.');
end;
{@@ ----------------------------------------------------------------------------
Set the CalcState flag of the specified cell. This flag tells whether a
formula in the cell has not yet been calculated (csNotCalculated), is
currently being calculated (csCalculating), or has already been calculated
(csCalculated).
For internal use only!
@param ACell Pointer to cell considered
@param AValue New value for the calculation state of the cell
(csNotCalculated, csCalculating, csCalculated)
-------------------------------------------------------------------------------}
procedure TsWorksheet.SetCalcState(ACell: PCell; AValue: TsCalcState);
begin
case AValue of
csNotCalculated:
ACell^.Flags := ACell^.Flags - [cfCalculated, cfCalculating];
csCalculating:
ACell^.Flags := ACell^.Flags + [cfCalculating] - [cfCalculated];
csCalculated:
ACell^.Flags := ACell^.Flags + [cfCalculated] - [cfCalculating];
end;
end;
{@@ ----------------------------------------------------------------------------
Reads the set of used formatting fields of a cell.
@ -3300,28 +3533,76 @@ begin
end;
{@@ ----------------------------------------------------------------------------
Helper method for clearing the records in a spreadsheet.
Helper method for clearing the cell records in a spreadsheet.
-------------------------------------------------------------------------------}
procedure TsWorksheet.RemoveCallback(data, arg: pointer);
procedure TsWorksheet.RemoveCellsCallback(data, arg: pointer);
begin
Unused(arg);
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;
{@@ ----------------------------------------------------------------------------
Clears the list of cells and releases their memory.
--------------------------------------------------------------------------------}
procedure TsWorksheet.RemoveAllCells;
var
Node: TAVLTreeNode;
begin
Node:=FCells.FindLowest;
while Assigned(Node) do begin
RemoveCallback(Node.Data,nil);
Node.Data:=nil;
Node:=FCells.FindSuccessor(Node);
RemoveAllAvlTreeNodes(FCells, RemoveCellsCallback);
end;
{@@ ----------------------------------------------------------------------------
Clears the list of comments and releases their memory
-------------------------------------------------------------------------------}
procedure TsWorksheet.RemoveAllComments;
begin
RemoveAllAvlTreeNodes(FComments, RemoveCommentsCallback);
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];
end;
FCells.Clear;
end;
{@@ ----------------------------------------------------------------------------
Clears the AVLTree specified and releases the memory occupied by the nodes
-------------------------------------------------------------------------------}
procedure TsWorksheet.RemoveAllAVLTreeNodes(ATree: TAvlTree;
ARemoveCallback: TsCallback);
var
node: TAvlTreeNode;
begin
node := ATree.FindLowest;
while Assigned(node) do begin
ARemoveCallback(node.Data, nil);
node.Data := nil;
node := ATree.FindSuccessor(node);
end;
ATree.Clear;
end;
{@@ ----------------------------------------------------------------------------
@ -3338,7 +3619,9 @@ begin
end;
{@@ ----------------------------------------------------------------------------
Removes a cell and releases its memory.
Removes a cell and releases its memory. If a comment is attached to the
cell then it is removed and releaded as well.
Just for internal usage since it does not modify the other cells affected
@param ARow Row index of the cell to be removed
@ -3348,6 +3631,8 @@ procedure TsWorksheet.RemoveAndFreeCell(ARow, ACol: Cardinal);
var
cellnode: TAVLTreeNode;
cell: TCell;
comment: TsComment;
commentnode: TAVLTreeNode;
begin
cell.Row := ARow;
cell.Col := ACol;
@ -3356,6 +3641,14 @@ begin
Dispose(PCell(cellnode.Data));
FCells.Delete(cellnode);
end;
comment.Row := ARow;
comment.Col := ACol;
commentNode := FComments.Find(@comment);
if commentNode <> nil then begin
Dispose(PsComment(commentNode.Data));
FComments.Delete(commentNode);
end;
end;
{@@ ----------------------------------------------------------------------------
@ -4134,7 +4427,7 @@ begin
WriteUTF8Text(ACell, AValue);
end;
(*
{@@ ----------------------------------------------------------------------------
Assigns a comment to a cell
@ -4163,7 +4456,7 @@ begin
ChangedCell(ACell^.Row, ACell^.Col);
end;
end;
*)
{@@ ----------------------------------------------------------------------------
Writes a currency value to a given cell. Its number format can be provided
optionally by specifying various parameters.
@ -8715,7 +9008,8 @@ begin
cctUTF8String:
WriteLabel(AStream, ACell^.Row, ACell^.Col, ACell^.UTF8StringValue, ACell);
end;
if ACell^.Comment <> '' then
//if ACell^.Comment <> '' then
if FWorksheet.ReadComment(ACell) <> '' then
WriteComment(AStream, ACell);
end;
@ -8769,6 +9063,31 @@ begin
end;
end;
{@@ ----------------------------------------------------------------------------
A generic method to iterate through all comments in a worksheet and call a
callback routine for each cell.
@param AStream The output stream, passed to the callback routine.
@param AComments List of comments to be iterated
@param ACallback Callback routine; it requires as arguments a pointer to the
comment record as well as the destination stream.
-------------------------------------------------------------------------------}
procedure TsCustomSpreadWriter.IterateThroughComments(AStream: TStream;
AComments: TAVLTree; ACallback: TCommentsCallback);
var
AVLNode: TAVLTreeNode;
index: Integer;
begin
index := 0;
AVLNode := AComments.FindLowest;
while Assigned(AVLNode) do
begin
ACallback(PsComment(AVLNode.Data), index, AStream);
AVLNode := AComments.FindSuccessor(AVLNode);
inc(index);
end;
end;
{@@ ----------------------------------------------------------------------------
Default file writing method.

6
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -1712,7 +1712,7 @@ begin
begin
// single cell
FDrawingCell := cell;
if (cell <> nil) and (cell^.Comment <> '') then
if Worksheet.HasComment(cell) then
commentcell_rct := CellRect(gc, gr)
else
commentcell_rct := Rect(0,0,0,0);
@ -1744,7 +1744,7 @@ begin
begin
gds := GetGridDrawState(gc, gr);
DoDrawCell(gc, gr, rct, temp_rct);
if (FDrawingCell <> nil) and (FDrawingCell^.Comment <> '') then
if Worksheet.HasComment(FDrawingCell) then
DrawCommentMarker(temp_rct);
end;
FTextOverflowing := false;
@ -1761,7 +1761,7 @@ begin
FDrawingCell := Worksheet.FindMergeBase(cell);
Worksheet.FindMergedRange(FDrawingCell, sr1, sc1, sr2, sc2);
gr := GetGridRow(sr1);
if (FDrawingCell <> nil) and (FDrawingCell^.Comment <> '') then
if Worksheet.HasComment(FDrawingCell) then
commentcell_rct := CellRect(GetGridCol(sc2), gr)
else
commentcell_rct := Rect(0,0,0,0);

11
components/fpspreadsheet/fpstypes.pas
View File

@ -128,6 +128,9 @@ type
TCellContentType = (cctEmpty, cctFormula, cctNumber, cctUTF8String,
cctDateTime, cctBool, cctError);
{@@ Callback function, e.g. for iterating the internal AVL trees of the workbook/sheet}
TsCallback = procedure (data, arg: Pointer) of object;
{@@ Error code values }
TsErrorValue = (
errOK, // no error
@ -382,9 +385,15 @@ type
coEqual, coNotEqual, coLess, coGreater, coLessEqual, coGreaterEqual
);
{@@ State flags while calculating formulas }
{@@ Cell calculation state }
TsCalcState = (csNotCalculated, csCalculating, csCalculated);
{@@ Cell flag }
TsCellFlag = (cfCalculating, cfCalculated, cfHasComment);
{@@ Set of cell flags }
TsCellFlags = set of TsCellFlag;
{@@ Record combining a cell's row and column indexes }
TsCellCoord = record
Row, Col: Cardinal;

84
components/fpspreadsheet/xlsbiff8.pas
View File

@ -118,8 +118,8 @@ type
TsSpreadBIFF8Writer = class(TsSpreadBIFFWriter)
private
FCommentList: TFPList;
procedure WriteCommentsCallback(ACell: PCell; AStream: TStream);
procedure WriteCommentsCallback(AComment: PsComment; ACommentIndex: Integer;
AStream: TStream);
protected
{ Record writing methods }
@ -135,11 +135,11 @@ type
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: string; ACell: PCell); override;
procedure WriteMergedCells(AStream: TStream; AWorksheet: TsWorksheet);
procedure WriteMSODrawing1(AStream: TStream; ANumShapes: Word; ACell: PCell);
procedure WriteMSODrawing2(AStream: TStream; ACell: PCell; AObjID: Word);
procedure WriteMSODrawing2_Data(AStream: TStream; ACell: PCell; AShapeID: Word);
procedure WriteMSODrawing3(AStream: TStream; ACell: PCell);
procedure WriteNOTE(AStream: TStream; ACell: PCell; AObjID: Word);
procedure WriteMSODrawing1(AStream: TStream; ANumShapes: Word; AComment: PsComment);
procedure WriteMSODrawing2(AStream: TStream; AComment: PsComment; AObjID: Word);
procedure WriteMSODrawing2_Data(AStream: TStream; AComment: PsComment; AShapeID: Word);
procedure WriteMSODrawing3(AStream: TStream);
procedure WriteNOTE(AStream: TStream; AComment: PsComment; AObjID: Word);
procedure WriteNumFormat(AStream: TStream; AFormatData: TsNumFormatData;
AListIndex: Integer); override;
procedure WriteOBJ(AStream: TStream; AObjID: Word);
@ -152,7 +152,7 @@ type
function WriteString_8bitLen(AStream: TStream; AString: String): Integer; override;
procedure WriteStringRecord(AStream: TStream; AString: string); override;
procedure WriteSTYLE(AStream: TStream);
procedure WriteTXO(AStream: TStream; ACell: PCell);
procedure WriteTXO(AStream: TStream; AComment: PsComment);
procedure WriteWINDOW2(AStream: TStream; ASheet: TsWorksheet);
procedure WriteXF(AStream: TStream; AFormatRecord: PsCellFormat;
XFType_Prot: Byte = 0); override;
@ -1595,39 +1595,23 @@ begin
exit; // Remove after comments can be written correctly
{$warning TODO: Fix writing of cell comments in BIFF8 (file is readable by OpenOffice, but not by Excel)}
FCommentList := TFPList.Create;
try
IterateThroughCells(AStream, AWorksheet.Cells, WriteCommentsCallback);
if FCommentList.Count = 0 then
exit;
for i:=0 to FCommentList.Count-1 do begin
if i = 0 then
WriteMSODRAWING1(AStream, FCommentList.Count, PCell(FCommentList[i]))
else
WriteMSODRAWING2(AStream, PCell(FCommentList[i]), i+1);
WriteOBJ(AStream, i+1);
WriteMSODRAWING3(AStream, PCell(FCommentList[i]));
WriteTXO(AStream, PCell(FCommentList[i]));
end;
for i:=0 to FCommentList.Count-1 do
WriteNOTE(AStream, PCell(FCommentList[i]), i+1);
finally
FreeAndNil(FCommentList);
end;
IterateThroughComments(AStream, AWorksheet.Comments, WriteCommentsCallback);
end;
{@@ ----------------------------------------------------------------------------
Helper method which stores the pointer to a cell in the FCommentsList if the
cell contains a comment
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteCommentsCallback(ACell: PCell;
AStream: TStream);
procedure TsSpreadBIFF8Writer.WriteCommentsCallback(AComment: PsComment;
ACommentIndex: Integer; AStream: TStream);
begin
Unused(AStream);
if (ACell <> nil) and (ACell^.Comment <> '') then
FCommentList.Add(ACell);
if ACommentIndex = 0 then
WriteMSODrawing1(AStream, FWorksheet.Comments.Count, AComment)
else
WriteMSODrawing2(AStream, AComment, ACommentIndex+1);
WriteOBJ(AStream, ACommentIndex+1);
WriteMSODrawing3(AStream);
WriteTXO(AStream, AComment);
end;
{@@ ----------------------------------------------------------------------------
@ -1777,7 +1761,7 @@ MSODRAWING2 |---- Sp container (child shape) $F004 0
</pre>
-------------------------------------------------------------------------------}
procedure TsSpreadBiff8Writer.WriteMSODrawing1(AStream: TStream; ANumShapes: Word;
ACell: PCell);
AComment: PsComment);
const
DRAWING_ID = 1;
var
@ -1808,9 +1792,9 @@ begin
MSO_FSP_BITS_GROUP + MSO_FSP_BITS_PATRIARCH); // 8 + 8 bytes
{ Data for the 1st comment }
WriteMSODrawing2_Data(tmpStream, ACell, SHAPEID_BASE + 1);
WriteMSODrawing2_Data(tmpStream, AComment, SHAPEID_BASE + 1);
// Write the BIFF stream
{ Write the BIFF stream }
tmpStream.Position := 0;
len := tmpStream.Size;
WriteBiffHeader(AStream, INT_EXCEL_ID_MSODRAWING, tmpStream.Size);
@ -1822,9 +1806,9 @@ end;
{ Write the MSODRAWING record which occurs before the OBJ record.
Do not use for the very first OBJ record where the record must be
WriteMSODrawing1 + WriteMSODrawing2_Data + WriteMSODrawing3_Data}
procedure TsSpreadBiff8Writer.WriteMSODrawing2(AStream: TStream; ACell: PCell;
AObjID: Word);
WriteMSODrawing1 + WriteMSODrawing2_Data}
procedure TsSpreadBiff8Writer.WriteMSODrawing2(AStream: TStream;
AComment: PsComment; AObjID: Word);
var
tmpStream: TStream;
len: Word;
@ -1832,7 +1816,7 @@ begin
tmpStream := TMemoryStream.Create;
try
{ Shape data for cell comment }
WriteMSODrawing2_Data(tmpStream, ACell, SHAPEID_BASE + AObjID);
WriteMSODrawing2_Data(tmpStream, AComment, SHAPEID_BASE + AObjID);
{ Get size of data stream }
len := tmpStream.Size;
@ -1849,7 +1833,7 @@ begin
end;
procedure TsSpreadBiff8Writer.WriteMSODrawing2_Data(AStream: TStream;
ACell: PCell; AShapeID: Word);
AComment: PsComment; AShapeID: Word);
var
tmpStream: TStream;
len: Cardinal;
@ -1869,7 +1853,7 @@ begin
{ OfficeArtClientAnchor record }
WriteMSOClientAnchorSheetRecord(tmpStream,
ACell^.Row + 1, ACell^.Col + 1, ACell.Row + 3, ACell^.Col + 5,
AComment^.Row + 1, AComment^.Col + 1, AComment^.Row + 3, AComment^.Col + 5,
691, 486, 38, 26,
true, true
);
@ -1893,7 +1877,7 @@ begin
end;
{ Writes the MSODRAWING record which must occur immediately before a TXO record }
procedure TsSpreadBiff8Writer.WriteMSODRAWING3(AStream: TStream; ACell: PCell);
procedure TsSpreadBiff8Writer.WriteMSODRAWING3(AStream: TStream);
begin
{ BIFF Header }
WriteBiffHeader(AStream, INT_EXCEL_ID_MSODRAWING, 8);
@ -1903,10 +1887,10 @@ begin
end;
{ Writes a NOTE record for a comment attached to a cell }
procedure TsSpreadBiff8Writer.WriteNOTE(AStream: TStream; ACell: PCell;
procedure TsSpreadBiff8Writer.WriteNOTE(AStream: TStream; AComment: PsComment;
AObjID: Word);
const
AUTHOR: ansistring = 'Werner';
AUTHOR: ansistring = 'author';
var
len: Integer;
begin
@ -1917,8 +1901,8 @@ begin
AStream.WriteWord(WordToLE(12+len)); // Size of NOTE record
{ Record data }
AStream.WriteWord(WordToLE(ACell^.Row)); // Row index of cell
AStream.WriteWord(WordToLE(ACell^.Col)); // Column index of cell
AStream.WriteWord(WordToLE(AComment^.Row)); // Row index of cell
AStream.WriteWord(WordToLE(AComment^.Col)); // Column index of cell
AStream.WriteWord(0); // Flags
AStream.WriteWord(WordToLE(AObjID)); // Object identifier (1, ...)
AStream.WriteWord(len); // Char length of author string
@ -2261,7 +2245,7 @@ end;
Writes a TXO and two CONTINUE records as needed for cell comments.
It can safely be assumed that the cell exists and contains a comment.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteTXO(AStream: TStream; ACell: PCell);
procedure TsSpreadBIFF8Writer.WriteTXO(AStream: TStream; AComment: PsComment);
var
recTXO: TBIFF8TXORecord;
comment: widestring;
@ -2272,7 +2256,7 @@ var
bytesFmtRuns: Integer;
begin
{ Prepare comment string. It is stored as a string with 8-bit characters }
comment := UTF8Decode(ACell^.Comment);
comment := UTF8Decode(AComment^.Text);
SetLength(compressed, length(comment));
for i:= 1 to Length(comment) do
begin

20
components/fpspreadsheet/xlscommon.pas
View File

@ -955,7 +955,7 @@ begin
try
List.Text := FIncompleteNote; // Fix line endings which are #10 in file
s := Copy(List.Text, 1, Length(List.Text) - Length(LineEnding));
FIncompleteCell^.Comment := s;
FWorksheet.WriteComment(FIncompleteCell, s);
finally
List.Free;
end;
@ -2004,25 +2004,27 @@ var
L: Integer;
base_size: Word;
p: Integer;
comment: ansistring;
cmnt: ansistring;
List: TStringList;
comment: PsComment;
begin
Unused(ACell);
if (ACell^.Comment = '') then
comment := FWorksheet.FindComment(ACell);
if (comment = nil) or (comment^.Text = '') then
exit;
List := TStringList.Create;
try
List.Text := ConvertEncoding(ACell^.Comment, encodingUTF8, FCodePage);
comment := List[0];
List.Text := ConvertEncoding(comment^.Text, encodingUTF8, FCodePage);
cmnt := List[0];
for p := 1 to List.Count-1 do
comment := comment + #$0A + List[p];
cmnt := cmnt + #$0A + List[p];
finally
List.Free;
end;
L := Length(comment);
L := Length(cmnt);
base_size := SizeOf(rec) - 2*SizeOf(word);
// First NOTE record
@ -2032,7 +2034,7 @@ begin
rec.TextLen := L;
rec.RecordSize := base_size + Min(L, CHUNK_SIZE);
AStream.WriteBuffer(rec, SizeOf(rec));
AStream.WriteBuffer(comment[1], Min(L, CHUNK_SIZE)); // Write text
AStream.WriteBuffer(cmnt[1], Min(L, CHUNK_SIZE)); // Write text
// If the comment text does not fit into 2048 bytes continuation records
// have to be written.
@ -2044,7 +2046,7 @@ begin
rec.TextLen := Min(L, CHUNK_SIZE);
rec.RecordSize := base_size + rec.TextLen;
AStream.WriteBuffer(rec, SizeOf(rec));
AStream.WriteBuffer(comment[p], rec.TextLen);
AStream.WriteBuffer(cmnt[p], rec.TextLen);
dec(L, CHUNK_SIZE);
inc(p, CHUNK_SIZE);
end;

51
components/fpspreadsheet/xlsxooxml.pas
View File

@ -104,8 +104,10 @@ type
TsSpreadOOXMLWriter = class(TsCustomSpreadWriter)
private
procedure WriteCommentsCallback(ACell: PCell; AStream: TStream);
procedure WriteVmlDrawingsCallback(ACell: PCell; AStream: TStream);
procedure WriteCommentsCallback(AComment: PsComment;
ACommentIndex: Integer; AStream: TStream);
procedure WriteVmlDrawingsCallback(AComment: PsComment;
ACommentIndex: Integer; AStream: TStream);
protected
FDateMode: TDateMode;
@ -113,8 +115,6 @@ type
FSharedStringsCount: Integer;
FFillList: array of PsCellFormat;
FBorderList: array of PsCellFormat;
FDrawingCounter: Integer;
FNumCommentsOnSheet: Integer;
protected
{ Helper routines }
procedure CreateNumFormatList; override;
@ -1837,7 +1837,7 @@ begin
'<commentList>');
// Comments
IterateThroughCells(FSComments[FCurSheetNum], AWorksheet.Cells, WriteCommentsCallback);
IterateThroughComments(FSComments[FCurSheetNum], AWorksheet.Comments, WriteCommentsCallback);
// Footer
AppendToStream(FSComments[FCurSheetNum],
@ -1846,20 +1846,19 @@ begin
'</comments>');
end;
procedure TsSpreadOOXMLWriter.WriteCommentsCallback(ACell: PCell;
AStream: TStream);
procedure TsSpreadOOXMLWriter.WriteCommentsCallback(AComment: PsComment;
ACommentIndex: Integer; AStream: TStream);
var
comment: String;
begin
if (ACell = nil) or (ACell^.Comment = '') then
exit;
Unused(ACommentIndex);
comment := ACell^.Comment;
comment := AComment^.Text;
ValidXMLText(comment);
// Write comment to Comments stream
AppendToStream(AStream, Format(
'<comment ref="%s" authorId="0">', [GetCellString(ACell^.Row, ACell^.Col)]));
'<comment ref="%s" authorId="0">', [GetCellString(AComment^.Row, AComment^.Col)]));
AppendToStream(AStream,
'<text>'+
'<r>'+
@ -2141,7 +2140,10 @@ begin
AVLNode := AWorksheet.Cells.Find(@lCell);
if Assigned(AVLNode) then begin
WriteCellCallback(PCell(AVLNode.Data), AStream);
if PCell(AVLNode.Data)^.Comment <> '' then inc(FNumCommentsOnSheet);
{
if (cfHasComment in PCell(AVLNode.Data)^.Flags) then
inc(FNumCommentsOnSheet);
}
end;
end;
AppendToStream(AStream,
@ -2338,7 +2340,7 @@ begin
else
FSVmlDrawings[FCurSheetNum] := TMemoryStream.Create;
FDrawingCounter := 0;
// FDrawingCounter := 0;
// Header
AppendToStream(FSVmlDrawings[FCurSheetNum],
@ -2358,24 +2360,25 @@ begin
' </v:shapetype>' + LineEnding);
// Write vmlDrawings for each comment (formatting and position of comment box)
IterateThroughCells(FSVmlDrawings[FCurSheetNum], AWorksheet.Cells, WriteVmlDrawingsCallback);
IterateThroughComments(FSVmlDrawings[FCurSheetNum], AWorksheet.Comments, WriteVmlDrawingsCallback);
// IterateThroughCells(FSVmlDrawings[FCurSheetNum], AWorksheet.Cells, WriteVmlDrawingsCallback);
// Footer
AppendToStream(FSVmlDrawings[FCurSheetNum],
'</xml>');
end;
procedure TsSpreadOOXMLWriter.WriteVmlDrawingsCallback(ACell: PCell;
AStream: TStream);
procedure TsSpreadOOXMLWriter.WriteVmlDrawingsCallback(AComment: PsComment;
ACommentIndex: integer; AStream: TStream);
var
id: Integer;
begin
// id := (FCurSheetNum+1) * 1024 + ACell^.Col + ACell^.Row;
id := 1025 + FDrawingCounter; // if more than 1024 comments then use data="1,2,etc" above! -- not implemented yet
id := 1025 + ACommentIndex; // if more than 1024 comments then use data="1,2,etc" above! -- not implemented yet
// My xml viewer does not format vml files property --> format in code.
AppendToStream(AStream, LineEnding + Format(
' <v:shape id="_x0000_s%d" type="#_x0000_t202" ', [id]) + LineEnding + Format(
' style="position:absolute; width:108pt; height:52.5pt; z-index:%d; visibility:hidden" ', [FDrawingCounter+1]) + LineEnding +
' style="position:absolute; width:108pt; height:52.5pt; z-index:%d; visibility:hidden" ', [ACommentIndex+1]) + LineEnding +
// it is not necessary to specify margin-left and margin-top here!
// 'style=''position:absolute; margin-left:71.25pt; margin-top:1.5pt; ' + Format(
@ -2394,11 +2397,10 @@ begin
' <x:SizeWithCells />'+LineEnding+
' <x:Anchor> 1, 15, 0, 2, 2, 79, 4, 4</x:Anchor>'+LineEnding+
' <x:AutoFill>False</x:AutoFill>'+LineEnding + Format(
' <x:Row>%d</x:Row>', [ACell^.Row]) + LineEnding + Format(
' <x:Column>%d</x:Column>', [ACell^.Col]) + LineEnding +
' <x:Row>%d</x:Row>', [AComment^.Row]) + LineEnding + Format(
' <x:Column>%d</x:Column>', [AComment^.Col]) + LineEnding +
' </x:ClientData>'+ LineEnding+
' </v:shape>' + LineEnding);
inc(FDrawingCounter);
end;
procedure TsSpreadOOXMLWriter.WriteWorksheetRels(AWorksheet: TsWorksheet);
@ -2553,7 +2555,7 @@ begin
begin
FWorksheet := Workbook.GetWorksheetByIndex(i);
WriteWorksheet(FWorksheet);
if FNumCommentsOnSheet <> 0 then
if FWorksheet.Comments.Count > 0 then
begin
WriteComments(FWorksheet);
WriteVmlDrawings(FWorksheet);
@ -2618,7 +2620,6 @@ procedure TsSpreadOOXMLWriter.WriteWorksheet(AWorksheet: TsWorksheet);
begin
FCurSheetNum := Length(FSSheets);
SetLength(FSSheets, FCurSheetNum + 1);
FNumCommentsOnSheet := 0;
// Create the stream
if (boBufStream in Workbook.Options) then
@ -2639,7 +2640,7 @@ begin
WriteMergedCells(FSSheets[FCurSheetNum], AWorksheet);
// Footer
if FNumCommentsOnSheet > 0 then
if AWorksheet.Comments.Count > 0 then
AppendToStream(FSSheets[FCurSheetNum],
'<legacyDrawing r:id="rId1" />');
AppendToStream(FSSheets[FCurSheetNum],