diff --git a/components/fpspreadsheet/examples/other/demo_recursive_calc.pas b/components/fpspreadsheet/examples/other/demo_recursive_calc.pas index 9159d9f5e..ce565af72 100644 --- a/components/fpspreadsheet/examples/other/demo_recursive_calc.pas +++ b/components/fpspreadsheet/examples/other/demo_recursive_calc.pas @@ -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 diff --git a/components/fpspreadsheet/fps.inc b/components/fpspreadsheet/fps.inc index a9257d9c0..e8102b476 100644 --- a/components/fpspreadsheet/fps.inc +++ b/components/fpspreadsheet/fps.inc @@ -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. } diff --git a/components/fpspreadsheet/fpsexprparser.pas b/components/fpspreadsheet/fpsexprparser.pas index 180b7a1e8..283c3eade 100644 --- a/components/fpspreadsheet/fpsexprparser.pas +++ b/components/fpspreadsheet/fpsexprparser.pas @@ -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; diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index 5c2bf3cc6..9fa04d362 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -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( '' + 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: diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 351c5c5a5..48e1f86f7 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -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. diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas index a2481cbfd..150aea512 100644 --- a/components/fpspreadsheet/fpspreadsheetgrid.pas +++ b/components/fpspreadsheet/fpspreadsheetgrid.pas @@ -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); diff --git a/components/fpspreadsheet/fpstypes.pas b/components/fpspreadsheet/fpstypes.pas index d17b16dd2..6f0be9878 100644 --- a/components/fpspreadsheet/fpstypes.pas +++ b/components/fpspreadsheet/fpstypes.pas @@ -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; diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas index f36a21e4b..97c400b56 100755 --- a/components/fpspreadsheet/xlsbiff8.pas +++ b/components/fpspreadsheet/xlsbiff8.pas @@ -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 -------------------------------------------------------------------------------} 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 diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas index 0cbee944d..1d3288c4c 100644 --- a/components/fpspreadsheet/xlscommon.pas +++ b/components/fpspreadsheet/xlscommon.pas @@ -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; diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index 44cae96ce..d09fa5e89 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/components/fpspreadsheet/xlsxooxml.pas @@ -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 ''); // Comments - IterateThroughCells(FSComments[FCurSheetNum], AWorksheet.Cells, WriteCommentsCallback); + IterateThroughComments(FSComments[FCurSheetNum], AWorksheet.Comments, WriteCommentsCallback); // Footer AppendToStream(FSComments[FCurSheetNum], @@ -1846,20 +1846,19 @@ begin ''); 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( - '', [GetCellString(ACell^.Row, ACell^.Col)])); + '', [GetCellString(AComment^.Row, AComment^.Col)])); AppendToStream(AStream, ''+ ''+ @@ -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 ' ' + 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], ''); 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( ' ' + 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], ''); AppendToStream(FSSheets[FCurSheetNum],