diff --git a/components/fpspreadsheet/examples/csvdemo/csvread.lpr b/components/fpspreadsheet/examples/csvdemo/csvread.lpr index a463339f0..863fc9a82 100644 --- a/components/fpspreadsheet/examples/csvdemo/csvread.lpr +++ b/components/fpspreadsheet/examples/csvdemo/csvread.lpr @@ -9,7 +9,7 @@ program myexcel2read; {$mode delphi}{$H+} uses - Classes, SysUtils, fpstypes, fpspreadsheet, fpscsv; + Classes, SysUtils, LazUTF8, fpstypes, fpspreadsheet, fpscsv; var MyWorkbook: TsWorkbook; @@ -45,17 +45,16 @@ begin WriteLn('Contents of the first worksheet of the file:'); WriteLn(''); - CurCell := MyWorkSheet.GetFirstCell(); - for i := 0 to MyWorksheet.GetCellCount - 1 do + for CurCell in MyWorksheet.Cells do begin if HasFormula(CurCell) then WriteLn('Row: ', CurCell^.Row, ' Col: ', CurCell^.Col, ' Formula: ', MyWorksheet.ReadFormulaAsString(CurCell)) else - WriteLn('Row: ', CurCell^.Row, + WriteLn( + 'Row: ', CurCell^.Row, ' Col: ', CurCell^.Col, - ' Value: ', UTF8ToAnsi(MyWorkSheet.ReadAsUTF8Text(CurCell^.Row, CurCell^.Col)) + ' Value: ', UTF8ToConsole(MyWorkSheet.ReadAsUTF8Text(CurCell^.Row, CurCell^.Col)) ); - CurCell := MyWorkSheet.GetNextCell(); end; // Finalization diff --git a/components/fpspreadsheet/examples/excel2demo/excel2read.lpr b/components/fpspreadsheet/examples/excel2demo/excel2read.lpr index bd0858552..171948065 100644 --- a/components/fpspreadsheet/examples/excel2demo/excel2read.lpr +++ b/components/fpspreadsheet/examples/excel2demo/excel2read.lpr @@ -10,7 +10,7 @@ program excel2read; {$mode delphi}{$H+} uses - Classes, SysUtils, fpsTypes, fpspreadsheet, xlsbiff2; + Classes, SysUtils, LazUTF8, fpsTypes, fpspreadsheet, xlsbiff2; var MyWorkbook: TsWorkbook; @@ -19,6 +19,7 @@ var MyDir: string; i: Integer; CurCell: PCell; + begin // Open the input file MyDir := ExtractFilePath(ParamStr(0)); @@ -43,16 +44,14 @@ begin WriteLn('Contents of the first worksheet of the file:'); WriteLn(''); - CurCell := MyWorkSheet.GetFirstCell(); - for i := 0 to MyWorksheet.GetCellCount - 1 do + for CurCell in MyWorksheet.Cells do begin Write('Row: ', CurCell^.Row, ' Col: ', CurCell^.Col, ' Value: ', - UTF8ToAnsi(MyWorkSheet.ReadAsUTF8Text(CurCell^.Row, CurCell^.Col)) + UTF8ToConsole(MyWorkSheet.ReadAsUTF8Text(CurCell^.Row, CurCell^.Col)) ); if HasFormula(CurCell) then Write(' (Formula ', CurCell^.FormulaValue, ')'); WriteLn; - CurCell := MyWorkSheet.GetNextCell(); end; // Finalization diff --git a/components/fpspreadsheet/examples/excel5demo/excel5read.lpr b/components/fpspreadsheet/examples/excel5demo/excel5read.lpr index 00be9978d..bf8431f50 100644 --- a/components/fpspreadsheet/examples/excel5demo/excel5read.lpr +++ b/components/fpspreadsheet/examples/excel5demo/excel5read.lpr @@ -10,7 +10,7 @@ program excel5read; {$mode delphi}{$H+} uses - Classes, SysUtils, fpsTypes, fpspreadsheet, xlsbiff5; + Classes, SysUtils, LazUTF8, fpsTypes, fpspreadsheet, xlsbiff5; var MyWorkbook: TsWorkbook; @@ -41,16 +41,14 @@ begin WriteLn('Contents of the first worksheet of the file:'); WriteLn(''); - CurCell := MyWorkSheet.GetFirstCell(); - for i := 0 to MyWorksheet.GetCellCount - 1 do + for CurCell in MyWorksheet.Cells do begin Write('Row: ', CurCell^.Row, ' Col: ', CurCell^.Col, ' Value: ', - UTF8ToAnsi(MyWorkSheet.ReadAsUTF8Text(CurCell^.Row, CurCell^.Col))); + UTF8ToConsole(MyWorkSheet.ReadAsUTF8Text(CurCell^.Row, CurCell^.Col))); if HasFormula(CurCell) then Write(' - Formula: ', CurCell^.FormulaValue); WriteLn; - CurCell := MyWorkSheet.GetNextCell(); end; // Finalization diff --git a/components/fpspreadsheet/examples/excel8demo/excel8read.lpr b/components/fpspreadsheet/examples/excel8demo/excel8read.lpr index f6bfb198f..e2d69033e 100644 --- a/components/fpspreadsheet/examples/excel8demo/excel8read.lpr +++ b/components/fpspreadsheet/examples/excel8demo/excel8read.lpr @@ -10,7 +10,7 @@ program excel8read; {$mode delphi}{$H+} uses - Classes, SysUtils, fpsTypes, fpspreadsheet, xlsbiff8, + Classes, SysUtils, LazUTF8, fpsTypes, fpspreadsheet, xlsbiff8, fpsutils; var @@ -47,19 +47,17 @@ begin WriteLn('Contents of the first worksheet of the file:'); WriteLn(''); - CurCell := MyWorkSheet.GetFirstCell(); - for i := 0 to MyWorksheet.GetCellCount - 1 do + for CurCell in MyWorksheet.Cells do begin Write('Row: ', CurCell^.Row, ' Col: ', CurCell^.Col, ' Value: ', - UTF8ToAnsi(MyWorkSheet.ReadAsUTF8Text(CurCell^.Row, + UTF8ToConsole(MyWorkSheet.ReadAsUTF8Text(CurCell^.Row, CurCell^.Col)) ); if HasFormula(CurCell) then WriteLn(' Formula: ', MyWorkSheet.ReadFormulaAsString(CurCell)) else WriteLn; - CurCell := MyWorkSheet.GetNextCell(); end; // Finalization diff --git a/components/fpspreadsheet/examples/fpsctrls/demo_ctrls.lpi b/components/fpspreadsheet/examples/fpsctrls/demo_ctrls.lpi index 082126cb5..3ab548c5f 100644 --- a/components/fpspreadsheet/examples/fpsctrls/demo_ctrls.lpi +++ b/components/fpspreadsheet/examples/fpsctrls/demo_ctrls.lpi @@ -69,7 +69,6 @@ - diff --git a/components/fpspreadsheet/examples/fpsgrid_no_install/fpsgrid.lpr b/components/fpspreadsheet/examples/fpsgrid_no_install/fpsgrid.lpr index 1752eb846..75994f791 100644 --- a/components/fpspreadsheet/examples/fpsgrid_no_install/fpsgrid.lpr +++ b/components/fpspreadsheet/examples/fpsgrid_no_install/fpsgrid.lpr @@ -7,7 +7,7 @@ uses cthreads, {$ENDIF}{$ENDIF} Interfaces, // this includes the LCL widgetset - Forms, mainfrm, fpsCell + Forms, mainfrm { you can add units after this }; {$R *.res} diff --git a/components/fpspreadsheet/examples/ooxmldemo/ooxmlread.lpr b/components/fpspreadsheet/examples/ooxmldemo/ooxmlread.lpr index 22978992c..a69d6c0af 100644 --- a/components/fpspreadsheet/examples/ooxmldemo/ooxmlread.lpr +++ b/components/fpspreadsheet/examples/ooxmldemo/ooxmlread.lpr @@ -10,7 +10,7 @@ program ooxmlread; {$mode delphi}{$H+} uses - Classes, SysUtils, fpstypes, fpspreadsheet, xlsxooxml; //fpsallformats; + Classes, SysUtils, LazUTF8, fpstypes, fpspreadsheet, xlsxooxml; //fpsallformats; var MyWorkbook: TsWorkbook; @@ -45,14 +45,12 @@ begin WriteLn('Contents of the first worksheet of the file:'); WriteLn(''); - cell := MyWorkSheet.GetFirstCell(); - for i := 0 to MyWorksheet.GetCellCount - 1 do begin - WriteLn('Row: ', cell^.Row, - ' Col: ', cell^.Col, ' Value: ', - UTF8ToAnsi(MyWorkSheet.ReadAsUTF8Text(cell^.Row, cell^.Col)) + for cell in MyWorksheet.Cells do + WriteLn( + 'Row: ', cell^.Row, + ' Col: ', cell^.Col, + ' Value: ', UTF8ToConsole(MyWorkSheet.ReadAsUTF8Text(cell^.Row, cell^.Col)) ); - cell := MyWorkSheet.GetNextCell(); - end; // Finalization MyWorkbook.Free; diff --git a/components/fpspreadsheet/examples/opendocdemo/opendocread.lpr b/components/fpspreadsheet/examples/opendocdemo/opendocread.lpr index 1dd185352..2f6badcb9 100644 --- a/components/fpspreadsheet/examples/opendocdemo/opendocread.lpr +++ b/components/fpspreadsheet/examples/opendocdemo/opendocread.lpr @@ -11,7 +11,7 @@ program opendocread; {$mode delphi}{$H+} uses - Classes, SysUtils, fpstypes, fpspreadsheet, fpsallformats; + Classes, SysUtils, LazUTF8, fpstypes, fpspreadsheet, fpsallformats; var MyWorkbook: TsWorkbook; @@ -45,14 +45,12 @@ begin WriteLn('Contents of the first worksheet of the file:'); WriteLn(''); - cell := MyWorkSheet.GetFirstCell(); - for i := 0 to MyWorksheet.GetCellCount - 1 do begin - WriteLn('Row: ', cell^.Row, - ' Col: ', cell^.Col, ' Value: ', - UTF8ToAnsi(MyWorkSheet.ReadAsUTF8Text(cell^.Row, cell^.Col)) + for cell in MyWorksheet.Cells do + WriteLn( + 'Row: ', cell^.Row, + ' Col: ', cell^.Col, + ' Value: ', UTF8ToConsole(MyWorkSheet.ReadAsUTF8Text(cell^.Row, cell^.Col)) ); - cell := MyWorkSheet.GetNextCell(); - end; // Finalization MyWorkbook.Free; diff --git a/components/fpspreadsheet/examples/wikitabledemo/wikitableread.lpr b/components/fpspreadsheet/examples/wikitabledemo/wikitableread.lpr index 405400b0d..525a24b22 100644 --- a/components/fpspreadsheet/examples/wikitabledemo/wikitableread.lpr +++ b/components/fpspreadsheet/examples/wikitabledemo/wikitableread.lpr @@ -10,7 +10,7 @@ program wikitableread; {$mode delphi}{$H+} uses - Classes, SysUtils, + Classes, SysUtils, LazUTF8, fpstypes, fpspreadsheet, wikitable, fpsutils; var @@ -46,19 +46,16 @@ begin WriteLn('Contents of the first worksheet of the file:'); WriteLn(''); - CurCell := MyWorkSheet.GetFirstCell(); - for i := 0 to MyWorksheet.GetCellCount - 1 do + for CurCell in MyWorkSheet.Cells do begin Write('Row: ', CurCell^.Row, - ' Col: ', CurCell^.Col, ' Value: ', - UTF8ToAnsi(MyWorkSheet.ReadAsUTF8Text(CurCell^.Row, - CurCell^.Col)) - ); + ' Col: ', CurCell^.Col, ' Value: ', + UTF8ToConsole(MyWorkSheet.ReadAsUTF8Text(CurCell^.Row, CurCell^.Col)) + ); if HasFormula(CurCell) then WriteLn(' Formula: ', CurCell^.FormulaValue) else WriteLn; - CurCell := MyWorkSheet.GetNextCell(); end; // Finalization diff --git a/components/fpspreadsheet/fpsclasses.pas b/components/fpspreadsheet/fpsclasses.pas index 69dbc00ec..2269d2b8d 100644 --- a/components/fpspreadsheet/fpsclasses.pas +++ b/components/fpspreadsheet/fpsclasses.pas @@ -14,65 +14,52 @@ type { TsRowCol } TsRowCol = record - Row, Col: LongInt; + Row, Col: Cardinal; end; PsRowCol = ^TsRowCol; - { TAVLTreeNodeStack } - TAVLTreeNodeStack = class(TFPList) - public - procedure Push(ANode: TAVLTreeNode); - function Pop: TAVLTreeNode; - end; - { TsRowColEnumerator } TsRowColEnumerator = class protected FCurrentNode: TAVLTreeNode; FTree: TsRowColAVLTree; - FStartRow, FEndRow, FStartCol, FEndCol: LongInt; + FStartRow, FEndRow, FStartCol, FEndCol: Cardinal; FReverse: Boolean; function GetCurrent: PsRowCol; public constructor Create(ATree: TsRowColAVLTree; - AStartRow, AStartCol, AEndRow, AEndCol: LongInt; AReverse: Boolean); + AStartRow, AStartCol, AEndRow, AEndCol: Cardinal; AReverse: Boolean); function GetEnumerator: TsRowColEnumerator; inline; function MoveNext: Boolean; property Current: PsRowCol read GetCurrent; - property StartRow: LongInt read FStartRow; - property EndRow: LongInt read FEndRow; - property StartCol: LongInt read FStartCol; - property EndCol: LongInt read FEndCol; + property StartRow: Cardinal read FStartRow; + property EndRow: Cardinal read FEndRow; + property StartCol: Cardinal read FStartCol; + property EndCol: Cardinal read FEndCol; end; { TsRowColAVLTree } TsRowColAVLTree = class(TAVLTree) private FOwnsData: Boolean; - FCurrentNode: TAVLTreeNode; - FCurrentNodeStack: TAVLTreeNodeStack; 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: LongInt): PsRowCol; + function Add(ARow, ACol: Cardinal): PsRowCol; overload; procedure Clear; procedure Delete(ANode: TAVLTreeNode); overload; - procedure Delete(ARow, ACol: LongInt); overload; - procedure DeleteRowOrCol(AIndex: LongInt; IsRow: Boolean); virtual; - procedure Exchange(ARow1, ACol1, ARow2, ACol2: LongInt); virtual; - function Find(ARow, ACol: LongInt): PsRowCol; overload; + procedure Delete(ARow, ACol: Cardinal); overload; + procedure DeleteRowOrCol(AIndex: Cardinal; IsRow: Boolean); virtual; + procedure Exchange(ARow1, ACol1, ARow2, ACol2: Cardinal); virtual; + function Find(ARow, ACol: Cardinal): PsRowCol; overload; function GetData(ANode: TAVLTreeNode): PsRowCol; function GetFirst: PsRowCol; function GetLast: PsRowCol; - function GetNext: PsRowCol; - function GetPrev: PsRowCol; - procedure InsertRowOrCol(AIndex: LongInt; IsRow: Boolean); - procedure Remove(ARow, ACol: LongInt); overload; - procedure PushCurrent; - procedure PopCurrent; + procedure InsertRowOrCol(AIndex: Cardinal; IsRow: Boolean); + procedure Remove(ARow, ACol: Cardinal); overload; end; { TsCells } @@ -92,28 +79,28 @@ type function NewData: Pointer; override; public constructor Create(AWorksheet: Pointer; AOwnsData: Boolean = true); - function AddCell(ARow, ACol: LongInt): PCell; - procedure DeleteCell(ARow, ACol: LongInt); - function FindCell(ARow, ACol: LongInt): PCell; + function AddCell(ARow, ACol: Cardinal): PCell; + procedure DeleteCell(ARow, ACol: Cardinal); + function FindCell(ARow, ACol: Cardinal): PCell; function GetFirstCell: PCell; + function GetFirstCellOfRow(ARow: Cardinal): PCell; function GetLastCell: PCell; - function GetNextCell: PCell; - function GetPrevCell: PCell; + function GetLastCellOfRow(ARow: Cardinal): PCell; // enumerators function GetEnumerator: TsCellEnumerator; function GetReverseEnumerator: TsCellEnumerator; - function GetColEnumerator(ACol: LongInt; AStartRow: Longint = 0; - AEndRow: Longint = $7FFFFFFF): TsCellEnumerator; + function GetColEnumerator(ACol: Cardinal; AStartRow: Cardinal = 0; + AEndRow: Cardinal = $7FFFFFFF): TsCellEnumerator; function GetRangeEnumerator(AStartRow, AStartCol, - AEndRow, AEndCol: Longint): TsCellEnumerator; - function GetRowEnumerator(ARow: LongInt; AStartCol:LongInt = 0; - AEndCol: Longint = $7FFFFFFF): TsCellEnumerator; - function GetReverseColEnumerator(ACol: LongInt; AStartRow: Longint = 0; - AEndRow: Longint = $7FFFFFFF): TsCellEnumerator; + AEndRow, AEndCol: Cardinal): TsCellEnumerator; + function GetRowEnumerator(ARow: Cardinal; AStartCol:Cardinal = 0; + AEndCol: Cardinal = $7FFFFFFF): TsCellEnumerator; + function GetReverseColEnumerator(ACol: Cardinal; AStartRow: Cardinal = 0; + AEndRow: Cardinal = $7FFFFFFF): TsCellEnumerator; function GetReverseRangeEnumerator(AStartRow, AStartCol, - AEndRow, AEndCol: Longint): TsCellEnumerator; - function GetReverseRowEnumerator(ARow: LongInt; AStartCol:LongInt = 0; - AEndCol: Longint = $7FFFFFFF): TsCellEnumerator; + AEndRow, AEndCol: Cardinal): TsCellEnumerator; + function GetReverseRowEnumerator(ARow: Cardinal; AStartCol:Cardinal = 0; + AEndCol: Cardinal = $7FFFFFFF): TsCellEnumerator; end; { TsComments } @@ -135,7 +122,7 @@ type // enumerators function GetEnumerator: TsCommentEnumerator; function GetRangeEnumerator(AStartRow, AStartCol, - AEndRow, AEndCol: Longint): TsCommentEnumerator; + AEndRow, AEndCol: Cardinal): TsCommentEnumerator; end; { TsHyperlinks } @@ -152,50 +139,52 @@ type procedure DisposeData(var AData: Pointer); override; function NewData: Pointer; override; public - function AddHyperlink(ARow, ACol: Longint; ATarget: String; + function AddHyperlink(ARow, ACol: Cardinal; ATarget: String; ATooltip: String = ''): PsHyperlink; - procedure DeleteHyperlink(ARow, ACol: Longint); + procedure DeleteHyperlink(ARow, ACol: Cardinal); // enumerators function GetEnumerator: TsHyperlinkEnumerator; function GetRangeEnumerator(AStartRow, AStartCol, - AEndRow, AEndCol: Longint): TsHyperlinkEnumerator; + AEndRow, AEndCol: Cardinal): TsHyperlinkEnumerator; end; { TsMergedCells } + TsCellRangeEnumerator = class(TsRowColEnumerator) + protected + function GetCurrent: PsCellRange; + public + function GetEnumerator: TsCellRangeEnumerator; inline; + property Current: PsCellRange read GetCurrent; + end; + TsMergedCells = class(TsRowColAVLTree) protected procedure DisposeData(var AData: Pointer); override; function NewData: Pointer; override; public - function AddRange(ARow1, ACol1, ARow2, ACol2: Longint): PsCellRange; - procedure DeleteRange(ARow, ACol: Longint); - procedure DeleteRowOrCol(AIndex: Longint; IsRow: Boolean); override; - procedure Exchange(ARow1, ACol1, ARow2, ACol2: Longint); override; - function FindRangeWithCell(ARow, ACol: Longint): PsCellRange; + function AddRange(ARow1, ACol1, ARow2, ACol2: Cardinal): PsCellRange; + procedure DeleteRange(ARow, ACol: Cardinal); + procedure DeleteRowOrCol(AIndex: Cardinal; IsRow: Boolean); override; + procedure Exchange(ARow1, ACol1, ARow2, ACol2: Cardinal); override; + function FindRangeWithCell(ARow, ACol: Cardinal): PsCellRange; + // enumerators + function GetEnumerator: TsCellRangeEnumerator; end; + implementation uses Math, fpsUtils; + +{ Helper function for sorting } + function CompareRowCol(Item1, Item2: Pointer): Integer; begin - Result := LongInt(PsRowCol(Item1)^.Row) - PsRowCol(Item2)^.Row; + Result := Longint(PsRowCol(Item1)^.Row) - PsRowCol(Item2)^.Row; if Result = 0 then - Result := LongInt(PsRowCol(Item1)^.Col) - PsRowCol(Item2)^.Col; -end; - - -function TAVLTreeNodeStack.Pop: TAVLTreeNode; -begin - Result := TAVLTreeNode(Items[Count-1]); - Delete(Count-1); -end; - -procedure TAVLTreeNodeStack.Push(ANode: TAVLTreeNode); -begin - Add(ANode); + Result := Longint(PsRowCol(Item1)^.Col) - PsRowCol(Item2)^.Col; end; @@ -205,7 +194,7 @@ end; {******************************************************************************} constructor TsRowColEnumerator.Create(ATree: TsRowColAVLTree; - AStartRow, AStartCol, AEndRow, AEndCol: LongInt; AReverse: Boolean); + AStartRow, AStartCol, AEndRow, AEndCol: Cardinal; AReverse: Boolean); begin FTree := ATree; FReverse := AReverse; @@ -245,7 +234,7 @@ end; function TsRowColEnumerator.MoveNext: Boolean; var - r1,c1,r2,c2: LongInt; + r1,c1,r2,c2: Cardinal; item: TsRowCol; begin if FCurrentNode <> nil then begin @@ -268,16 +257,22 @@ begin end; end else begin - if FReverse and (FStartRow = $7FFFFFFF) and (FStartCol = $7FFFFFFF) then - FCurrentNode := FTree.FindHighest - else - if not FReverse and (FStartRow = 0) and (FStartCol = 0) then - FCurrentNode := FTree.FindLowest - else + if FReverse then begin - item.Row := FStartRow; - item.Col := FStartCol; - FCurrentNode := FTree.Find(@item); + FCurrentNode := FTree.FindHighest; + while (FCurrentNode <> nil) and + ( (Current^.Row < FEndRow) or (Current^.Row > FStartRow) or + (Current^.Col < FEndCol) or (Current^.Col > FStartCol) ) + do + FCurrentNode := FTree.FindPrecessor(FCurrentNode); + end else + begin + FCurrentNode := FTree.FindLowest; + while (FCurrentNode <> nil) and + ( (Current^.Row < FStartRow) or (Current^.Row > FEndRow) or + (Current^.Col < FStartCol) or (Current^.Col > FEndCol) ) + do + FCurrentNode := FTree.FindSuccessor(FCurrentNode); end; end; Result := FCurrentNode <> nil; @@ -298,7 +293,6 @@ constructor TsRowColAVLTree.Create(AOwnsData: Boolean = true); begin inherited Create(@CompareRowCol); FOwnsData := AOwnsData; - FCurrentNodeStack := TAVLTreeNodeStack.Create; end; {@@ ---------------------------------------------------------------------------- @@ -307,7 +301,6 @@ end; -------------------------------------------------------------------------------} destructor TsRowColAVLTree.Destroy; begin - FCurrentNodeStack.Free; Clear; inherited; end; @@ -316,7 +309,7 @@ end; Adds a new node to the tree identified by the specified row and column indexes. -------------------------------------------------------------------------------} -function TsRowColAVLTree.Add(ARow, ACol: LongInt): PsRowCol; +function TsRowColAVLTree.Add(ARow, ACol: Cardinal): PsRowCol; begin Result := NewData; Result^.Row := ARow; @@ -351,7 +344,7 @@ begin inherited Delete(ANode); end; -procedure TsRowColAVLTree.Delete(ARow, ACol: LongInt); +procedure TsRowColAVLTree.Delete(ARow, ACol: Cardinal); var node: TAVLTreeNode; cell: TCell; @@ -371,7 +364,7 @@ end; to be deleted @param IsRow Identifies whether AIndex refers to a row or column index -------------------------------------------------------------------------------} -procedure TsRowColAVLTree.DeleteRowOrCol(AIndex: LongInt; IsRow: Boolean); +procedure TsRowColAVLTree.DeleteRowOrCol(AIndex: Cardinal; IsRow: Boolean); var node, nextnode: TAVLTreeNode; item: PsRowCol; @@ -386,7 +379,7 @@ begin if item^.Row > AIndex then dec(item^.Row) else - // Remove the RowCol record if it is in the deleted row + // Remove and destroy the RowCol record if it is in the deleted row if item^.Row = AIndex then Delete(node); end else @@ -406,7 +399,7 @@ end; {@@ ---------------------------------------------------------------------------- Exchanges two nodes -------------------------------------------------------------------------------} -procedure TsRowColAVLTree.Exchange(ARow1, ACol1, ARow2, ACol2: LongInt); +procedure TsRowColAVLTree.Exchange(ARow1, ACol1, ARow2, ACol2: Cardinal); var item1, item2: PsRowCol; begin @@ -422,11 +415,11 @@ begin item1^.Col := ACol2; item2^.Row := ARow1; item2^.Col := ACol1; - inherited Add(item1); - inherited Add(item2); + inherited Add(item1); // The items are sorted to the correct position + inherited Add(item2); // when they are added to the tree end else - // Only the 1tst item exists --> give it the row/col indexes of the 2nd item + // Only the 1st item exists --> give it the row/col indexes of the 2nd item if (item1 <> nil) then begin Remove(item1); @@ -450,7 +443,7 @@ end; returns a pointer to the data record. Returns nil if such a node does not exist -------------------------------------------------------------------------------} -function TsRowColAVLTree.Find(ARow, ACol: LongInt): PsRowCol; +function TsRowColAVLTree.Find(ARow, ACol: Cardinal): PsRowCol; var data: TsRowCol; node: TAVLTreeNode; @@ -476,22 +469,6 @@ begin else Result := nil; end; - (* -function TsRowColAVLTree.GetEnumerator: TsRowColEnumerator; -begin - Result := TsRowColEnumerator.Create(self); -end; - -function TsRowColAVLTree.GetColEnumerator(ACol: LongInt): TsRowColEnumerator; -begin - Result := TsRowColEnumerator.Create(self, -1, ACol, -1, ACol); -end; - -function TsRowColAVLTree.GetRowEnumerator(ARow: LongInt): TsRowColEnumerator; -begin - Result := TsRowColEnumerator.Create(self, ARow, -1, ARow, -1); -end; - *) {@@ ---------------------------------------------------------------------------- The combination of the methods GetFirst and GetNext allow a fast iteration @@ -499,28 +476,12 @@ end; -------------------------------------------------------------------------------} function TsRowColAVLTree.GetFirst: PsRowCol; begin - FCurrentNode := FindLowest; - Result := GetData(FCurrentNode); + Result := GetData(FindLowest); end; function TsRowColAVLTree.GetLast: PsRowCol; begin - FCurrentNode := FindHighest; - Result := GetData(FCurrentNode); -end; - -function TsRowColAVLTree.GetNext: PsRowCol; -begin - if FCurrentNode <> nil then - FCurrentNode := FindSuccessor(FCurrentNode); - Result := GetData(FCurrentNode); -end; - -function TsRowColAVLTree.GetPrev: PsRowCol; -begin - if FCurrentNode <> nil then - FCurrentNode := FindPrecessor(FCurrentNode); - Result := GetData(FCurrentNode); + Result := GetData(FindHighest); end; {@@ ---------------------------------------------------------------------------- @@ -531,7 +492,7 @@ end; to be inserted @param IsRow Identifies whether AIndex refers to a row or column index -------------------------------------------------------------------------------} -procedure TsRowColAVLTree.InsertRowOrCol(AIndex: LongInt; IsRow: Boolean); +procedure TsRowColAVLTree.InsertRowOrCol(AIndex: Cardinal; IsRow: Boolean); var node: TAVLTreeNode; item: PsRowCol; @@ -553,7 +514,7 @@ end; {@@ ---------------------------------------------------------------------------- Removes the node, but does NOT destroy the associated data reocrd -------------------------------------------------------------------------------} -procedure TsRowColAVLTree.Remove(ARow, ACol: LongInt); +procedure TsRowColAVLTree.Remove(ARow, ACol: Cardinal); var node: TAVLTreeNode; item: TsRowCol; @@ -565,16 +526,6 @@ begin // Delete(node); end; -procedure TsRowColAVLTree.PopCurrent; -begin - FCurrentNode := FCurrentNodeStack.Pop; -end; - -procedure TsRowColAVLTree.PushCurrent; -begin - FCurrentNodeStack.Push(FCurrentNode); -end; - {******************************************************************************} { TsCellEnumerator: enumerator for the TsCells AVLTree } @@ -607,7 +558,7 @@ end; NOTE: It must be checked first that there ia no other record at the same col/row. (Check omitted for better performance). -------------------------------------------------------------------------------} -function TsCells.AddCell(ARow, ACol: LongInt): PCell; +function TsCells.AddCell(ARow, ACol: Cardinal): PCell; begin Result := PCell(Add(ARow, ACol)); end; @@ -616,7 +567,7 @@ end; Deletes the node for the specified row and column index along with the associated cell data record. -------------------------------------------------------------------------------} -procedure TsCells.DeleteCell(ARow, ACol: LongInt); +procedure TsCells.DeleteCell(ARow, ACol: Cardinal); begin Delete(ARow, ACol); end; @@ -635,7 +586,7 @@ end; {@@ ---------------------------------------------------------------------------- Checks whether a specific cell already exists -------------------------------------------------------------------------------} -function TsCells.FindCell(ARow, ACol: Longint): PCell; +function TsCells.FindCell(ARow, ACol: Cardinal): PCell; begin Result := PCell(Find(ARow, ACol)); end; @@ -648,28 +599,28 @@ begin Result := TsCellEnumerator.Create(self, 0, 0, $7FFFFFFF, $7FFFFFFF, false); end; -function TsCells.GetColEnumerator(ACol: LongInt; AStartRow: Longint = 0; - AEndRow: Longint = $7FFFFFFF): TsCellEnumerator; +function TsCells.GetColEnumerator(ACol: Cardinal; AStartRow: Cardinal = 0; + AEndRow: Cardinal = $7FFFFFFF): TsCellEnumerator; begin Result := TsCellEnumerator.Create(Self, AStartRow, ACol, AEndRow, ACol, false); end; function TsCells.GetRangeEnumerator(AStartRow, AStartCol, - AEndRow, AEndCol: Longint): TsCellEnumerator; + AEndRow, AEndCol: Cardinal): TsCellEnumerator; begin Result := TsCellEnumerator.Create(Self, AStartRow, AStartCol, AEndRow, AEndCol, false); end; -function TsCells.GetRowEnumerator(ARow: LongInt; AStartCol: Longint = 0; - AEndCol: LongInt = $7FFFFFFF): TsCellEnumerator; +function TsCells.GetRowEnumerator(ARow: Cardinal; AStartCol: Cardinal = 0; + AEndCol: Cardinal = $7FFFFFFF): TsCellEnumerator; begin Result := TsCellEnumerator.Create(Self, ARow, AStartCol, ARow, AEndCol, false); end; -function TsCells.GetReverseColEnumerator(ACol: LongInt; AStartRow: Longint = 0; - AEndRow: Longint = $7FFFFFFF): TsCellEnumerator; +function TsCells.GetReverseColEnumerator(ACol: Cardinal; AStartRow: Cardinal = 0; + AEndRow: Cardinal = $7FFFFFFF): TsCellEnumerator; begin Result := TsCellEnumerator.Create(Self, AStartRow, ACol, AEndRow, ACol, true); @@ -681,14 +632,14 @@ begin end; function TsCells.GetReverseRangeEnumerator(AStartRow, AStartCol, - AEndRow, AEndCol: Longint): TsCellEnumerator; + AEndRow, AEndCol: Cardinal): TsCellEnumerator; begin Result := TsCellEnumerator.Create(Self, AStartRow, AStartCol, AEndRow, AEndCol, true); end; -function TsCells.GetReverseRowEnumerator(ARow: LongInt; AStartCol: Longint = 0; - AEndCol: LongInt = $7FFFFFFF): TsCellEnumerator; +function TsCells.GetReverseRowEnumerator(ARow: Cardinal; AStartCol: Cardinal = 0; + AEndCol: Cardinal = $7FFFFFFF): TsCellEnumerator; begin Result := TsCellEnumerator.Create(Self, ARow, AStartCol, ARow, AEndCol, true); @@ -697,9 +648,6 @@ end; {@@ ---------------------------------------------------------------------------- Returns a pointer to the first cell of the tree. - Should always be followed by GetNextCell. - - Use to iterate through all cells efficiently. -------------------------------------------------------------------------------} function TsCells.GetFirstCell: PCell; begin @@ -707,10 +655,18 @@ begin end; {@@ ---------------------------------------------------------------------------- - Returns a pointer to the last cell of the tree. + Returns a pointer to the first cell in a specified row +-------------------------------------------------------------------------------} +function TsCells.GetFirstCellOfRow(ARow: Cardinal): PCell; +begin + Result := nil; + // Creating the row enumerator automatically finds the first cell of the row + for Result in GetRowEnumerator(ARow) do + exit; +end; - Needed for efficient iteration through all nodes in reverse direction by - calling GetPrev. +{@@ ---------------------------------------------------------------------------- + Returns a pointer to the last cell of the tree. -------------------------------------------------------------------------------} function TsCells.GetLastCell: PCell; begin @@ -718,25 +674,14 @@ begin end; {@@ ---------------------------------------------------------------------------- - After beginning an iteration through all cells with GetFirstCell, the next - available cell can be found by calling GetNextCell. - - Use to iterate througt all cells efficiently. + Returns a pointer to the last cell of a specified row -------------------------------------------------------------------------------} -function TsCells.GetNextCell: PCell; +function TsCells.GetLastCellOfRow(ARow: Cardinal): PCell; begin - Result := PCell(GetNext); -end; - -{@@ ---------------------------------------------------------------------------- - After beginning a reverse iteration through all cells with GetLastCell, - the next available cell can be found by calling GetPrevCell. - - Use to iterate througt all cells efficiently in reverse order. --------------------------------------------------------------------------------} -function TsCells.GetPrevCell: PCell; -begin - Result := PCell(GetPrev); + Result := nil; + // Creating the reverse row enumerator finds the last cell of the row + for Result in GetReverseRowEnumerator(ARow) do + exit; end; {@@ ---------------------------------------------------------------------------- @@ -826,7 +771,7 @@ begin end; function TsComments.GetRangeEnumerator(AStartRow, AStartCol, - AEndRow, AEndCol: Longint): TsCommentEnumerator; + AEndRow, AEndCol: Cardinal): TsCommentEnumerator; begin Result := TsCommentEnumerator.Create(Self, AStartRow, AStartCol, AEndRow, AEndCol, false); @@ -847,6 +792,7 @@ begin Result := PsHyperlink(inherited GetCurrent); end; + {******************************************************************************} { TsHyperlinks: an AVLTree to store hyperlink records for cells } {******************************************************************************} @@ -856,7 +802,7 @@ end; exists then its data will be replaced by the specified ones. Returns a pointer to the hyperlink record. -------------------------------------------------------------------------------} -function TsHyperlinks.AddHyperlink(ARow, ACol: Longint; ATarget: String; +function TsHyperlinks.AddHyperlink(ARow, ACol: Cardinal; ATarget: String; ATooltip: String = ''): PsHyperlink; begin Result := PsHyperlink(Find(ARow, ACol)); @@ -870,7 +816,7 @@ end; Deletes the node for the specified row and column index along with the associated hyperlink data record. -------------------------------------------------------------------------------} -procedure TsHyperlinks.DeleteHyperlink(ARow, ACol: Longint); +procedure TsHyperlinks.DeleteHyperlink(ARow, ACol: Cardinal); begin Delete(ARow, ACol); end; @@ -895,7 +841,7 @@ begin end; function TsHyperlinks.GetRangeEnumerator(AStartRow, AStartCol, - AEndRow, AEndCol: Longint): TsHyperlinkEnumerator; + AEndRow, AEndCol: Cardinal): TsHyperlinkEnumerator; begin Result := TsHyperlinkEnumerator.Create(Self, AStartRow, AStartCol, AEndRow, AEndCol, false); @@ -914,7 +860,22 @@ end; {******************************************************************************} -{ TsMergedCell: a AVLTree to store merged cell range records for cells } +{ TsCellRangeEnumerator: enumerator for the cell range records } +{******************************************************************************} + +function TsCellRangeEnumerator.GetEnumerator: TsCellRangeEnumerator; +begin + Result := self; +end; + +function TsCellRangeEnumerator.GetCurrent: PsCellRange; +begin + Result := PsCellRange(inherited GetCurrent); +end; + + +{******************************************************************************} +{ TsMergedCells: a AVLTree to store merged cell range records for cells } {******************************************************************************} {@@ ---------------------------------------------------------------------------- @@ -922,7 +883,7 @@ end; exists then its data will be replaced by the specified ones. Returns a pointer to the cell range record. -------------------------------------------------------------------------------} -function TsMergedCells.AddRange(ARow1, ACol1, ARow2, ACol2: Longint): PsCellRange; +function TsMergedCells.AddRange(ARow1, ACol1, ARow2, ACol2: Cardinal): PsCellRange; begin Result := PsCellRange(Find(ARow1, ACol1)); if Result = nil then @@ -935,7 +896,7 @@ end; Deletes the node for which the top/left corner of the cell range matches the specified parameters. There is only a single range fulfilling this criterion. -------------------------------------------------------------------------------} -procedure TsMergedCells.DeleteRange(ARow, ACol: Longint); +procedure TsMergedCells.DeleteRange(ARow, ACol: Cardinal); begin Delete(ARow, ACol); end; @@ -948,21 +909,25 @@ end; to be deleted @param IsRow Identifies whether AIndex refers to a row or column index -------------------------------------------------------------------------------} -procedure TsMergedCells.DeleteRowOrCol(AIndex: Longint; IsRow: Boolean); +procedure TsMergedCells.DeleteRowOrCol(AIndex: Cardinal; IsRow: Boolean); var - rng, nextrng: PsCellRange; + rng: PsCellRange; + R: TsCellRange; + node, nextnode: TAVLTreeNode; begin - rng := PsCellRange(GetFirst); - while Assigned(rng) do begin - nextrng := PsCellRange(GetNext); + node := FindLowest; + while Assigned(node) do begin + rng := PsCellRange(node.Data); + nextnode := FindSuccessor(node); if IsRow then begin // Deleted row is above the merged range --> Shift entire range up by 1 // NOTE: // The "merged" flags do not have to be changed, they move with the cells. if (AIndex < rng^.Row1) then begin - dec(rng^.Row1); - dec(rng^.Row2); + R := rng^; // Store range parameters + Delete(node); // Delete node from tree, adapt the row indexes, ... + AddRange(R.Row1-1, R.Col1, R.Row2-1, R.Col2); // ... and re-insert to get it sorted correctly end else // Single-row merged block coincides with row to be deleted if (AIndex = rng^.Row1) and (rng^.Row1 = rng^.Row2) then @@ -971,7 +936,7 @@ begin // Deleted row runs through the merged block --> Shift bottom row up by 1 // NOTE: The "merged" flags disappear with the deleted cells if (AIndex >= rng^.Row1) and (AIndex <= rng^.Row2) then - dec(rng^.Row2); + dec(rng^.Row2); // no need to remove & re-insert because Row1 does not change end else begin // Deleted column is at the left of the merged range @@ -979,8 +944,9 @@ begin // NOTE: // The "merged" flags do not have to be changed, they move with the cells. if (AIndex < rng^.Col1) then begin - dec(rng^.Col1); - dec(rng^.Col2); + R := rng^; + Delete(node); + AddRange(R.Row1, R.Col1-1, R.Row2, R.Col2-1); end else // Single-column block coincides with the column to be deleted // NOTE: The "merged" flags disappear with the deleted cells @@ -993,7 +959,7 @@ begin dec(rng^.Col2); end; // Proceed with next merged range - rng := nextrng; + node := nextnode; end; end; @@ -1008,10 +974,10 @@ begin AData := nil; end; -procedure TsMergedCells.Exchange(ARow1, ACol1, ARow2, ACol2: Longint); +procedure TsMergedCells.Exchange(ARow1, ACol1, ARow2, ACol2: Cardinal); var rng: PsCellrange; - dr, dc: LongInt; + dr, dc: Cardinal; begin rng := PsCellrange(Find(ARow1, ACol1)); if rng <> nil then @@ -1042,7 +1008,7 @@ end; Finds the cell range which contains the cell specified by its row and column index -------------------------------------------------------------------------------} -function TsMergedCells.FindRangeWithCell(ARow, ACol: Longint): PsCellRange; +function TsMergedCells.FindRangeWithCell(ARow, ACol: Cardinal): PsCellRange; var node: TAVLTreeNode; begin @@ -1056,6 +1022,14 @@ begin end; end; +{@@ ---------------------------------------------------------------------------- + Cell range enumerator (use in "for ... in" syntax) +-------------------------------------------------------------------------------} +function TsMergedCells.GetEnumerator: TsCellRangeEnumerator; +begin + Result := TsCellRangeEnumerator.Create(self, 0, 0, $7FFFFFFF, $7FFFFFFF, false); +end; + {@@ ---------------------------------------------------------------------------- Alloates memory of a merged cell range data record. -------------------------------------------------------------------------------} diff --git a/components/fpspreadsheet/fpscsv.pas b/components/fpspreadsheet/fpscsv.pas index 55b774d0e..345b1d521 100644 --- a/components/fpspreadsheet/fpscsv.pas +++ b/components/fpspreadsheet/fpscsv.pas @@ -604,7 +604,7 @@ procedure TsCSVWriter.WriteSheet(AStream: TStream; AWorksheet: TsWorksheet); var r, c: Cardinal; LastRow, LastCol: Cardinal; - Cell: PCell; + cell: PCell; begin FWorksheet := AWorksheet; @@ -618,6 +618,12 @@ begin LastRow := FWorksheet.GetLastOccupiedRowIndex; LastCol := FWorksheet.GetLastOccupiedColIndex; for r := 0 to LastRow do + begin + for cell in FWorksheet.Cells.GetRowEnumerator(r) do + WriteCellToStream(AStream, cell); + FCSVBuilder.AppendRow; + end; + { for c := 0 to LastCol do begin Cell := FWorksheet.FindCell(r, c); @@ -626,6 +632,7 @@ begin if c = LastCol then FCSVBuilder.AppendRow; end; + } finally FreeAndNil(FCSVBuilder); end; diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index 724a12fc0..c1618550c 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -3226,12 +3226,12 @@ begin end else // Look for empty rows with the same style, they need the "number-rows-repeated" element. - if (ASheet.GetFirstCellOfRow(r) = nil) then + if (ASheet.Cells.GetFirstCellOfRow(r) = nil) then begin rr := r + 1; while (rr <= lastRow) do begin - if ASheet.GetFirstCellOfRow(rr) <> nil then + if ASheet.Cells.GetFirstCellOfRow(rr) <> nil then break; h1 := ASheet.GetRowHeight(rr); if not SameValue(h, h1, ROWHEIGHT_EPS) then @@ -3295,7 +3295,8 @@ begin AppendToStream(AStream, Format( '', [colsRepeatedStr])); end else - WriteCellCallback(cell, AStream); + WriteCellToStream(AStream, cell); +// WriteCellCallback(cell, AStream); inc(c, colsRepeated); end; @@ -3980,7 +3981,8 @@ begin lCell.BoolValue := value <> 0; end else lCell.ContentType := cctEmpty; - WriteCellCallback(@lCell, AStream); + WriteCellToStream(AStream, @lCell); +// WriteCellCallback(@lCell, AStream); end; inc(c, colsRepeated); end; diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index c7d9e0918..93f96c4a4 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -363,8 +363,8 @@ type function GetCellCount: Cardinal; - function GetFirstCellOfRow(ARow: Cardinal): PCell; - function GetLastCellOfRow(ARow: Cardinal): PCell; +// function GetFirstCellOfRow(ARow: Cardinal): PCell; +// function GetLastCellOfRow(ARow: Cardinal): PCell; function GetFirstColIndex(AForceCalculation: Boolean = false): Cardinal; function GetLastColIndex(AForceCalculation: Boolean = false): Cardinal; function GetLastColNumber: Cardinal; deprecated 'Use GetLastColIndex'; @@ -1284,38 +1284,33 @@ var i: Integer; rpnFormula: TsRPNFormula; begin - FCells.PushCurrent; - try - cell := FCells.GetFirstCell; - while Assigned(cell) do begin - if HasFormula(cell) then begin - rpnFormula := BuildRPNFormula(cell); - for i := 0 to Length(rpnFormula)-1 do - begin - fe := rpnFormula[i]; - case fe.ElementKind of - fekCell, fekCellRef: - if (fe.Row = ARow) and (fe.Col = ACol) then - begin - Result := true; - exit; - end; - fekCellRange: - if (fe.Row <= ARow) and (ARow <= fe.Row2) and - (fe.Col <= ACol) and (ACol <= fe.Col2) then - begin - Result := true; - exit; - end; - end; + for cell in FCells do + begin + if HasFormula(cell) then begin + rpnFormula := BuildRPNFormula(cell); + for i := 0 to Length(rpnFormula)-1 do + begin + fe := rpnFormula[i]; + case fe.ElementKind of + fekCell, fekCellRef: + if (fe.Row = ARow) and (fe.Col = ACol) then + begin + Result := true; + exit; + end; + fekCellRange: + if (fe.Row <= ARow) and (ARow <= fe.Row2) and + (fe.Col <= ACol) and (ACol <= fe.Col2) then + begin + Result := true; + exit; + end; end; end; - cell := FCells.GetNextCell; end; - finally - FCells.PopCurrent; end; SetLength(rpnFormula, 0); + Result := false; end; {@@ ---------------------------------------------------------------------------- @@ -2184,25 +2179,9 @@ var begin if AForceCalculation then begin - Result := $FFFFFFFF; + Result := Cardinal(-1); for cell in FCells do Result := Math.Min(Result, cell^.Col); - - (* - // Traverse the tree from lowest to highest. - // Since tree primary sort order is on row lowest col could exist anywhere. - FCells.PushCurrent; - try - cell := FCells.GetFirstCell; - while Assigned(cell) do - begin - Result := Math.Min(Result, cell^.Col); - cell := FCells.GetNextCell; - end; - finally - FCells.PopCurrent; - end; - *) // In addition, there may be column records defining the column width even // without content for i:=0 to FCols.Count-1 do @@ -2214,14 +2193,14 @@ begin else begin Result := FFirstColIndex; - if Result = $FFFFFFFF then + if Result = cardinal(-1) then Result := GetFirstColIndex(true); end; end; {@@ ---------------------------------------------------------------------------- - Returns the 0-based index of the last column with a cell with contents or - with a column record. + Returns the 0-based index of the last column containing a cell with a + column record (due to content or formatting), or containing a Col record. If no cells have contents or there are no column records, zero will be returned, which is also a valid value. @@ -2243,11 +2222,10 @@ begin if AForceCalculation then begin // Traverse the tree from lowest to highest. - // Since tree primary sort order is on row - // highest col could exist anywhere. + // Since tree primary sort order is on row highest col could exist anywhere. Result := GetLastOccupiedColIndex; // In addition, there may be column records defining the column width even - // without content + // without cells for i:=0 to FCols.Count-1 do if FCols[i] <> nil then Result := Math.Max(Result, PCol(FCols[i])^.Col); @@ -2287,21 +2265,8 @@ begin // Since tree's primary sort order is on row, highest col could exist anywhere. for cell in FCells do Result := Math.Max(Result, cell^.Col); - { - FCells.PushCurrent; - try - cell := FCells.GetFirstCell; - while Assigned(cell) do - begin - Result := Math.Max(Result, cell^.Col); - cell := FCells.GetNextCell; - end; - finally - FCells.PopCurrent; - end; - } end; - + (* {@@ ---------------------------------------------------------------------------- Finds the first cell with contents in a given row @@ -2309,17 +2274,8 @@ end; @return Pointer to the first cell in this row, or nil if the row is empty. -------------------------------------------------------------------------------} function TsWorksheet.GetFirstCellOfRow(ARow: Cardinal): PCell; -var - c, n: Cardinal; begin - n := GetLastColIndex; - c := 0; - Result := FindCell(ARow, c); - while (result = nil) and (c < n) do - begin - inc(c); - result := FindCell(ARow, c); - end; + Result := FCells.GetFirstCellOfRow(ARow); end; {@@ ---------------------------------------------------------------------------- @@ -2329,19 +2285,10 @@ end; @return Pointer to the last cell in this row, or nil if the row is empty. -------------------------------------------------------------------------------} function TsWorksheet.GetLastCellOfRow(ARow: Cardinal): PCell; -var - c, n: Cardinal; begin - n := GetLastColIndex; - c := n; - Result := FindCell(ARow, c); - while (Result = nil) and (c > 0) do - begin - dec(c); - Result := FindCell(ARow, c); - end; + Result := FCells.GetLastCellOfRow(ARow); end; - + *) {@@ ---------------------------------------------------------------------------- Returns the 0-based index of the first row with a cell with data or formatting. If no cells have contents, -1 will be returned. @@ -2360,14 +2307,8 @@ begin if AForceCalculation then begin Result := $FFFFFFFF; - FCells.PushCurrent; - try - cell := FCells.GetFirstCell; - finally - FCells.PopCurrent; - end; - if Assigned(cell) then - Result := cell^.Row; + cell := FCells.GetFirstCell; + if cell <> nil then Result := cell^.Row; // In addition, there may be row records even for rows without cells. for i:=0 to FRows.Count-1 do if FRows[i] <> nil then @@ -2378,13 +2319,14 @@ begin else begin Result := FFirstRowIndex; - if Result = $FFFFFFFF then + if Result = Cardinal(-1) then Result := GetFirstRowIndex(true); end; end; {@@ ---------------------------------------------------------------------------- - Returns the 0-based index of the last row with a cell with contents. + Returns the 0-based index of the last row with a cell with contents or with + a ROW record. If no cells have contents, zero will be returned, which is also a valid value. @@ -3125,13 +3067,8 @@ begin // ... yes: --> modify the merged range accordingly begin // unmark previously merged range - for r := rng^.Row1 to rng^.Row2 do - for c := rng^.Col1 to rng^.Col2 do - begin - cell := FindCell(r, c); - if cell <> nil then // nil happens when col/row is inserted... - Exclude(cell^.Flags, cfMerged); - end; + for cell in Cells.GetRangeEnumerator(rng^.Row1, rng^.Col1, rng^.Row2, rng^.Col2) do + Exclude(cell^.Flags, cfMerged); // Define new limits of merged range rng^.Row2 := ARow2; rng^.Col2 := ACol2; @@ -3180,13 +3117,10 @@ begin if rng <> nil then begin // Remove the "merged" flag from the cells in the merged range to make them - // isolated again. - for r := rng^.Row1 to rng^.Row2 do - for c := rng^.Col1 to rng^.Col2 do - begin - cell := FindCell(r, c); - Exclude(cell^.Flags, cfMerged); - end; + // isolated again... + for cell in Cells.GetRangeEnumerator(rng^.Row1, rng^.Col1, rng^.Row2, rng^.Col2) do + Exclude(cell^.Flags, cfMerged); + // ... and delete the range FMergedCells.DeleteRange(rng^.Row1, rng^.Col1); end; @@ -3363,8 +3297,12 @@ procedure TsWorksheet.FixSharedFormulas; var r,c, r1,c1, r2,c2: Cardinal; cell: PCell; - firstRow, firstCol, lastRow, lastCol: Cardinal; +// firstRow, firstCol, lastRow, lastCol: Cardinal; begin + for cell in Cells do + if FindSharedFormulaRange(cell, r1, c1, r2, c2) and (r1 = r2) and (c1 = c2) then + cell^.SharedFormulaBase := nil; + { firstRow := GetFirstRowIndex; firstCol := GetFirstColIndex; lastRow := GetLastOccupiedRowIndex; @@ -3376,6 +3314,7 @@ begin if FindSharedFormulaRange(cell, r1, c1, r2, c2) and (r1 = r2) and (c1 = c2) then cell^.SharedFormulaBase := nil; end; + } end; {@@ ---------------------------------------------------------------------------- @@ -3678,10 +3617,14 @@ procedure TsWorksheet.Sort(const ASortParams: TsSortParams; function ContainsMergedCells: boolean; var - r,c: Cardinal; + //r,c: Cardinal; cell: PCell; begin result := false; + for cell in Cells.GetRangeEnumerator(ARowFrom, AColFrom, ARowTo, AColTo) do + if IsMerged(cell) then + exit(true); + { for r := ARowFrom to ARowTo do for c := AColFrom to AColTo do begin @@ -3689,6 +3632,7 @@ procedure TsWorksheet.Sort(const ASortParams: TsSortParams; if IsMerged(cell) then exit(true); end; + } end; begin @@ -5749,11 +5693,15 @@ var begin Result := 0; h0 := Workbook.GetDefaultFontSize; + for cell in Cells.GetRowEnumerator(ARow) do + Result := Max(Result, ReadCellFont(cell).Size / h0); + { for col := GetFirstColIndex to GetLastColIndex do begin cell := FindCell(ARow, col); if cell <> nil then Result := Max(Result, ReadCellFont(cell).Size / h0); end; + } end; {@@ ---------------------------------------------------------------------------- @@ -5993,16 +5941,8 @@ begin RemoveAndFreeCell(r, ACol); // Update column index of cell records - FCells.PushCurrent; - try - cell := FCells.GetFirstCell; - while Assigned(cell) do begin - DeleteColCallback(cell, {%H-}pointer(PtrInt(ACol))); - cell := FCells.GetNextCell; - end; - finally - FCells.PopCurrent; - end; + for cell in FCells do + DeleteColCallback(cell, {%H-}pointer(PtrInt(ACol))); // Update column index of col records for i:=FCols.Count-1 downto 0 do begin @@ -6080,11 +6020,8 @@ begin RemoveAndFreeCell(ARow, c); // Update row index of cell records - cell := FCells.GetFirstCell; - while Assigned(cell) do begin + for cell in FCells do DeleteRowCallback(cell, {%H-}pointer(PtrInt(ARow))); - cell := FCells.GetNextCell; - end; // Update row index of row records for i:=FRows.Count-1 downto 0 do @@ -6119,11 +6056,8 @@ var begin // Handling of shared formula references is too complicated for me... // Split them into isolated cell formulas - cell := FCells.GetFirstCell; - while Assigned(cell) do begin + for cell in FCells do SplitSharedFormula(cell); - cell := FCells.GetNextCell; - end; // Update column index of comments FComments.InsertRowOrCol(ACol, false); @@ -6132,11 +6066,8 @@ begin FHyperlinks.InsertRowOrCol(ACol, false); // Update column index of cell records - cell := FCells.GetFirstCell; - while Assigned(cell) do begin + for cell in FCells do InsertColCallback(cell, {%H-}pointer(PtrInt(ACol))); - cell := FCells.GetNextCell; - end; // Update column index of column records for i:=0 to FCols.Count-1 do begin @@ -6148,39 +6079,48 @@ begin UpdateCaches; // Fix merged cells - rng := PsCellRange(FMergedCells.GetFirst); - while rng <> nil do + for rng in FMergedCells do +// rng := PsCellRange(FMergedCells.GetFirst); +// while rng <> nil do begin // The new column is at the LEFT of the merged block // --> Shift entire range to the right by 1 column if (ACol < rng^.Col1) then begin // The former first column is no longer marged --> un-tag its cells + for cell in Cells.GetColEnumerator(rng^.Col1, rng^.Row1, rng^.Row2) do + Exclude(cell^.Flags, cfMerged); + { for r := rng^.Row1 to rng^.Row2 do begin cell := FindCell(r, rng^.Col1); if cell <> nil then Exclude(cell^.Flags, cfMerged); end; + } // Shift merged block to the right // Don't call "MergeCells" here - this would add a new merged block // because of the new merge base! --> infinite loop! inc(rng^.Col1); inc(rng^.Col2); // The right column needs to be tagged + for cell in Cells.GetColEnumerator(rng^.Col2, rng^.Row1, rng^.Row2) do + Include(cell^.Flags, cfMerged); + { for r := rng^.Row1 to rng^.Row2 do begin cell := FindCell(R, rng^.Col2); if cell <> nil then Include(cell^.Flags, cfMerged); end; + } end else // The new column goes through this cell block --> Shift only the right // column of the range to the right by 1 if (ACol >= rng^.Col1) and (ACol <= rng^.Col2) then MergeCells(rng^.Row1, rng^.Col1, rng^.Row2, rng^.Col2+1); // Continue with next merged block - rng := PsCellRange(FMergedCells.GetNext); +// rng := PsCellRange(FMergedCells.GetNext); end; ChangedCell(0, ACol); @@ -6242,11 +6182,8 @@ var begin // Handling of shared formula references is too complicated for me... // Splits them into isolated cell formulas - cell := FCells.GetFirstCell; - while Assigned(cell) do begin + for cell in FCells do SplitSharedFormula(cell); - cell := FCells.GetNextCell; - end; // Update row index of cell comments FComments.InsertRowOrCol(ARow, true); @@ -6255,11 +6192,8 @@ begin FHyperlinks.InsertRowOrCol(ARow, true); // Update row index of cell records - cell := FCells.GetFirstCell; - while Assigned(cell) do begin + for cell in FCells do InsertRowCallback(cell, {%H-}pointer(PtrInt(ARow))); - cell := FCells.GetNextCell; - end; // Update row index of row records for i:=0 to FRows.Count-1 do begin @@ -6271,38 +6205,47 @@ begin UpdateCaches; // Fix merged cells - rng := PsCellRange(FMergedCells.GetFirst); - while rng <> nil do + for rng in FMergedCells do +// rng := PsCellRange(FMergedCells.GetFirst); +// while rng <> nil do begin // The new row is ABOVE the merged block --> Shift entire range down by 1 row if (ARow < rng^.Row1) then begin // The formerly first row is no longer merged --> un-tag its cells + for cell in Cells.GetRowEnumerator(rng^.Row1, rng^.Col1, rng^.Col2) do + Exclude(cell^.Flags, cfMerged); + { for c := rng^.Col1 to rng^.Col2 do begin cell := FindCell(rng^.Row1, c); if cell <> nil then Exclude(cell^.Flags, cfMerged); end; + } // Shift merged block down // (Don't call "MergeCells" here - this would add a new merged block // because of the new merge base! --> infinite loop!) inc(rng^.Row1); inc(rng^.Row2); // The last row needs to be tagged + for cell in Cells.GetRowEnumerator(rng^.Row2, rng^.Col1, rng^.Col2) do + Include(cell^.Flags, cfMerged); + { for c := rng^.Col1 to rng^.Col2 do begin cell := FindCell(rng^.Row2, c); if cell <> nil then Include(cell^.Flags, cfMerged); end; + } end else // The new row goes through this cell block --> Shift only the bottom row // of the range down by 1 if (ARow >= rng^.Row1) and (ARow <= rng^.Row2) then MergeCells(rng^.Row1, rng^.Col1, rng^.Row2+1, rng^.Col2); // Continue with next block - rng := PsCellRange(FMergedCells.GetNext); +// rng := PsCellRange(FMergedCells.GetNext); end; ChangedCell(ARow, 0); @@ -8080,8 +8023,7 @@ begin for i:=0 to GetWorksheetCount-1 do begin sheet := GetWorksheetByIndex(i); - cell := sheet.Cells.GetFirstCell; - while Assigned(cell) do + for cell in sheet.Cells do begin fmt := GetPointerToCellFormat(cell^.FormatIndex); if (uffBackground in fmt^.UsedFormattingFields) then @@ -8099,7 +8041,6 @@ begin if fnt.Color = AColorIndex then exit; end; - cell := sheet.Cells.GetNextCell; end; end; Result := false; diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas index 6d167baa8..85c32981f 100644 --- a/components/fpspreadsheet/fpspreadsheetgrid.pas +++ b/components/fpspreadsheet/fpspreadsheetgrid.pas @@ -75,9 +75,9 @@ type function CalcRowHeight(AHeight: Single): Integer; procedure ChangedCellHandler(ASender: TObject; ARow, ACol: Cardinal); procedure ChangedFontHandler(ASender: TObject; ARow, ACol: Cardinal); - procedure FixNeighborCellBorders(ACol, ARow: Integer); + procedure FixNeighborCellBorders(ACell: PCell); function GetBorderStyle(ACol, ARow, ADeltaCol, ADeltaRow: Integer; - out ABorderStyle: TsCellBorderStyle): Boolean; + ACell: PCell; out ABorderStyle: TsCellBorderStyle): Boolean; // Setter/Getter function GetBackgroundColor(ACol, ARow: Integer): TsColor; @@ -155,7 +155,7 @@ type procedure DoPrepareCanvas(ACol, ARow: Integer; AState: TGridDrawState); override; procedure DrawAllRows; override; procedure DrawCellBorders; overload; - procedure DrawCellBorders(ACol, ARow: Integer; ARect: TRect); overload; + procedure DrawCellBorders(ACol, ARow: Integer; ARect: TRect; ACell: PCell); overload; procedure DrawCellGrid(ACol,ARow: Integer; ARect: TRect; AState: TGridDrawState); override; procedure DrawCommentMarker(ARect: TRect); procedure DrawFocusRect(aCol,aRow:Integer; ARect:TRect); override; @@ -1502,7 +1502,7 @@ begin c := GetGridCol(cell^.Col); r := GetGridRow(cell^.Row); rect := CellRect(c, r); - DrawCellBorders(c, r, rect); + DrawCellBorders(c, r, rect, cell); end; end; end; @@ -1517,7 +1517,8 @@ end; @param ARow Row index @param ARect Rectangle in pixels occupied by the cell. -------------------------------------------------------------------------------} -procedure TsCustomWorksheetGrid.DrawCellBorders(ACol, ARow: Integer; ARect: TRect); +procedure TsCustomWorksheetGrid.DrawCellBorders(ACol, ARow: Integer; + ARect: TRect; ACell: PCell); const drawHor = 0; drawVert = 1; @@ -1635,26 +1636,24 @@ const var bs: TsCellBorderStyle; - cell: PCell; fmt: PsCellFormat; begin if Assigned(Worksheet) then begin // Left border - if GetBorderStyle(ACol, ARow, -1, 0, bs) then + if GetBorderStyle(ACol, ARow, -1, 0, ACell, bs) then DrawBorderLine(ARect.Left-1, ARect, drawVert, bs); // Right border - if GetBorderStyle(ACol, ARow, +1, 0, bs) then + if GetBorderStyle(ACol, ARow, +1, 0, ACell, bs) then DrawBorderLine(ARect.Right-1, ARect, drawVert, bs); // Top border - if GetBorderstyle(ACol, ARow, 0, -1, bs) then + if GetBorderstyle(ACol, ARow, 0, -1, ACell, bs) then DrawBorderLine(ARect.Top-1, ARect, drawHor, bs); // Bottom border - if GetBorderStyle(ACol, ARow, 0, +1, bs) then + if GetBorderStyle(ACol, ARow, 0, +1, ACell, bs) then DrawBorderLine(ARect.Bottom-1, ARect, drawHor, bs); - cell := Worksheet.FindCell(ARow-FHeaderCount, ACol-FHeaderCount); - if cell <> nil then begin - fmt := Workbook.GetPointerToCellFormat(cell^.FormatIndex); + if ACell <> nil then begin + fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex); // Diagonal up if cbDiagUp in fmt^.Border then begin bs := fmt^.Borderstyles[cbDiagUp]; @@ -2208,12 +2207,12 @@ end; Copies the borders of a cell to its neighbors. This avoids the nightmare of changing borders due to border conflicts of adjacent cells. - @param ACol Grid column index of the cell - @param ARow Grid row index of the cell + @param ACell Pointer to the cell -------------------------------------------------------------------------------} -procedure TsCustomWorksheetGrid.FixNeighborCellBorders(ACol, ARow: Integer); +procedure TsCustomWorksheetGrid.FixNeighborCellBorders(ACell: PCell); +//Col, ARow: Integer); - procedure SetNeighborBorder(NewRow, NewCol: Integer; + procedure SetNeighborBorder(NewRow, NewCol: Cardinal; ANewBorder: TsCellBorder; const ANewBorderStyle: TsCellBorderStyle; AInclude: Boolean); var @@ -2235,17 +2234,16 @@ procedure TsCustomWorksheetGrid.FixNeighborCellBorders(ACol, ARow: Integer); end; var - cell: PCell; fmt: PsCellFormat; begin if Worksheet = nil then exit; - cell := Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); - if (Worksheet <> nil) and (cell <> nil) then - with cell^ do +// cell := Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); + if (Worksheet <> nil) and (ACell <> nil) then + with ACell^ do begin - fmt := Workbook.GetPointerToCellFormat(cell^.FormatIndex); + fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex); SetNeighborBorder(Row, Col-1, cbEast, fmt^.BorderStyles[cbWest], cbWest in fmt^.Border); SetNeighborBorder(Row, Col+1, cbWest, fmt^.BorderStyles[cbEast], cbEast in fmt^.Border); SetNeighborBorder(Row-1, Col, cbSouth, fmt^.BorderStyles[cbNorth], cbNorth in fmt^.Border); @@ -2541,12 +2539,30 @@ end; -------------------------------------------------------------------------------} function TsCustomWorksheetGrid.GetCellFonts(ARect: TGridRect): TFont; var - c, r: Integer; +// c, r: Integer; + r1,c1,r2,c2: Cardinal; sFont, sDefFont: TsFont; cell: PCell; begin Result := GetCellFont(ARect.Left, ARect.Top); sDefFont := Workbook.GetDefaultFont; // Default font + r1 := GetWorksheetRow(ARect.Top); + c1 := GetWorksheetCol(ARect.Left); + r2 := GetWorksheetRow(ARect.Bottom); + c2 := GetWorksheetRow(ARect.Right); + for cell in Worksheet.Cells.GetRangeEnumerator(r1, c1, r2, c2) do + begin + sFont := Worksheet.ReadCellFont(cell); + if (sFont.FontName <> sDefFont.FontName) and (sFont.Size <> sDefFont.Size) + and (sFont.Style <> sDefFont.Style) and (sFont.Color <> sDefFont.Color) + then + begin + Convert_sFont_to_Font(sDefFont, FCellFont); + Result := FCellFont; + exit; + end; + end; + { for c := ARect.Left to ARect.Right do for r := ARect.Top to ARect.Bottom do begin @@ -2564,6 +2580,7 @@ begin end; end; end; + } end; {@@ ---------------------------------------------------------------------------- @@ -2798,11 +2815,12 @@ end; Result is FALSE if there is no border line. -------------------------------------------------------------------------------} function TsCustomWorksheetGrid.GetBorderStyle(ACol, ARow, ADeltaCol, ADeltaRow: Integer; - out ABorderStyle: TsCellBorderStyle): Boolean; + ACell: PCell; out ABorderStyle: TsCellBorderStyle): Boolean; var - cell, neighborcell: PCell; + //cell, + neighborcell: PCell; border, neighborborder: TsCellBorder; - r, c: Cardinal; +// r, c: Cardinal; begin Result := true; if (ADeltaCol = -1) and (ADeltaRow = 0) then @@ -2827,42 +2845,42 @@ begin end else raise Exception.Create('[TsCustomWorksheetGrid] Incorrect col/row for GetBorderStyle.'); - r := GetWorksheetRow(ARow); - c := GetWorksheetCol(ACol); - cell := Worksheet.FindCell(r, c); +// r := GetWorksheetRow(ARow); + // c := GetWorksheetCol(ACol); + //cell := Worksheet.FindCell(r, c); if (ARow - FHeaderCount + ADeltaRow < 0) or (ACol - FHeaderCount + ADeltaCol < 0) then neighborcell := nil else neighborcell := Worksheet.FindCell(ARow - FHeaderCount + ADeltaRow, ACol - FHeaderCount + ADeltaCol); // Only cell has border, but neighbor has not - if HasBorder(cell, border) and not HasBorder(neighborCell, neighborBorder) then + if HasBorder(ACell, border) and not HasBorder(neighborCell, neighborBorder) then begin - if Worksheet.InSameMergedRange(cell, neighborcell) then + if Worksheet.InSameMergedRange(ACell, neighborcell) then result := false else - ABorderStyle := Worksheet.ReadCellBorderStyle(cell, border) + ABorderStyle := Worksheet.ReadCellBorderStyle(ACell, border) end else // Only neighbor has border, cell has not - if not HasBorder(cell, border) and HasBorder(neighborCell, neighborBorder) then + if not HasBorder(ACell, border) and HasBorder(neighborCell, neighborBorder) then begin - if Worksheet.InSameMergedRange(cell, neighborcell) then + if Worksheet.InSameMergedRange(ACell, neighborcell) then result := false else ABorderStyle := Worksheet.ReadCellBorderStyle(neighborcell, neighborborder); end else // Both cells have shared border -> use top or left border - if HasBorder(cell, border) and HasBorder(neighborCell, neighborBorder) then + if HasBorder(ACell, border) and HasBorder(neighborCell, neighborBorder) then begin - if Worksheet.InSameMergedRange(cell, neighborcell) then + if Worksheet.InSameMergedRange(ACell, neighborcell) then result := false else if (border in [cbNorth, cbWest]) then ABorderStyle := Worksheet.ReadCellBorderStyle(neighborcell, neighborborder) else - ABorderStyle := Worksheet.ReadCellBorderStyle(cell, border); //cell^.BorderStyles[border]; + ABorderStyle := Worksheet.ReadCellBorderStyle(ACell, border); end else Result := false; end; @@ -4279,7 +4297,7 @@ begin try cell := Worksheet.GetCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); Worksheet.WriteBorders(cell, AValue); - FixNeighborCellBorders(ACol, ARow); + FixNeighborCellBorders(cell); finally EndUpdate; end; @@ -4311,7 +4329,7 @@ begin try cell := Worksheet.GetCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); Worksheet.WriteBorderStyle(cell, ABorder, AValue); - FixNeighborCellBorders(ACol, ARow); + FixNeighborCellBorders(cell); finally EndUpdate; end; diff --git a/components/fpspreadsheet/fpsreaderwriter.pas b/components/fpspreadsheet/fpsreaderwriter.pas index 360313b9e..6a25132c1 100644 --- a/components/fpspreadsheet/fpsreaderwriter.pas +++ b/components/fpspreadsheet/fpsreaderwriter.pas @@ -100,7 +100,7 @@ type procedure ListAllNumFormats; virtual; { Helpers for writing } - procedure WriteCellCallback(ACell: PCell; AStream: TStream); + procedure WriteCellToStream(AStream: TStream; ACell: PCell); procedure WriteCellsToStream(AStream: TStream; ACells: TsCells); { Record writing methods } @@ -124,12 +124,14 @@ type constructor Create(AWorkbook: TsWorkbook); override; destructor Destroy; override; { General writing methods } + { procedure IterateThroughCells(AStream: TStream; ACells: TsCells; ACallback: TCellsCallback); procedure IterateThroughComments(AStream: TStream; AComments: TsComments; ACallback: TCommentsCallback); procedure IterateThroughHyperlinks(AStream: TStream; AHyperlinks: TsHyperlinks; ACallback: THyperlinksCallback); + } procedure WriteToFile(const AFileName: string; const AOverwriteExisting: Boolean = False); override; procedure WriteToStream(AStream: TStream); override; @@ -460,7 +462,7 @@ begin if ALastRow >= Limitations.MaxRowCount then ALastRow := Limitations.MaxRowCount-1; end; - +(* {@@ ---------------------------------------------------------------------------- A generic method to iterate through all cells in a worksheet and call a callback routine for each cell. @@ -512,17 +514,10 @@ var comment: PsComment; begin index := 0; - AComments.PushCurrent; - try - comment := PsComment(AComments.GetFirst); - while Assigned(comment) do - begin - ACallback(comment, index, AStream); - comment := PsComment(AComments.GetNext); - inc(index); - end; - finally - AComments.PopCurrent; + for comment in AComments do + begin + ACallback(comment, index, AStream); + inc(index); end; end; @@ -552,7 +547,7 @@ begin AHyperlinks.PopCurrent; end; end; - + *) {@@ ---------------------------------------------------------------------------- Iterates through all cells and collects the number formats in FNumFormatList (without duplicates). @@ -577,12 +572,12 @@ end; stream. Calls the WriteNumber method of the worksheet for writing a number, the WriteDateTime method for writing a date/time etc. - @param ACell Pointer to the worksheet cell being written - @param AStream Stream to which data are written + @param ACell Pointer to the worksheet cell being written + @param AStream Stream to which data are written @see TsCustomSpreadWriter.WriteCellsToStream -------------------------------------------------------------------------------} -procedure TsCustomSpreadWriter.WriteCellCallback(ACell: PCell; AStream: TStream); +procedure TsCustomSpreadWriter.WriteCellToStream(AStream: TStream; ACell: PCell); begin if HasFormula(ACell) then WriteFormula(AStream, ACell^.Row, ACell^.Col, ACell) @@ -616,8 +611,12 @@ end; -------------------------------------------------------------------------------} procedure TsCustomSpreadWriter.WriteCellsToStream(AStream: TStream; ACells: TsCells); +var + cell: PCell; begin - IterateThroughCells(AStream, ACells, WriteCellCallback); + for cell in ACells do + WriteCellToStream(AStream, cell); +// IterateThroughCells(AStream, ACells, WriteCellCallback); end; {@@ ---------------------------------------------------------------------------- diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpi b/components/fpspreadsheet/tests/spreadtestgui.lpi index 30519e721..b55a3691e 100644 --- a/components/fpspreadsheet/tests/spreadtestgui.lpi +++ b/components/fpspreadsheet/tests/spreadtestgui.lpi @@ -48,6 +48,7 @@ + @@ -72,6 +73,7 @@ + diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas index 546c1214e..fd6dcc09e 100755 --- a/components/fpspreadsheet/xlsbiff8.pas +++ b/components/fpspreadsheet/xlsbiff8.pas @@ -120,10 +120,6 @@ type TsSpreadBIFF8Writer = class(TsSpreadBIFFWriter) private - procedure WriteCommentsEscherCallback(AComment: PsComment; - ACommentIndex: Integer; AStream: TStream); - procedure WriteCommentsNoteCallback(AComment: PsComment; - ACommentIndex: Integer; AStream: TStream); procedure WriteHyperlinksCallback(AHyperlink: PsHyperlink; AStream: TStream); protected @@ -132,6 +128,12 @@ type function WriteBoundsheet(AStream: TStream; ASheetName: string): Int64; procedure WriteComment(AStream: TStream; ACell: PCell); override; procedure WriteComments(AStream: TStream; AWorksheet: TsWorksheet); + { + procedure WriteCommentEscher(AStream: TStream; AComment: PsComment; + ACommentIndex: Integer); + procedure WriteCommentNote(AStream: TStream; AComment: PsComment; + ACommentIndex: Integer); + } procedure WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteEOF(AStream: TStream); procedure WriteFont(AStream: TStream; AFont: TsFont); @@ -1563,7 +1565,8 @@ procedure TsSpreadBIFF8Reader.ReadHyperlinkToolTip(AStream: TStream); var txt: String; widestr: widestring; - row, col, row1, col1, row2, col2: Word; + //row, col, + row1, col1, row2, col2: Word; hyperlink: PsHyperlink; numbytes: Integer; begin @@ -1584,6 +1587,10 @@ begin txt := UTF8Encode(wideStr); { Add tooltip to hyperlinks } + for hyperlink in FWorksheet.Hyperlinks.GetRangeEnumerator(row1, col1, row2, col2) do + hyperlink^.ToolTip := txt; + + { for row := row1 to row2 do for col := col1 to col2 do begin @@ -1591,6 +1598,7 @@ begin if hyperlink <> nil then hyperlink^.ToolTip := txt; end; + } end; @@ -1810,24 +1818,47 @@ end; -------------------------------------------------------------------------------} procedure TsSpreadBIFF8Writer.WriteComments(AStream: TStream; AWorksheet: TsWorksheet); +var + index: Integer; + comment: PsComment; 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)} - { At first we have to write all Escher-related records for all comments. } - IterateThroughComments(AStream, AWorksheet.Comments, WriteCommentsEscherCallback); - { The NOTE records for all comments follow subsequently. } - IterateThroughComments(AStream, AWorksheet.Comments, WriteCommentsNoteCallback); -end; + { At first we have to write all Escher-related records for all comments; + MSODRAWING - OBJ - MSODRAWING - TXO } + index := 1; + for comment in AWorksheet.Comments do + begin + if index = 1 then + WriteMSODrawing1(AStream, FWorksheet.Comments.Count, comment) + else + WriteMSODrawing2(AStream, comment, index); + WriteOBJ(AStream, index); + WriteMSODrawing3(AStream); + WriteTXO(AStream, comment); + inc(index); + end; +// IterateThroughComments(AStream, AWorksheet.Comments, WriteCommentsEscherCallback); + { The NOTE records for all comments follow subsequently. } + index := 1; + for comment in AWorksheet.Comments do + begin + WriteNOTE(AStream, comment, index); + inc(index); + end; +// IterateThroughComments(AStream, AWorksheet.Comments, WriteCommentsNoteCallback); +end; + (* {@@ ---------------------------------------------------------------------------- Helper method which writes all Escher-related records required for a cell comment: MSODRAWING - OBJ - MSODRAWING - TXT The NOTE records are written separately -------------------------------------------------------------------------------} -procedure TsSpreadBIFF8Writer.WriteCommentsEscherCallback(AComment: PsComment; - ACommentIndex: Integer; AStream: TStream); +procedure TsSpreadBIFF8Writer.WriteCommentsEscher(AStream: TStream; + AComment: PsComment; ACommentIndex: Integer); begin if ACommentIndex = 0 then WriteMSODrawing1(AStream, FWorksheet.Comments.Count, AComment) @@ -1843,12 +1874,12 @@ end; The Escher-related records required for each cell comment already have been written. -------------------------------------------------------------------------------} -procedure TsSpreadBIFF8Writer.WriteCommentsNoteCallback(AComment: PsComment; - ACommentIndex: Integer; AStream: TStream); +procedure TsSpreadBIFF8Writer.WriteCommentNote(AStream: TStream; + AComment: PsComment; ACommentIndex: Integer); begin WriteNOTE(AStream, AComment, ACommentIndex+1); end; - +*) {@@ ---------------------------------------------------------------------------- Writes an Excel 8 DIMENSIONS record @@ -2491,8 +2522,12 @@ end; -------------------------------------------------------------------------------} procedure TsSpreadBIFF8Writer.WriteHyperlinks(AStream: TStream; AWorksheet: TsWorksheet); +var + hyperlink: PsHyperlink; begin - IterateThroughHyperlinks(AStream, AWorksheet.Hyperlinks, WriteHyperlinksCallback); + for hyperlink in AWorksheet.Hyperlinks do + WriteHyperlink(AStream, hyperlink, AWorksheet); +// IterateThroughHyperlinks(AStream, AWorksheet.Hyperlinks, WriteHyperlinksCallback); end; {@@ ---------------------------------------------------------------------------- @@ -2613,11 +2648,37 @@ procedure TsSpreadBIFF8Writer.WriteMergedCells(AStream: TStream; const MAX_PER_RECORD = 1026; var - n0, n: Integer; + n0, n, i: Integer; rng: PsCellRange; + newRecord: Boolean; begin n0 := AWorksheet.MergedCells.Count; + n := Min(n0, MAX_PER_RECORD); + newRecord := true; + for rng in AWorksheet.MergedCells do + begin + if newRecord then + begin + newRecord := false; + { BIFF record header } + WriteBIFFHeader(AStream, INT_EXCEL_ID_MERGEDCELLS, 2 + n*8); + { Number of cell ranges in this record } + AStream.WriteWord(WordToLE(n)); + end; + { Write range data } + AStream.WriteWord(WordToLE(rng^.Row1)); + AStream.WriteWord(WordToLE(rng^.Row2)); + AStream.WriteWord(WordToLE(rng^.Col1)); + AStream.WriteWord(WordToLE(rng^.Col2)); + dec(n); + if n = 0 then begin + newRecord := true; + dec(n0, MAX_PER_RECORD); + n := Min(n0, MAX_PER_RECORD); + end; + end; + (* while n0 > 0 do begin n := Min(n0, MAX_PER_RECORD); // at most 1026 merged ranges per BIFF record, the rest goes into a new record @@ -2641,6 +2702,7 @@ begin dec(n0, MAX_PER_RECORD); end; + *) end; {@@----------------------------------------------------------------------------- diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas index 49aaecdb3..340dfbcda 100644 --- a/components/fpspreadsheet/xlscommon.pas +++ b/components/fpspreadsheet/xlscommon.pas @@ -335,14 +335,14 @@ type protected FDateMode: TDateMode; FCodePage: String; // in a format prepared for lconvencoding.ConvertEncoding - FLastRow: Cardinal; - FLastCol: Cardinal; +// FLastRow: Cardinal; +// FLastCol: Cardinal; procedure CreateNumFormatList; override; function FindXFIndex(ACell: PCell): Integer; virtual; function FixColor(AColor: TsColor): TsColor; override; - procedure GetLastRowCallback(ACell: PCell; AStream: TStream); +// procedure GetLastRowCallback(ACell: PCell; AStream: TStream); function GetLastRowIndex(AWorksheet: TsWorksheet): Integer; - procedure GetLastColCallback(ACell: PCell; AStream: TStream); +// procedure GetLastColCallback(ACell: PCell; AStream: TStream); function GetLastColIndex(AWorksheet: TsWorksheet): Word; // Helper function for writing the BIFF header @@ -1894,31 +1894,37 @@ begin end else Result := AColor; end; - + (* procedure TsSpreadBIFFWriter.GetLastRowCallback(ACell: PCell; AStream: TStream); begin Unused(AStream); if ACell^.Row > FLastRow then FLastRow := ACell^.Row; -end; +end; *) function TsSpreadBIFFWriter.GetLastRowIndex(AWorksheet: TsWorksheet): Integer; begin + Result := AWorksheet.GetLastRowIndex; + { FLastRow := 0; IterateThroughCells(nil, AWorksheet.Cells, @GetLastRowCallback); Result := FLastRow; + } end; - + (* procedure TsSpreadBIFFWriter.GetLastColCallback(ACell: PCell; AStream: TStream); begin Unused(AStream); if ACell^.Col > FLastCol then FLastCol := ACell^.Col; end; - + *) function TsSpreadBIFFWriter.GetLastColIndex(AWorksheet: TsWorksheet): Word; begin + Result := AWorksheet.GetLastColIndex; + { FLastCol := 0; IterateThroughCells(nil, AWorksheet.Cells, @GetLastColCallback); Result := FLastCol; + } end; {@@ ---------------------------------------------------------------------------- @@ -2925,9 +2931,9 @@ var begin for i := 0 to ASheet.Rows.Count-1 do begin row := ASheet.Rows[i]; - cell1 := ASheet.GetFirstCellOfRow(row^.Row); + cell1 := ASheet.Cells.GetFirstCellOfRow(row^.Row); if cell1 <> nil then begin - cell2 := ASheet.GetLastCellOfRow(row^.Row); + cell2 := ASheet.Cells.GetLastCellOfRow(row^.Row); WriteRow(AStream, ASheet, row^.Row, cell1^.Col, cell2^.Col, row); end else WriteRow(AStream, ASheet, row^.Row, 0, 0, row); @@ -3170,7 +3176,8 @@ begin lCell.BoolValue := value <> 0; end else lCell.ContentType := cctEmpty; - WriteCellCallback(@lCell, AStream); + WriteCellToStream(AStream, @lCell); +// WriteCellCallback(@lCell, AStream); value := varNULL; end; end; diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index 08bb8dde8..691a1b00f 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/components/fpspreadsheet/xlsxooxml.pas @@ -109,8 +109,10 @@ type TsSpreadOOXMLWriter = class(TsCustomSpreadWriter) private FNext_rId: Integer; + { procedure WriteCommentsCallback(AComment: PsComment; ACommentIndex: Integer; AStream: TStream); + } procedure WriteVmlDrawingsCallback(AComment: PsComment; ACommentIndex: Integer; AStream: TStream); @@ -2018,6 +2020,9 @@ begin end; procedure TsSpreadOOXMLWriter.WriteComments(AWorksheet: TsWorksheet); +var + comment: PsComment; + txt: String; begin if AWorksheet.Comments.Count = 0 then exit; @@ -2042,7 +2047,60 @@ begin ''); // Comments - IterateThroughComments(FSComments[FCurSheetNum], AWorksheet.Comments, WriteCommentsCallback); + //IterateThroughComments(FSComments[FCurSheetNum], AWorksheet.Comments, WriteCommentsCallback); + + for comment in AWorksheet.Comments do + begin + txt := comment^.Text; + ValidXMLText(txt); + + // Write comment text to Comments stream + AppendToStream(FSComments[FCurSheetNum], Format( + '', [GetCellString(comment^.Row, comment^.Col)]) + + ''+ + ''+ + ''+ // thie entire node could be omitted, but then Excel uses some ugly default font + ''+ + ''+ // Excel files have color index 81 here, but it could be that this does not exist in fps files --> use rgb instead + ''+ // It is not harmful to Excel if the font does not exist. + ''+ + ''+ + '' + txt + '' + + '' + + '' + + ''); + end; + + (* + procedure TsSpreadOOXMLWriter.WriteCommentsCallback(AComment: PsComment; + ACommentIndex: Integer; AStream: TStream); + var + comment: String; + begin + Unused(ACommentIndex); + + comment := AComment^.Text; + ValidXMLText(comment); + + // Write comment to Comments stream + AppendToStream(AStream, Format( + '', [GetCellString(AComment^.Row, AComment^.Col)])); + AppendToStream(AStream, + ''+ + ''+ + ''+ // this entire node could be omitted, but then Excel uses some default font out of control + ''+ + ''+ // It could be that color index 81 does not exist in fps files --> use rgb instead + ''+ // It is not harmful to Excel if the font does not exist. + ''+ + ''+ + '' + comment + '' + + ''+ + ''); + AppendToStream(AStream, + ''); + end; + *) // Footer AppendToStream(FSComments[FCurSheetNum], @@ -2050,7 +2108,7 @@ begin AppendToStream(FSComments[FCurSheetNum], ''); end; - + (* procedure TsSpreadOOXMLWriter.WriteCommentsCallback(AComment: PsComment; ACommentIndex: Integer; AStream: TStream); var @@ -2078,7 +2136,7 @@ begin ''); AppendToStream(AStream, ''); -end; +end; *) procedure TsSpreadOOXMLWriter.WriteDimension(AStream: TStream; AWorksheet: TsWorksheet); @@ -2240,13 +2298,9 @@ begin exit; AppendToStream(AStream, Format( '', [n]) ); - rng := PsCellRange(AWorksheet.MergedCells.GetFirst); - while Assigned(rng) do - begin + for rng in AWorksheet.MergedCells do AppendToStream(AStream, Format( '', [GetCellRangeString(rng.Row1, rng.Col1, rng.Row2, rng.Col2)])); - rng := PsCellRange(AWorksheet.MergedCells.GetNext); - end; AppendToStream(AStream, ''); end; @@ -2374,7 +2428,8 @@ begin lCell.ContentType := cctBool; lCell.BoolValue := value <> 0; end; - WriteCellCallback(@lCell, AStream); + WriteCellToStream(AStream, @lCell); +// WriteCellCallback(@lCell, AStream); varClear(value); end; AppendToStream(AStream, @@ -2394,12 +2449,16 @@ begin AppendToStream(AStream, Format( '', [r+1, c1+1, c2+1, rh])); // Write cells belonging to this row. + for cell in AWorksheet.Cells.GetRowEnumerator(r) do + WriteCellToStream(AStream, cell); + { for c := c1 to c2 do begin cell := AWorksheet.FindCell(r, c); if Assigned(cell) then begin WriteCellCallback(cell, AStream); end; end; + } AppendToStream(AStream, ''); end; @@ -2587,6 +2646,11 @@ begin end; procedure TsSpreadOOXMLWriter.WriteVmlDrawings(AWorksheet: TsWorksheet); +// My xml viewer does not format vml files property --> format in code. +var + comment: PsComment; + index: Integer; + id: Integer; begin if AWorksheet.Comments.Count = 0 then exit; @@ -2597,8 +2661,6 @@ begin else FSVmlDrawings[FCurSheetNum] := TMemoryStream.Create; -// FDrawingCounter := 0; - // Header AppendToStream(FSVmlDrawings[FCurSheetNum], '' + LineEnding); // Write vmlDrawings for each comment (formatting and position of comment box) - IterateThroughComments(FSVmlDrawings[FCurSheetNum], AWorksheet.Comments, WriteVmlDrawingsCallback); + index := 1; + for comment in AWorksheet.Comments do + begin + id := 1024 + index; // if more than 1024 comments then use data="1,2,etc" above! -- not implemented yet + AppendToStream(FSVmlDrawings[FCurSheetNum], LineEnding + Format( + ' ' + LineEnding); + end; + + //IterateThroughComments(FSVmlDrawings[FCurSheetNum], AWorksheet.Comments, WriteVmlDrawingsCallback); // Footer AppendToStream(FSVmlDrawings[FCurSheetNum],