paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fpspreadsheet: Replace for-to loops by for-in loops if possible. Update example demos.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3991 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2015-03-05 10:35:32 +00:00
parent 75b09e07c3
commit c5f6cbe82d
19 changed files with 582 additions and 491 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
components/fpspreadsheet/examples/csvdemo/csvread.lpr
View File

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

9
components/fpspreadsheet/examples/excel2demo/excel2read.lpr
View File

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

8
components/fpspreadsheet/examples/excel5demo/excel5read.lpr
View File

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

8
components/fpspreadsheet/examples/excel8demo/excel8read.lpr
View File

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

1
components/fpspreadsheet/examples/fpsctrls/demo_ctrls.lpi
View File

@ -69,7 +69,6 @@
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="main"/>
</Unit1>
</Units>
</ProjectOptions>

2
components/fpspreadsheet/examples/fpsgrid_no_install/fpsgrid.lpr
View File

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

14
components/fpspreadsheet/examples/ooxmldemo/ooxmlread.lpr
View File

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

14
components/fpspreadsheet/examples/opendocdemo/opendocread.lpr
View File

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

13
components/fpspreadsheet/examples/wikitabledemo/wikitableread.lpr
View File

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

354
components/fpspreadsheet/fpsclasses.pas
View File

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

9
components/fpspreadsheet/fpscsv.pas
View File

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

10
components/fpspreadsheet/fpsopendocument.pas
View File

@ -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(
'<table:table-cell %s/>', [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;

245
components/fpspreadsheet/fpspreadsheet.pas
View File

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

96
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

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

35
components/fpspreadsheet/fpsreaderwriter.pas
View File

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

2
components/fpspreadsheet/tests/spreadtestgui.lpi
View File

@ -48,6 +48,7 @@
<Unit1>
<Filename Value="datetests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="datetests"/>
</Unit1>
<Unit2>
<Filename Value="stringtests.pas"/>
@ -72,6 +73,7 @@
<Unit7>
<Filename Value="formattests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="formattests"/>
</Unit7>
<Unit8>
<Filename Value="colortests.pas"/>

96
components/fpspreadsheet/xlsbiff8.pas
View File

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

29
components/fpspreadsheet/xlscommon.pas
View File

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

117
components/fpspreadsheet/xlsxooxml.pas
View File

@ -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
'<commentList>');
// 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(
'<comment ref="%s" authorId="0">', [GetCellString(comment^.Row, comment^.Col)]) +
'<text>'+
'<r>'+
'<rPr>'+ // thie entire node could be omitted, but then Excel uses some ugly default font
'<sz val="9"/>'+
'<color rgb="000000" />'+ // Excel files have color index 81 here, but it could be that this does not exist in fps files --> use rgb instead
'<fFont vel="Arial" />'+ // It is not harmful to Excel if the font does not exist.
'<charset val="1" />'+
'</rPr>'+
'<t xml:space="preserve">' + txt + '</t>' +
'</r>' +
'</text>' +
'</comment>');
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(
'<comment ref="%s" authorId="0">', [GetCellString(AComment^.Row, AComment^.Col)]));
AppendToStream(AStream,
'<text>'+
'<r>'+
'<rPr>'+ // this entire node could be omitted, but then Excel uses some default font out of control
'<sz val="9"/>'+
'<color rgb="000000" />'+ // It could be that color index 81 does not exist in fps files --> use rgb instead
'<rFont val="Arial"/>'+ // It is not harmful to Excel if the font does not exist.
'<charset val="1"/>'+
'</rPr>'+
'<t xml:space="preserve">' + comment + '</t>' +
'</r>'+
'</text>');
AppendToStream(AStream,
'</comment>');
end;
*)
// Footer
AppendToStream(FSComments[FCurSheetNum],
@ -2050,7 +2108,7 @@ begin
AppendToStream(FSComments[FCurSheetNum],
'</comments>');
end;
(*
procedure TsSpreadOOXMLWriter.WriteCommentsCallback(AComment: PsComment;
ACommentIndex: Integer; AStream: TStream);
var
@ -2078,7 +2136,7 @@ begin
'</text>');
AppendToStream(AStream,
'</comment>');
end;
end; *)
procedure TsSpreadOOXMLWriter.WriteDimension(AStream: TStream;
AWorksheet: TsWorksheet);
@ -2240,13 +2298,9 @@ begin
exit;
AppendToStream(AStream, Format(
'<mergeCells count="%d">', [n]) );
rng := PsCellRange(AWorksheet.MergedCells.GetFirst);
while Assigned(rng) do
begin
for rng in AWorksheet.MergedCells do
AppendToStream(AStream, Format(
'<mergeCell ref="%s" />', [GetCellRangeString(rng.Row1, rng.Col1, rng.Row2, rng.Col2)]));
rng := PsCellRange(AWorksheet.MergedCells.GetNext);
end;
AppendToStream(AStream,
'</mergeCells>');
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(
'<row r="%d" spans="%d:%d"%s>', [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,
'</row>');
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],
'<xml xmlns:v="urn:schemas-microsoft-com:vml" '+
@ -2617,7 +2679,38 @@ begin
' </v:shapetype>' + 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(
' <v:shape id="_x0000_s%d" type="#_x0000_t202" ', [id]) + LineEnding + Format(
' style="position:absolute; width:108pt; height:52.5pt; z-index:%d; visibility:hidden" ', [index]) + LineEnding +
// it is not necessary to specify margin-left and margin-top here!
// 'style=''position:absolute; margin-left:71.25pt; margin-top:1.5pt; ' + Format(
// 'width:108pt; height:52.5pt; z-index:%d; visibility:hidden'' ', [FDrawingCounter+1]) +
// 'width:108pt; height:52.5pt; z-index:1; visibility:hidden'' ' +
' fillcolor="#ffffe1" o:insetmode="auto"> '+ LineEnding +
' <v:fill color2="#ffffe1" />'+LineEnding+
' <v:shadow on="t" color="black" obscured="t" />'+LineEnding+
' <v:path o:connecttype="none" />'+LineEnding+
' <v:textbox style="mso-direction-alt:auto">'+LineEnding+
' <div style="text-align:left"></div>'+LineEnding+
' </v:textbox>' + LineEnding +
' <x:ClientData ObjectType="Note">'+LineEnding+
' <x:MoveWithCells />'+LineEnding+
' <x:SizeWithCells />'+LineEnding+
' <x:Anchor> 1, 15, 0, 2, 2, 79, 4, 4</x:Anchor>'+LineEnding+
' <x:AutoFill>False</x:AutoFill>'+LineEnding + Format(
' <x:Row>%d</x:Row>', [comment^.Row]) + LineEnding + Format(
' <x:Column>%d</x:Column>', [comment^.Col]) + LineEnding +
' </x:ClientData>'+ LineEnding+
' </v:shape>' + LineEnding);
end;
//IterateThroughComments(FSVmlDrawings[FCurSheetNum], AWorksheet.Comments, WriteVmlDrawingsCallback);
// Footer
AppendToStream(FSVmlDrawings[FCurSheetNum],