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

Applied patch from Torsten Bonde Christiansen ( http://bugs.freepascal.org/view.php?id=14480 ) with some minor changes. Big speedup reading spreadsheets.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@952 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
Joshy
2009-09-02 22:03:01 +00:00
parent 312e8f16fc
commit c9cad114e8
5 changed files with 72 additions and 93 deletions
Download Patch File Download Diff File Expand all files Collapse all files

35
components/fpspreadsheet/fpsopendocument.pas
View File

@ -30,7 +30,7 @@ uses
Classes, SysUtils,
fpszipper, {NOTE: fpszipper is the latest zipper.pp Change to standard zipper when FPC 2.4 is released. Changed by JLJR}
fpspreadsheet,
xmlread, DOM;
xmlread, DOM, AVL_Tree;
type
@ -404,6 +404,8 @@ var
CurCell: PCell;
CurRow: array of PCell;
LastColNum: Cardinal;
ACell: PCell;
AVLNode: TAVLTreeNode;
begin
LastColNum := CurSheet.GetLastColNumber;
@ -413,41 +415,30 @@ begin
' <table:table-column table:style-name="co1" table:number-columns-repeated="' +
IntToStr(LastColNum + 1) + '" table:default-cell-style-name="Default"/>' + LineEnding;
ACell := GetMem(SizeOf(TCell));
// The cells need to be written in order, row by row, cell by cell
for j := 0 to CurSheet.GetLastRowNumber do
begin
FContent := FContent +
' <table:table-row table:style-name="ro1">' + LineEnding;
// First make an array with the cells of this row in their respective order
// nil pointers indicate empty cells, so it's necessary to initialize the array
SetLength(CurRow, LastColNum + 1);
for k := 0 to LastColNum do CurRow[k] := nil;
// Now fill the array with the cells in their proper place
for k := 0 to CurSheet.FCells.Count - 1 do
begin
CurCell := CurSheet.FCells.Items[k];
if CurCell^.Row = j then CurRow[CurCell^.Col] := CurCell;
end;
// And now write all cells from this row
// Write cells from this row.
for k := 0 to LastColNum do
begin
CurCell := CurRow[k];
if CurCell = nil then
FContent := FContent + '<table:table-cell/>' + LineEnding
else WriteCellCallback(CurCell, nil);
ACell^.Row := j;
ACell^.Col := k;
AVLNode := CurSheet.Cells.Find(ACell);
if Assigned(AVLNode) then
WriteCellCallback(PCell(AVLNode.Data), nil)
else
FContent := FContent + '<table:table-cell/>' + LineEnding;
end;
FContent := FContent +
' </table:table-row>' + LineEnding;
end;
// Clean up
SetLength(CurRow, 0);
// Footer
FContent := FContent +
' </table:table>' + LineEnding;

124
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -14,7 +14,7 @@ unit fpspreadsheet;
interface
uses
Classes, SysUtils;
Classes, SysUtils, AVL_Tree;
type
TsSpreadsheetFormat = (sfExcel2, sfExcel3, sfExcel4, sfExcel5, sfExcel8,
@ -98,9 +98,9 @@ type
TsWorksheet = class
private
FCells: TAvlTree;
procedure RemoveCallback(data, arg: pointer);
public
FCells: TFPList;
Name: string;
{ Base methods }
constructor Create;
@ -109,7 +109,6 @@ type
function FindCell(ARow, ACol: Cardinal): PCell;
function GetCell(ARow, ACol: Cardinal): PCell;
function GetCellCount: Cardinal;
function GetCellByIndex(AIndex: Cardinal): PCell;
function GetLastColNumber: Cardinal;
function GetLastRowNumber: Cardinal;
function ReadAsUTF8Text(ARow, ACol: Cardinal): ansistring;
@ -118,6 +117,7 @@ type
procedure WriteNumber(ARow, ACol: Cardinal; ANumber: double);
procedure WriteFormula(ARow, ACol: Cardinal; AFormula: TsFormula);
procedure WriteRPNFormula(ARow, ACol: Cardinal; AFormula: TsRPNFormula);
property Cells: TAVLTree read FCells;
end;
{ TsWorkbook }
@ -178,7 +178,7 @@ type
function ExpandFormula(AFormula: TsFormula): TsExpandedFormula;
{ General writing methods }
procedure WriteCellCallback(data, arg: pointer);
procedure WriteCellsToStream(AStream: TStream; ACells: TFPList);
procedure WriteCellsToStream(AStream: TStream; ACells: TAVLTree);
procedure WriteToFile(AFileName: string; AData: TsWorkbook); virtual;
procedure WriteToStream(AStream: TStream; AData: TsWorkbook); virtual;
{ Record writing methods }
@ -206,6 +206,9 @@ procedure RegisterSpreadFormat(
implementation
uses
Math;
var
{ Translatable strings }
lpUnsupportedReadFormat, lpUnsupportedWriteFormat: string;
@ -241,6 +244,13 @@ begin
FreeMem(data);
end;
function CompareCells(Item1, Item2: Pointer): Integer;
begin
result := PCell(Item1).Row - PCell(Item2).Row;
if Result = 0 then
Result := PCell(Item1).Col - PCell(Item2).Col;
end;
{@@
Constructor.
}
@ -248,7 +258,7 @@ constructor TsWorksheet.Create;
begin
inherited Create;
FCells := TFPList.Create;
FCells := TAVLTree.Create(@CompareCells);
end;
{@@
@ -277,24 +287,16 @@ end;
}
function TsWorksheet.FindCell(ARow, ACol: Cardinal): PCell;
var
i: Integer;
ACell: PCell;
LCell: TCell;
AVLNode: TAVLTreeNode;
begin
i := 0;
Result := nil;
while (i < FCells.Count) do
begin
ACell := PCell(FCells.Items[i]);
if (ACell^.Row = ARow) and (ACell^.Col = ACol) then
begin
Result := ACell;
Exit;
end;
Inc(i);
end;
LCell.Row := ARow;
LCell.Col := ACol;
AVLNode := Cells.Find(@LCell);
if Assigned(AVLNode) then
result := PCell(AVLNode.Data);
end;
{@@
@ -326,7 +328,7 @@ begin
Result^.Row := ARow;
Result^.Col := ACol;
FCells.Add(Result);
Cells.Add(Result);
end;
end;
@ -343,28 +345,7 @@ end;
}
function TsWorksheet.GetCellCount: Cardinal;
begin
Result := FCells.Count;
end;
{@@
Obtains the cell with a specific index in the internal list of cells.
The index goes from 0 to GetCellCount - 1.
This routine is used together with GetCellCount to
iterate througth all cells in a worksheet efficiently.
@param AIndex The index of the cell to be obtained
@return A pointer to the cell, or nil if it doesn't exist
@see TCell
@see GetCellCount
}
function TsWorksheet.GetCellByIndex(AIndex: Cardinal): PCell;
begin
if FCells.Count > AIndex then Result := PCell(FCells.Items[AIndex])
else Result := nil;
Result := Cells.Count;
end;
{@@
@ -379,19 +360,18 @@ end;
}
function TsWorksheet.GetLastColNumber: Cardinal;
var
i: Integer;
ACell: PCell;
AVLNode: TAVLTreeNode;
begin
i := 0;
Result := 0;
while (i < FCells.Count) do
// Traverse the tree from lowest to highest.
// Since tree primary sort order is on Row
// highest Col could exist anywhere.
AVLNode := Cells.FindLowest;
While Assigned(AVLNode) do
begin
ACell := PCell(FCells.Items[i]);
if ACell^.Col > Result then Result := ACell^.Col;
Inc(i);
Result := Math.Max(Result, PCell(AVLNode.Data)^.Col);
AVLNode := Cells.FindSuccessor(AVLNode);
end;
end;
@ -407,20 +387,13 @@ end;
}
function TsWorksheet.GetLastRowNumber: Cardinal;
var
i: Integer;
ACell: PCell;
AVLNode: TAVLTreeNode;
begin
i := 0;
Result := 0;
while (i < FCells.Count) do
begin
ACell := PCell(FCells.Items[i]);
if ACell^.Row > Result then Result := ACell^.Row;
Inc(i);
end;
AVLNode := FCells.FindHighest;
if Assigned(AVLNode) then
Result := PCell(AVLNode.Data).Row;
end;
{@@
@ -460,8 +433,16 @@ end;
Clears the list of Cells and releases their memory.
}
procedure TsWorksheet.RemoveAllCells;
var
Node: TAVLTreeNode;
begin
FCells.ForEachCall(RemoveCallback, nil);
Node:=FCells.FindLowest;
while Assigned(Node) do begin
RemoveCallback(Node.Data,nil);
Node.Data:=nil;
Node:=FCells.FindSuccessor(Node);
end;
FCells.Clear;
end;
{@@
@ -725,7 +706,7 @@ end;
}
function TsWorkbook.GetWorksheetByIndex(AIndex: Cardinal): TsWorksheet;
begin
if AIndex < FWorksheets.Count then Result := TsWorksheet(FWorksheets.Items[AIndex])
if (integer(AIndex) < FWorksheets.Count) and (integer(AIndex)>=0) then Result := TsWorksheet(FWorksheets.Items[AIndex])
else Result := nil;
end;
@ -854,9 +835,16 @@ end;
@param AStream The output stream.
@param ACells List of cells to be writeen
}
procedure TsCustomSpreadWriter.WriteCellsToStream(AStream: TStream; ACells: TFPList);
procedure TsCustomSpreadWriter.WriteCellsToStream(AStream: TStream; ACells: TAVLTree);
var
AVLNode: TAVLTreeNode;
begin
ACells.ForEachCall(WriteCellCallback, Pointer(AStream));
AVLNode := ACells.FindLowest;
While Assigned(AVLNode) do
begin
WriteCellCallback(AVLNode.Data, Pointer(AStream));
AVLNode := ACells.FindSuccessor(AVLNode);
end;
end;
{@@

2
components/fpspreadsheet/xlsbiff2.pas
View File

@ -130,7 +130,7 @@ procedure TsSpreadBIFF2Writer.WriteToStream(AStream: TStream; AData: TsWorkbook)
begin
WriteBOF(AStream);
WriteCellsToStream(AStream, AData.GetFirstWorksheet.FCells);
WriteCellsToStream(AStream, AData.GetFirstWorksheet.Cells);
WriteEOF(AStream);
end;

2
components/fpspreadsheet/xlsbiff5.pas
View File

@ -403,7 +403,7 @@ begin
WriteWindow2(AStream, True);
WriteCellsToStream(AStream, AData.GetWorksheetByIndex(i).FCells);
WriteCellsToStream(AStream, AData.GetWorksheetByIndex(i).Cells);
WriteEOF(AStream);
end;

2
components/fpspreadsheet/xlsbiff8.pas
View File

@ -370,7 +370,7 @@ begin
WriteWindow2(AStream, True);
WriteCellsToStream(AStream, AData.GetWorksheetByIndex(i).FCells);
WriteCellsToStream(AStream, AData.GetWorksheetByIndex(i).Cells);
WriteEOF(AStream);
end;