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

fpspreadsheet: Implement virtual reading mode for biff2 and ods.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3373 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-07-24 15:56:03 +00:00
parent 5a65855a48
commit 340efa7c8f
8 changed files with 182 additions and 72 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
components/fpspreadsheet/examples/fpsspeedtest/fpsspeedtest.lpi
View File

@ -70,9 +70,6 @@
</Win32>
</Options>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="2">

2
components/fpspreadsheet/examples/fpsspeedtest/mainform.lfm
View File

@ -10,7 +10,7 @@ object Form1: TForm1
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
OnKeyPress = FormKeyPress
LCLVersion = '1.2.4.0'
LCLVersion = '1.3'
object StatusBar: TStatusBar
Left = 0
Height = 23

19
components/fpspreadsheet/examples/fpsspeedtest/mainform.pas
View File

@ -92,7 +92,9 @@ const
procedure TForm1.ReadCellDataHandler(Sender: TObject; ARow, ACol: Cardinal;
const ADataCell: PCell);
begin
// nothing to do here.
// nothing to do here. Just do a progress display
if ARow mod 1000 = 0 then
StatusMsg(Format('Virtual mode reading %s: Row %d...', [GetFileFormatName(FCurFormat), ARow]));
end;
procedure TForm1.WriteCellStringHandler(Sender: TObject; ARow, ACol: cardinal;
@ -103,7 +105,7 @@ begin
S := 'Xy' + IntToStr(ARow) + 'x' + IntToStr(ACol);
AValue := S;
if ARow mod 1000 = 0 then
StatusMsg(Format('Writing %s row %d...', [GetFileFormatName(FCurFormat), ARow]));
StatusMsg(Format('Virtual mode writing %s: Row %d...', [GetFileFormatName(FCurFormat), ARow]));
end;
procedure TForm1.WriteCellNumberHandler(Sender: TObject; ARow, ACol: cardinal;
@ -111,7 +113,7 @@ procedure TForm1.WriteCellNumberHandler(Sender: TObject; ARow, ACol: cardinal;
begin
AValue := ARow * 1E5 + ACol;
if ARow mod 1000 = 0 then
StatusMsg(Format('Writing %s row %d...', [GetFileFormatName(FCurFormat), ARow]));
StatusMsg(Format('Virtual mode writing %s: Row %d...', [GetFileFormatName(FCurFormat), ARow]));
end;
procedure TForm1.WriteCellStringAndNumberHandler(Sender: TObject; ARow, ACol: cardinal;
@ -137,6 +139,11 @@ begin
s := Trim(Log);
Log := Log + ' ';
try
if FEscape then begin
Log := 'Test aborted';
exit;
end;
for i := 0 to CgFormats.Items.Count-1 do begin
if FEscape then begin
Log := 'Test aborted';
@ -153,9 +160,15 @@ begin
end;
FCurFormat := SPREAD_FORMAT[i];
StatusMsg('Reading ' + GetFileFormatName(FCurFormat));
ok := false;
for j:=1 to 4 do begin
if FEscape then begin
Log := 'Test aborted';
exit;
end;
fName := FDir + CONTENT_PREFIX[RgContent.ItemIndex] + Copy(s, 1, Pos(' ', s)-1) + '_' + IntToStr(j) + FORMAT_EXT[i];
if not FileExists(fname) then
continue;

4
components/fpspreadsheet/examples/other/demo_virtualmode_write.lpr
View File

@ -98,9 +98,9 @@ begin
t := Now;
//workbook.WriteToFile('test_virtual.xlsx', sfOOXML, true);
workbook.WriteToFile('test_virtual.xls', sfExcel8, true);
//workbook.WriteToFile('test_virtual.xls', sfExcel8, true);
//workbook.WriteToFile('test_virtual.xls', sfExcel5, true);
//workbook.WriteToFile('test_virtual.xls', sfExcel2, true);
workbook.WriteToFile('test_virtual.xls', sfExcel2, true);
t := Now - t;
finally

76
components/fpspreadsheet/fpsopendocument.pas
View File

@ -1001,11 +1001,17 @@ end;
procedure TsSpreadOpenDocReader.ReadBlank(ARow, ACol: Word; ACellNode: TDOMNode);
var
styleName: String;
cell: PCell;
begin
FWorkSheet.WriteBlank(ARow, ACol);
if FIsVirtualMode then begin
InitCell(ARow, ACol, FVirtualCell);
cell := @FVirtualCell;
end else
cell := FWorksheet.GetCell(ARow, ACol);
FWorkSheet.WriteBlank(cell);
styleName := GetAttrValue(ACellNode, 'table:style-name');
ApplyStyleToCell(ARow, ACol, stylename);
ApplyStyleToCell(cell, stylename);
end;
{ Collection columns used in the given table. The columns contain links to
@ -1321,9 +1327,14 @@ begin
fs.DecimalSeparator := '.';
// Create cell and apply format
if FIsVirtualMode then begin
InitCell(ARow, ACol, FVirtualCell);
cell := @FVirtualCell;
end else
cell := FWorksheet.GetCell(ARow, ACol);
styleName := GetAttrValue(ACellNode, 'table:style-name');
ApplyStyleToCell(ARow, ACol, stylename);
cell := FWorksheet.FindCell(ARow, ACol);
ApplyStyleToCell(cell, stylename);
// Read formula, store in the cell's FormulaValue.FormulaStr
formula := GetAttrValue(ACellNode, 'table:formula');
@ -1369,6 +1380,9 @@ begin
end else
// Text
FWorksheet.WriteUTF8Text(cell, valueStr);
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
procedure TsSpreadOpenDocReader.ReadLabel(ARow: Word; ACol: Word; ACellNode: TDOMNode);
@ -1376,6 +1390,7 @@ var
cellText: String;
styleName: String;
childnode: TDOMNode;
cell: PCell;
begin
// cellText := ACellNode.TextContent;
{ We were forced to activate PreserveWhiteSpace in the DOMParser in order to
@ -1393,10 +1408,18 @@ begin
childnode := childnode.NextSibling;
end;
FWorkSheet.WriteUTF8Text(ARow, ACol, cellText);
if FIsVirtualMode then begin
InitCell(ARow, ACol, FVirtualCell);
cell := @FVirtualCell;
end else
cell := FWorksheet.GetCell(ARow, ACol);
FWorkSheet.WriteUTF8Text(cell, cellText);
styleName := GetAttrValue(ACellNode, 'table:style-name');
ApplyStyleToCell(ARow, ACol, stylename);
ApplyStyleToCell(cell, stylename);
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
procedure TsSpreadOpenDocReader.ReadNumber(ARow: Word; ACol : Word; ACellNode : TDOMNode);
@ -1405,42 +1428,50 @@ var
Value, Str: String;
lNumber: Double;
styleName: String;
lCell: PCell;
cell: PCell;
begin
FSettings := DefaultFormatSettings;
FSettings.DecimalSeparator:='.';
if FIsVirtualMode then begin
InitCell(ARow, ACol, FVirtualCell);
cell := @FVirtualCell;
end else
cell := FWorksheet.GetCell(ARow, ACol);
Value := GetAttrValue(ACellNode,'office:value');
if UpperCase(Value)='1.#INF' then
FWorkSheet.WriteNumber(Arow,ACol,1.0/0.0)
FWorkSheet.WriteNumber(cell, 1.0/0.0)
else
begin
// Don't merge, or else we can't debug
Str := GetAttrValue(ACellNode,'office:value');
lNumber := StrToFloat(Str,FSettings);
FWorkSheet.WriteNumber(ARow,ACol,lNumber);
FWorkSheet.WriteNumber(cell, lNumber);
end;
styleName := GetAttrValue(ACellNode, 'table:style-name');
ApplyStyleToCell(ARow, ACol, stylename);
ApplyStyleToCell(cell, stylename);
// Sometimes date/time cells are stored as "float".
// We convert them to date/time and also correct the date origin offset if
// needed.
lCell := FWorksheet.FindCell(ARow, ACol);
if IsDateTimeFormat(lCell^.NumberFormat) or IsDateTimeFormat(lCell^.NumberFormatStr)
if IsDateTimeFormat(cell^.NumberFormat) or IsDateTimeFormat(cell^.NumberFormatStr)
then begin
lCell^.ContentType := cctDateTime;
cell^.ContentType := cctDateTime;
// No datemode correction for intervals and for time-only values
if (lCell^.NumberFormat = nfTimeInterval) or (lCell^.NumberValue < 1) then
lCell^.DateTimeValue := lCell^.NumberValue
if (cell^.NumberFormat = nfTimeInterval) or (cell^.NumberValue < 1) then
cell^.DateTimeValue := cell^.NumberValue
else
case FDateMode of
dm1899: lCell^.DateTimeValue := lCell^.NumberValue + DATEMODE_1899_BASE;
dm1900: lCell^.DateTimeValue := lCell^.NumberValue + DATEMODE_1900_BASE;
dm1904: lCell^.DateTimeValue := lCell^.NumberValue + DATEMODE_1904_BASE;
dm1899: cell^.DateTimeValue := cell^.NumberValue + DATEMODE_1899_BASE;
dm1900: cell^.DateTimeValue := cell^.NumberValue + DATEMODE_1900_BASE;
dm1904: cell^.DateTimeValue := cell^.NumberValue + DATEMODE_1904_BASE;
end;
end;
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
procedure TsSpreadOpenDocReader.ReadDateTime(ARow: Word; ACol: Word;
@ -1450,13 +1481,20 @@ var
styleName: String;
cell: PCell;
begin
cell := FWorksheet.GetCell(ARow, ACol);
if FIsVirtualMode then begin
InitCell(ARow, ACol, FVirtualCell);
cell := @FVirtualCell;
end else
cell := FWorksheet.GetCell(ARow, ACol);
styleName := GetAttrValue(ACellNode, 'table:style-name');
ApplyStyleToCell(cell, stylename);
dt := ExtractDateTimeFromNode(ACellNode, cell^.NumberFormat, cell^.NumberFormatStr);
FWorkSheet.WriteDateTime(cell, dt, cell^.NumberFormat, cell^.NumberFormatStr);
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
procedure TsSpreadOpenDocReader.ReadNumFormats(AStylesNode: TDOMNode);

4
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -2847,8 +2847,8 @@ begin
end;
end else
if FWorksheet <> nil then begin
ColCount := FWorksheet.GetLastColIndex + 1 + FHeaderCount;
RowCount := FWorksheet.GetLastRowIndex + 1 + FHeaderCount;
ColCount := Max(FWorksheet.GetLastColIndex + 1 + FHeaderCount, FInitColCount);
RowCount := Max(FWorksheet.GetLastRowIndex + 1 + FHeaderCount, FInitRowCount);
FixedCols := FFrozenCols + FHeaderCount;
FixedRows := FFrozenRows + FHeaderCount;
if ShowHeaders then begin

144
components/fpspreadsheet/xlsbiff2.pas
View File

@ -57,7 +57,7 @@ type
FWorksheet: TsWorksheet;
FFont: TsFont;
protected
procedure ApplyCellFormatting(ARow, ACol: Cardinal; XFIndex: Word); override;
procedure ApplyCellFormatting(ACell: PCell; XFIndex: Word); override;
procedure CreateNumFormatList; override;
procedure ExtractNumberFormat(AXFIndex: WORD;
out ANumberFormat: TsNumberFormat; out ANumberFormatStr: String); override;
@ -110,8 +110,10 @@ type
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal; ACell: PCell); override;
procedure WriteFormat(AStream: TStream; AFormatData: TsNumFormatData;
AListIndex: Integer); override;
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; const AValue: string; ACell: PCell); override;
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double; ACell: PCell); override;
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: string; ACell: PCell); override;
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: double; ACell: PCell); override;
procedure WriteRow(AStream: TStream; ASheet: TsWorksheet;
ARowIndex, AFirstColIndex, ALastColIndex: Cardinal; ARow: PRow); override;
procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal;
@ -190,6 +192,17 @@ type
Value: Double;
end;
TBIFF2IntegerRecord = packed record
RecordID: Word;
RecordSize: Word;
Row: Word;
Col: Word;
Attrib1: Byte;
Attrib2: Byte;
Attrib3: Byte;
Value: Word;
end;
{ TsBIFF2NumFormatList }
@ -297,45 +310,41 @@ end;
{ TsSpreadBIFF2Reader }
procedure TsSpreadBIFF2Reader.ApplyCellFormatting(ARow, ACol: Cardinal;
XFIndex: Word);
procedure TsSpreadBIFF2Reader.ApplyCellFormatting(ACell: PCell; XFIndex: Word);
var
lCell: PCell;
xfData: TXFListData;
begin
lCell := FWorksheet.GetCell(ARow, ACol);
if Assigned(lCell) then begin
if Assigned(ACell) then begin
xfData := TXFListData(FXFList.items[XFIndex]);
// Font index, "bold" attribute
if xfData.FontIndex = 1 then
Include(lCell^.UsedFormattingFields, uffBold)
Include(ACell^.UsedFormattingFields, uffBold)
else
Include(lCell^.UsedFormattingFields, uffFont);
lCell^.FontIndex := xfData.FontIndex;
Include(ACell^.UsedFormattingFields, uffFont);
ACell^.FontIndex := xfData.FontIndex;
// Alignment
lCell^.HorAlignment := xfData.HorAlignment;
lCell^.VertAlignment := xfData.VertAlignment;
ACell^.HorAlignment := xfData.HorAlignment;
ACell^.VertAlignment := xfData.VertAlignment;
// Wordwrap not supported by BIFF2
Exclude(lCell^.UsedFormattingFields, uffWordwrap);
Exclude(ACell^.UsedFormattingFields, uffWordwrap);
// Text rotation not supported by BIFF2
Exclude(lCell^.UsedFormattingFields, uffTextRotation);
Exclude(ACell^.UsedFormattingFields, uffTextRotation);
// Border
if xfData.Borders <> [] then begin
Include(lCell^.UsedFormattingFields, uffBorder);
lCell^.Border := xfData.Borders;
Include(ACell^.UsedFormattingFields, uffBorder);
ACell^.Border := xfData.Borders;
end else
Exclude(lCell^.UsedFormattingFields, uffBorder);
Exclude(ACell^.UsedFormattingFields, uffBorder);
// Background, only shaded, color is ignored
if xfData.BackgroundColor <> 0 then
Include(lCell^.UsedFormattingFields, uffBackgroundColor)
Include(ACell^.UsedFormattingFields, uffBackgroundColor)
else
Exclude(lCell^.UsedFormattingFields, uffBackgroundColor);
Exclude(ACell^.UsedFormattingFields, uffBackgroundColor);
end;
end;
@ -368,9 +377,17 @@ procedure TsSpreadBIFF2Reader.ReadBlank(AStream: TStream);
var
ARow, ACol: Cardinal;
XF: Word;
cell: PCell;
begin
ReadRowColXF(AStream, ARow, ACol, XF);
ApplyCellFormatting(ARow, ACol, XF);
if FIsVirtualMode then begin
InitCell(ARow, ACol, FVirtualCell);
cell := @FVirtualCell;
end else
cell := FWorksheet.GetCell(ARow, ACol);
ApplyCellFormatting(cell, XF);
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
procedure TsSpreadBIFF2Reader.ReadColWidth(AStream: TStream);
@ -514,13 +531,20 @@ begin
{ Recalculation byte - currently not used }
AStream.ReadByte;
{ Create cell }
if FIsVirtualMode then begin
InitCell(ARow, ACol, FVirtualCell);
cell := @FVirtualCell;
end else
cell := FWorksheet.GetCell(ARow, ACol);
// Now determine the type of the formula result
if (Data[6] = $FF) and (Data[7] = $FF) then
case Data[0] of
0: // String -> Value is found in next record (STRING)
FIncompleteCell := FWorksheet.GetCell(ARow, ACol);
FIncompleteCell := cell;
1: // Boolean value
FWorksheet.WriteBoolValue(ARow, ACol, Data[2] = 1);
FWorksheet.WriteBoolValue(cell, Data[2] = 1);
2: begin // Error value
case Data[2] of
ERR_INTERSECTION_EMPTY : err := errEmptyIntersection;
@ -531,10 +555,10 @@ begin
ERR_OVERFLOW : err := errOverflow;
ERR_ARG_ERROR : err := errArgError;
end;
FWorksheet.WriteErrorValue(ARow, ACol, err);
FWorksheet.WriteErrorValue(cell, err);
end;
3: // Empty cell
FWorksheet.WriteBlank(ARow, ACol);
FWorksheet.WriteBlank(cell);
end
else begin
if SizeOf(Double) <> 8 then
@ -546,20 +570,22 @@ begin
{Find out what cell type, set content type and value}
ExtractNumberFormat(XF, nf, nfs);
if IsDateTime(formulaResult, nf, nfs, dt) then
FWorksheet.WriteDateTime(ARow, ACol, dt, nf, nfs)
FWorksheet.WriteDateTime(cell, dt, nf, nfs)
else
FWorksheet.WriteNumber(ARow, ACol, formulaResult, nf, nfs);
FWorksheet.WriteNumber(cell, formulaResult, nf, nfs);
end;
{ Formula token array }
if FWorkbook.ReadFormulas then begin
cell := FWorksheet.FindCell(ARow, ACol);
ok := ReadRPNTokenArray(AStream, cell^.RPNFormulaValue);
if not ok then FWorksheet.WriteErrorValue(cell, errFormulaNotSupported);
end;
{ Apply formatting to cell }
ApplyCellFormatting(ARow, ACol, XF);
ApplyCellFormatting(cell, XF);
if FIsVirtualMode and (cell <> FIncompleteCell) then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
procedure TsSpreadBIFF2Reader.ReadLabel(AStream: TStream);
@ -570,6 +596,7 @@ var
XF: Word;
AValue: ansistring;
AStrValue: UTF8String;
cell: PCell;
begin
{ Read entire record, starting at Row, except for string data }
AStream.ReadBuffer(rec.Row, SizeOf(TBIFF2LabelRecord) - 2*SizeOf(Word));
@ -594,10 +621,20 @@ begin
// Latin 1 is the default
AStrValue := CP1252ToUTF8(AValue);
end;
FWorksheet.WriteUTF8Text(ARow, ACol, AStrValue);
{ Create cell }
if FIsVirtualMode then begin
InitCell(ARow, ACol, FVirtualCell);
cell := @FVirtualCell;
end else
cell := FWorksheet.GetCell(ARow, ACol);
FWorksheet.WriteUTF8Text(cell, AStrValue);
{ Apply formatting to cell }
ApplyCellFormatting(ARow, ACol, XF);
ApplyCellFormatting(cell, XF);
if FIsVirtualMode and (cell <> FIncompleteCell) then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
procedure TsSpreadBIFF2Reader.ReadNumber(AStream: TStream);
@ -609,6 +646,7 @@ var
dt: TDateTime;
nf: TsNumberFormat;
nfs: String;
cell: PCell;
begin
{ Read entire record, starting at Row }
AStream.ReadBuffer(rec.Row, SizeOf(TBIFF2NumberRecord) - 2*SizeOf(Word));
@ -617,15 +655,25 @@ begin
XF := rec.Attrib1 and $3F;
value := rec.Value;
{Create cell}
if FIsVirtualMode then begin
InitCell(ARow, ACol, FVirtualCell);
cell := @FVirtualCell;
end else
cell := FWorksheet.GetCell(ARow, ACol);
{Find out what cell type, set content type and value}
ExtractNumberFormat(XF, nf, nfs);
if IsDateTime(value, nf, nfs, dt) then
FWorksheet.WriteDateTime(ARow, ACol, dt, nf, nfs)
FWorksheet.WriteDateTime(cell, dt, nf, nfs)
else
FWorksheet.WriteNumber(ARow, ACol, value, nf, nfs);
FWorksheet.WriteNumber(cell, value, nf, nfs);
{ Apply formatting to cell }
ApplyCellFormatting(ARow, ACol, XF);
ApplyCellFormatting(cell, XF);
if FIsVirtualMode and (cell <> FIncompleteCell) then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
procedure TsSpreadBIFF2Reader.ReadInteger(AStream: TStream);
@ -633,18 +681,30 @@ var
ARow, ACol: Cardinal;
XF: Word;
AWord : Word = 0;
cell: PCell;
rec: TBIFF2IntegerRecord;
begin
{ BIFF Record row/column/style }
ReadRowColXF(AStream, ARow, ACol, XF);
AStream.ReadBuffer(rec.Row, SizeOf(TBIFF2NumberRecord) - 2*SizeOf(Word));
ARow := WordLEToN(rec.Row);
ACol := WordLEToN(rec.Col);
XF := rec.Attrib1 and $3F;
AWord := WordLEToN(rec.Value);
{ 16 bit unsigned integer }
AStream.ReadBuffer(AWord, 2);
{ Create cell }
if FIsVirtualMode then begin
InitCell(ARow, ACol, FVirtualCell);
cell := @FVirtualCell;
end else
cell := FWorksheet.GetCell(ARow, ACol);
{ Save the data }
FWorksheet.WriteNumber(ARow, ACol, AWord);
FWorksheet.WriteNumber(cell, AWord);
{ Apply formatting to cell }
ApplyCellFormatting(ARow, ACol, XF);
ApplyCellFormatting(cell, XF);
if FIsVirtualMode and (cell <> FIncompleteCell) then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
// Read the row, column and xf index
@ -723,6 +783,8 @@ begin
// the FORMULA record which precedes the String record.
FIncompleteCell^.UTF8StringValue := AnsiToUTF8(s);
FIncompleteCell^.ContentType := cctUTF8String;
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, FIncompleteCell^.Row, FIncompleteCell^.Col, FIncompleteCell);
end;
end;
FIncompleteCell := nil;

2
components/fpspreadsheet/xlscommon.pas
View File

@ -382,7 +382,7 @@ type
FPaletteFound: Boolean;
FXFList: TFPList; // of TXFListData
FIncompleteCell: PCell;
procedure ApplyCellFormatting(ARow, ACol: Cardinal; XFIndex: Word); virtual; overload;
procedure ApplyCellFormatting(ARow, ACol: Cardinal; XFIndex: Word); overload;
procedure ApplyCellFormatting(ACell: PCell; XFIndex: Word); virtual; overload;
procedure CreateNumFormatList; override;
// Extracts a number out of an RK value