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

fpspreadsheet: Implement virtual reading mode for biff8 and biff5 (activated by workbook option boVirtualMode when reading). Add demo_virtualmode_read. Update speed test (factor 2 faster than standard mode, main advantage: no significant memory usage)

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3372 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-07-24 11:51:34 +00:00
parent 6606f62e79
commit 5a65855a48
11 changed files with 498 additions and 184 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

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

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

@ -37,6 +37,8 @@ type
FCurFormat: TsSpreadsheetFormat;
procedure EnableControls(AEnable: Boolean);
function GetRowCount(AIndex: Integer): Integer;
procedure ReadCellDataHandler(Sender: TObject; ARow, ACol: Cardinal;
const ADataCell: PCell);
procedure WriteCellStringHandler(Sender: TObject; ARow, ACol: Cardinal;
var AValue: Variant; var AStyleCell: PCell);
procedure WriteCellNumberHandler(Sender: TObject; ARow, ACol: Cardinal;
@ -87,6 +89,12 @@ const
{ TForm1 }
procedure TForm1.ReadCellDataHandler(Sender: TObject; ARow, ACol: Cardinal;
const ADataCell: PCell);
begin
// nothing to do here.
end;
procedure TForm1.WriteCellStringHandler(Sender: TObject; ARow, ACol: cardinal;
var AValue: variant; var AStyleCell: PCell);
var
@ -161,6 +169,8 @@ begin
try
Application.ProcessMessages;
MyWorkbook.Options := Options;
if boVirtualMode in Options then
MyWorkbook.OnReadCellData := @ReadCellDataHandler;
Tm := GetTickCount;
try
MyWorkbook.ReadFromFile(fname, SPREAD_FORMAT[i]);
@ -349,13 +359,13 @@ begin
s := Format('%7.0nx%d', [1.0*rows, COLCOUNT]);
if CbVirtualModeOnly.Checked then begin
//RunReadTest(2, s + ' [boVM ]', [boVirtualMode]);
//RunReadTest(4, s + ' [boVM, boBS]', [boVirtualMode, boBufStream]);
RunReadTest(2, s + ' [boVM ]', [boVirtualMode]);
RunReadTest(4, s + ' [boVM, boBS]', [boVirtualMode, boBufStream]);
end else begin
RunReadTest(1, s + ' [ ]', []);
//RunReadTest(2, s + ' [boVM ]', [boVirtualMode]);
RunReadTest(2, s + ' [boVM ]', [boVirtualMode]);
RunReadTest(3, s + ' [ boBS]', [boBufStream]);
//RunReadTest(4, s + ' [boVM, boBS]', [boVirtualMode, boBufStream]);
RunReadTest(4, s + ' [boVM, boBS]', [boVirtualMode, boBufStream]);
end;
Memo.Append(DupeString('-', len));

116
components/fpspreadsheet/examples/other/demo_virtualmode_read.lpi Normal file
View File

@ -0,0 +1,116 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="demo_virtualmode_read"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="2">
<Item1 Name="Debug" Default="True"/>
<Item2 Name="Release">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="demo_virtualmode_read"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="..\.."/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
<StripSymbols Value="True"/>
</Debugging>
<LinkSmart Value="True"/>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</Item2>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LazUtils"/>
</Item1>
</RequiredPackages>
<Units Count="1">
<Unit0>
<Filename Value="demo_virtualmode_read.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="demo_virtualmode_read"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="..\.."/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<Optimizations>
<OptimizationLevel Value="0"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<UseExternalDbgSyms Value="True"/>
</Debugging>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

93
components/fpspreadsheet/examples/other/demo_virtualmode_read.lpr Normal file
View File

@ -0,0 +1,93 @@
program demo_virtualmode_read;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}
{$IFDEF UseCThreads}
cthreads,
{$ENDIF}
{$ENDIF}
Classes, SysUtils,
lazutf8,
variants, fpspreadsheet, xlsbiff2, xlsbiff5, xlsbiff8, xlsxooxml;
type
TDataAnalyzer = class
NumberCellCount: integer;
LabelCellCount: Integer;
procedure ReadCellDataHandler(Sender: TObject; ARow,ACol: Cardinal;
const ADataCell: PCell);
end;
const
TestFileName = 'test_virtual.xls';
var
workbook: TsWorkbook;
worksheet: TsWorksheet;
dataAnalyzer: TDataAnalyzer;
t: TTime;
procedure TDataAnalyzer.ReadCellDataHandler(Sender: TObject;
ARow, ACol: Cardinal; const ADataCell: PCell);
{ This is just a sample stupidly counting the number and label cells.
A more serious example could write the cell data to a database. }
var
s: String;
begin
if ADataCell^.ContentType = cctNumber then
inc(NumberCellCount);
if ADataCell^.ContentType = cctUTF8String then
inc(LabelCellCount);
// you can use the event handler also to provide feedback on how the process
// progresses:
if (ACol = 0) and (ARow mod 1000 = 0) then
WriteLn('Reading row ', ARow, '...');
end;
begin
if not FileExists(TestFileName) then begin
WriteLn('The test file does not exist. Please run demo_virtual_write first.');
Halt;
end;
dataAnalyzer := TDataAnalyzer.Create;
try
workbook := TsWorkbook.Create;
try
{ These are the essential commands to activate virtual mode: }
workbook.Options := [boVirtualMode];
// workbook.Options := [boVirtualMode, buBufStream];
{ boBufStream can be omitted, but is important for large files: it reads
large pieces of the file to a memory stream from which the data are
analyzed faster. }
{ The event handler for OnReadCellData links the workbook to the method
from which analyzes the data. }
workbook.OnReadCellData := @dataAnalyzer.ReadCellDataHandler;
t := Now;
workbook.ReadFromFile(TestFileName);
t := Now - t;
WriteLn(Format('The workbook containes %d number and %d label cells, total %d.', [
dataAnalyzer.NumberCellCount,
dataAnalyzer.LabelCellCount,
dataAnalyzer.NumberCellCount + dataAnalyzer.LabelCellCount]));
WriteLn(Format('Execution time: %.3f sec', [t*24*60*60]));
finally
workbook.Free;
end;
finally
dataAnalyzer.Free;
end;
WriteLn('Press [ENTER] to quit...');
ReadLn;
end.

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

@ -49,7 +49,7 @@ var
end else
AData := 10000*ARow + ACol;
// you can use the OnNeedData also to provide feedback on how the process
// you can use the event handler also to provide feedback on how the process
// progresses:
if (ACol = 0) and (ARow mod 1000 = 0) then
WriteLn('Writing row ', ARow, '...');
@ -76,10 +76,10 @@ begin
{ Next two numbers define the size of virtual spreadsheet.
In case of a database, VirtualRowCount is the RecordCount, VirtualColCount
the number of fields to be written to the spreadsheet file }
workbook.VirtualRowCount := 5000;
workbook.VirtualRowCount := 20000;
workbook.VirtualColCount := 100;
{ The event handler for OnNeedCellData links the workbook to the method
{ The event handler for OnWriteCellData links the workbook to the method
from which it gets the data to be written. }
workbook.OnWriteCellData := @dataprovider.WriteCellDataHandler;
@ -97,8 +97,8 @@ begin
{ In case of a database, you would open the dataset before calling this: }
t := Now;
workbook.WriteToFile('test_virtual.xlsx', sfOOXML, true);
//workbook.WriteToFile('test_virtual.xls', sfExcel8, true);
//workbook.WriteToFile('test_virtual.xlsx', sfOOXML, true);
workbook.WriteToFile('test_virtual.xls', sfExcel8, true);
//workbook.WriteToFile('test_virtual.xls', sfExcel5, true);
//workbook.WriteToFile('test_virtual.xls', sfExcel2, true);
t := Now - t;

4
components/fpspreadsheet/examples/other/readme.txt
View File

@ -12,6 +12,10 @@ This folder contains various demo applications:
- demo_virtualmode_writing: demonstrates how the virtual mode of the workbook
can be used to create huge spreadsheet files.
- demo_virtualmode_reading: demonstrates how the virtual mode of the workbook
can be used to read huge spreadsheet files. Requires the file written by
demo_virtualmode_writing.
- demo_write_formatting: shows some simple cell formatting
- demo_write_formula: shows some rpn formulas

44
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -941,6 +941,10 @@ type
FWorksheet: TsWorksheet;
{@@ List of number formats found in the file }
FNumFormatList: TsCustomNumFormatList;
{@@ Temporary cell for virtual mode}
FVirtualCell: TCell;
{@@ Stores if the reader is in virtual mode }
FIsVirtualMode: Boolean;
procedure CreateNumFormatList; virtual;
{ Record reading methods }
{@@ Abstract method for reading a blank cell. Must be overridden by descendent classes. }
@ -1094,7 +1098,8 @@ function GetFileFormatName(AFormat: TsSpreadsheetFormat): String;
procedure MakeLEPalette(APalette: PsPalette; APaletteSize: Integer);
function SameCellBorders(ACell1, ACell2: PCell): Boolean;
procedure InitCell(var ACell: TCell);
procedure InitCell(var ACell: TCell); overload;
procedure InitCell(ARow, ACol: Cardinal; var ACell: TCell); overload;
implementation
@ -1496,34 +1501,13 @@ begin
ACell.NumberFormatStr := '';
FillChar(ACell, SizeOf(ACell), 0);
end;
(*
Col: Cardinal; // zero-based
Row: Cardinal; // zero-based
ContentType: TCellContentType;
{ Possible values for the cells }
FormulaValue: TsFormula;
RPNFormulaValue: TsRPNFormula;
NumberValue: double;
UTF8StringValue: ansistring;
DateTimeValue: TDateTime;
BoolValue: Boolean;
ErrorValue: TsErrorValue;
{ Formatting fields }
{ When adding/deleting formatting fields don't forget to update CopyFormat! }
UsedFormattingFields: TsUsedFormattingFields;
FontIndex: Integer;
TextRotation: TsTextRotation;
HorAlignment: TsHorAlignment;
VertAlignment: TsVertAlignment;
Border: TsCellBorders;
BorderStyles: TsCelLBorderStyles;
BackgroundColor: TsColor;
NumberFormat: TsNumberFormat;
NumberFormatStr: String;
RGBBackgroundColor: TFPColor; // only valid if BackgroundColor=scRGBCOLOR
{ Status flags }
CalcState: TsCalcState;
*)
procedure InitCell(ARow, ACol: Cardinal; var ACell: TCell);
begin
InitCell(ACell);
ACell.Row := ARow;
ACell.Col := ACol;
end;
{ TsWorksheet }
@ -5305,6 +5289,8 @@ constructor TsCustomSpreadReader.Create(AWorkbook: TsWorkbook);
begin
inherited Create;
FWorkbook := AWorkbook;
FIsVirtualMode := (boVirtualMode in FWorkbook.Options) and
Assigned(FWorkbook.OnReadCellData);
CreateNumFormatList;
end;

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

@ -85,7 +85,6 @@
<Unit2>
<Filename Value="stringtests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="stringtests"/>
</Unit2>
<Unit3>
<Filename Value="numberstests.pas"/>
@ -94,7 +93,6 @@
<Unit4>
<Filename Value="manualtests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="manualtests"/>
</Unit4>
<Unit5>
<Filename Value="testsutility.pas"/>
@ -128,12 +126,10 @@
<Unit12>
<Filename Value="rpnformulaunit.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="rpnFormulaUnit"/>
</Unit12>
<Unit13>
<Filename Value="formulatests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="formulatests"/>
</Unit13>
<Unit14>
<Filename Value="emptycelltests.pas"/>

57
components/fpspreadsheet/xlsbiff5.pas
View File

@ -82,7 +82,6 @@ type
FCurrentWorksheet: Integer;
protected
{ Record writing methods }
procedure ReadBlank(AStream: TStream); override;
procedure ReadFont(const AStream: TStream);
procedure ReadFormat(AStream: TStream); override;
procedure ReadLabel(AStream: TStream); override;
@ -1450,6 +1449,7 @@ var
ARow, ACol: Cardinal;
XF: Word;
AStrValue: ansistring;
cell: PCell;
begin
ReadRowColXF(AStream, ARow, ACol, XF);
@ -1458,8 +1458,15 @@ begin
SetLength(AStrValue,L);
AStream.ReadBuffer(AStrValue[1], L);
{ Create cell }
if FIsVirtualMode then begin
InitCell(ARow, ACol, FVirtualCell);
cell := @FVirtualCell;
end else
cell := FWorksheet.GetCell(ARow, ACol);
{ Save the data }
FWorksheet.WriteUTF8Text(ARow, ACol, ISO_8859_1ToUTF8(AStrValue));
FWorksheet.WriteUTF8Text(cell, ISO_8859_1ToUTF8(AStrValue));
//Read formatting runs (not supported)
B:=AStream.ReadByte;
for L := 0 to B-1 do begin
@ -1468,7 +1475,10 @@ begin
end;
{ Add attributes to cell }
ApplyCellFormatting(ARow, ACol, XF);
ApplyCellFormatting(cell, XF);
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
{ Reads a STRING record which contains the result of string formula. }
@ -1485,6 +1495,8 @@ begin
if (FIncompleteCell <> nil) and (s <> '') then begin
FIncompleteCell^.UTF8StringValue := AnsiToUTF8(s);
FIncompleteCell^.ContentType := cctUTF8String;
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, FIncompleteCell^.Row, FIncompleteCell^.Col, FIncompleteCell);
end;
end;
FIncompleteCell := nil;
@ -1657,17 +1669,6 @@ begin
FWorksheetNames.Free;
end;
procedure TsSpreadBIFF5Reader.ReadBlank(AStream: TStream);
var
ARow, ACol: Cardinal;
XF: Word;
begin
{ Read row, column, and XF index from BIFF file }
ReadRowColXF(AStream, ARow, ACol, XF);
{ Add attributes to cell}
ApplyCellFormatting(ARow, ACol, XF);
end;
procedure TsSpreadBIFF5Reader.ReadFont(const AStream: TStream);
var
lCodePage: Word;
@ -1761,7 +1762,7 @@ var
L: Word;
ARow, ACol: Cardinal;
XF: WORD;
// AValue: array[0..255] of Char;
cell: PCell;
AValue: ansistring;
AStrValue: ansistring;
begin
@ -1776,23 +1777,21 @@ begin
SetLength(AValue, L);
AStream.ReadBuffer(AValue[1], L);
{ Save the data }
FWorksheet.WriteUTF8Text(ARow, ACol, ISO_8859_1ToUTF8(AValue));
(*
ReadRowColXF(AStream, ARow, ACol, XF);
{ Byte String with 16-bit size }
L := AStream.ReadWord();
AStream.ReadBuffer(AValue, L);
AValue[L] := #0;
AStrValue := AValue;
{ Create cell }
if FIsVirtualMode then begin
InitCell(ARow, ACol, FVirtualCell);
cell := @FVirtualCell;
end else
cell := FWorksheet.GetCell(ARow, ACol);
{ Save the data }
FWorksheet.WriteUTF8Text(ARow, ACol, ISO_8859_1ToUTF8(AStrValue));
*)
FWorksheet.WriteUTF8Text(cell, ISO_8859_1ToUTF8(AValue));
{ Add attributes }
ApplyCellFormatting(ARow, ACol, XF);
ApplyCellFormatting(cell, XF);
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;

129
components/fpspreadsheet/xlsbiff8.pas
View File

@ -78,12 +78,10 @@ type
procedure ReadBoundsheet(AStream: TStream);
function ReadString(const AStream: TStream; const ALength: WORD): UTF8String;
protected
procedure ReadBlank(AStream: TStream); override;
procedure ReadFont(const AStream: TStream);
procedure ReadFormat(AStream: TStream); override;
procedure ReadLabel(AStream: TStream); override;
procedure ReadLabelSST(const AStream: TStream);
// procedure ReadNumber() --> xlscommon
procedure ReadRichString(const AStream: TStream);
procedure ReadRPNCellAddress(AStream: TStream; out ARow, ACol: Cardinal;
out AFlags: TsRelFlags); override;
@ -110,8 +108,6 @@ type
{ Record writing methods }
procedure WriteBOF(AStream: TStream; ADataType: Word);
function WriteBoundsheet(AStream: TStream; ASheetName: string): Int64;
// procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal;
// const AValue: TDateTime; ACell: PCell); override;
procedure WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet);
procedure WriteEOF(AStream: TStream);
procedure WriteFont(AStream: TStream; AFont: TsFont);
@ -278,6 +274,26 @@ const
XF_ROTATION_STACKED
);
type
TBIFF8LabelRecord = packed record
RecordID: Word;
RecordSize: Word;
Row: Word;
Col: Word;
XFIndex: Word;
TextLen: Word;
TextFlags: Byte;
end;
TBIFF8LabelSSTRecord = packed record
RecordID: Word;
RecordSize: Word;
Row: Word;
Col: Word;
XFIndex: Word;
SSTIndex: DWord;
end;
{ TsSpreadBIFF8Writer }
@ -960,16 +976,6 @@ end;
*******************************************************************}
procedure TsSpreadBIFF8Writer.WriteLabel(AStream: TStream; const ARow,
ACol: Cardinal; const AValue: string; ACell: PCell);
type
TLabelRecord = packed record
RecordID: Word;
RecordSize: Word;
Row: Word;
Col: Word;
XFIndex: Word;
TextLen: Word;
TextFlags: Byte;
end;
const
//limit for this format: 32767 bytes - header (see reclen below):
//37267-8-1=32758
@ -978,7 +984,7 @@ var
L, RecLen: Word;
TextTooLong: boolean=false;
WideValue: WideString;
rec: TLabelRecord;
rec: TBIFF8LabelRecord;
buf: array of byte;
begin
WideValue := UTF8Decode(AValue); //to UTF16
@ -1027,33 +1033,13 @@ begin
{ Clean up }
SetLength(buf, 0);
(*
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_LABEL));
RecLen := 8 + 1 + L * SizeOf(WideChar);
AStream.WriteWord(WordToLE(RecLen));
{ BIFF Record data }
AStream.WriteWord(WordToLE(ARow));
AStream.WriteWord(WordToLE(ACol));
{ Index to XF record, according to formatting }
WriteXFIndex(AStream, ACell);
{ Byte String with 16-bit size }
AStream.WriteWord(WordToLE(L));
{ Byte flags. 1 means regular Unicode LE encoding}
AStream.WriteByte(1);
AStream.WriteBuffer(WideStringToLE(WideValue)[1], L * Sizeof(WideChar));
{
//todo: keep a log of errors and show with an exception after writing file or something.
We can't just do the following
if TextTooLong then
Raise Exception.CreateFmt('Text value exceeds %d character limit in cell [%d,%d]. Text has been truncated.',[MaxBytes,ARow,ACol]);
because the file wouldn't be written.
} *)
}
end;
{*******************************************************************
@ -1540,6 +1526,7 @@ begin
// Only one stream is necessary for any number of worksheets
OLEDocument.Stream := MemStream;
OLEStorage.ReadOLEFile(AFileName, OLEDocument, 'Workbook');
// Can't be shared with BIFF5 because of the parameter "Workbook" !!!)
// Check if the operation succeded
if MemStream.Size = 0 then raise Exception.Create('FPSpreadsheet: Reading the OLE document failed');
@ -1599,23 +1586,13 @@ begin
end;
procedure TsSpreadBIFF8Reader.ReadBlank(AStream: TStream);
var
ARow, ACol: Cardinal;
XF: Word;
begin
{ Read row, column, and XF index from BIFF file }
ReadRowColXF(AStream, ARow, ACol, XF);
{ Add attributes to cell}
ApplyCellFormatting(ARow, ACol, XF);
end;
procedure TsSpreadBIFF8Reader.ReadLabel(AStream: TStream);
var
L: Word;
ARow, ACol: Cardinal;
XF: Word;
WideStrValue: WideString;
cell: PCell;
begin
{ BIFF Record data: Row, Column, XF Index }
ReadRowColXF(AStream, ARow, ACol, XF);
@ -1627,10 +1604,19 @@ begin
WideStrValue:=ReadWideString(AStream,L);
{ Save the data }
FWorksheet.WriteUTF8Text(ARow, ACol, UTF16ToUTF8(WideStrValue));
if FIsVirtualMode then begin
InitCell(ARow, ACol, FVirtualCell); // "virtual" cell
cell := @FVirtualCell;
end else
cell := FWorksheet.GetCell(ARow, ACol); // "real" cell
FWorksheet.WriteUTF8Text(cell, UTF16ToUTF8(WideStrValue));
{Add attributes}
ApplyCellFormatting(ARow, ACol, XF);
ApplyCellFormatting(cell, XF);
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
procedure TsSpreadBIFF8Reader.ReadRichString(const AStream: TStream);
@ -1640,15 +1626,23 @@ var
ARow, ACol: Cardinal;
XF: Word;
AStrValue: ansistring;
cell: PCell;
begin
ReadRowColXF(AStream, ARow, ACol, XF);
{ Byte String with 16-bit size }
L := WordLEtoN(AStream.ReadWord());
AStrValue:=ReadString(AStream,L);
AStrValue:=ReadString(AStream,L); // ???? shouldn't this be a unicode string ????
{ Create cell }
if FIsVirtualMode then begin
InitCell(ARow, ACol, FVirtualCell);
cell := @FVirtualCell;
end else
cell := FWorksheet.GetCell(ARow, ACol);
{ Save the data }
FWorksheet.WriteUTF8Text(ARow, ACol, AStrValue);
FWorksheet.WriteUTF8Text(cell, AStrValue);
//Read formatting runs (not supported)
B:=WordLEtoN(AStream.ReadWord);
for L := 0 to B-1 do begin
@ -1657,7 +1651,10 @@ begin
end;
{Add attributes}
ApplyCellFormatting(ARow, ACol, XF);
ApplyCellFormatting(cell, XF);
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
{ Reads the cell address used in an RPN formula element. Evaluates the corresponding
@ -1779,16 +1776,34 @@ var
ACol,ARow: Cardinal;
XF: WORD;
SSTIndex: DWORD;
rec: TBIFF8LabelSSTRecord;
cell: PCell;
begin
ReadRowColXF(AStream, ARow, ACol, XF);
SSTIndex := DWordLEtoN(AStream.ReadDWord);
{ Read entire record, starting at Row }
AStream.ReadBuffer(rec.Row, SizeOf(TBIFF8LabelSSTRecord) - 2*SizeOf(Word));
ARow := WordLEToN(rec.Row);
ACol := WordLEToN(rec.Col);
XF := WordLEToN(rec.XFIndex);
SSTIndex := DWordLEToN(rec.SSTIndex);
if SizeInt(SSTIndex) >= FSharedStringTable.Count then begin
Raise Exception.CreateFmt('Index %d in SST out of range (0-%d)',[Integer(SSTIndex),FSharedStringTable.Count-1]);
end;
FWorksheet.WriteUTF8Text(ARow, ACol, FSharedStringTable[SSTIndex]);
{ Create cell }
if FIsVirtualMode then begin
InitCell(ARow, ACol, FVirtualCell);
cell := @FVirtualCell;
end else
cell := FWorksheet.GetCell(ARow, ACol);
FWorksheet.WriteUTF8Text(cell, FSharedStringTable[SSTIndex]);
{Add attributes}
ApplyCellFormatting(ARow, ACol, XF);
ApplyCellFormatting(cell, XF);
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
{ Helper function for reading a string with 8-bit length. }
@ -1808,6 +1823,8 @@ begin
if (FIncompleteCell <> nil) and (s <> '') then begin
FIncompleteCell^.UTF8StringValue := UTF8Encode(s);
FIncompleteCell^.ContentType := cctUTF8String;
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, FIncompleteCell^.Row, FIncompleteCell^.Col, FIncompleteCell);
end;
FIncompleteCell := nil;
end;

203
components/fpspreadsheet/xlscommon.pas
View File

@ -11,8 +11,12 @@ interface
uses
Classes, SysUtils, DateUtils,
fpspreadsheet,
fpsutils, lconvencoding;
{$ifdef USE_NEW_OLE}
fpolebasic,
{$else}
fpolestorage,
{$endif}
fpspreadsheet, fpsutils, lconvencoding;
const
{ RECORD IDs which didn't change across versions 2-8 }
@ -378,7 +382,8 @@ type
FPaletteFound: Boolean;
FXFList: TFPList; // of TXFListData
FIncompleteCell: PCell;
procedure ApplyCellFormatting(ARow, ACol: Cardinal; XFIndex: Word); virtual;
procedure ApplyCellFormatting(ARow, ACol: Cardinal; XFIndex: Word); virtual; overload;
procedure ApplyCellFormatting(ACell: PCell; XFIndex: Word); virtual; overload;
procedure CreateNumFormatList; override;
// Extracts a number out of an RK value
function DecodeRKValue(const ARK: DWORD): Double;
@ -394,6 +399,8 @@ type
function IsDateTime(Number: Double; ANumberFormat: TsNumberFormat;
ANumberFormatStr: String; out ADateTime: TDateTime): Boolean;
// Here we can add reading of records which didn't change across BIFF5-8 versions
// Read a blank cell
procedure ReadBlank(AStream: TStream); virtual;
procedure ReadCodePage(AStream: TStream);
// Read column info
procedure ReadColInfo(const AStream: TStream);
@ -434,6 +441,7 @@ type
procedure ReadStringRecord(AStream: TStream); virtual;
// Read WINDOW2 record (gridlines, sheet headers)
procedure ReadWindow2(AStream: TStream); virtual;
public
constructor Create(AWorkbook: TsWorkbook); override;
destructor Destroy; override;
@ -678,6 +686,14 @@ const
);
type
TBIFF58BlankRecord = packed record
RecordID: Word;
RecordSize: Word;
Row: Word;
Col: Word;
XFIndex: Word;
end;
TBIFF58NumberRecord = packed record
RecordID: Word;
RecordSize: Word;
@ -836,51 +852,58 @@ procedure TsSpreadBIFFReader.ApplyCellFormatting(ARow, ACol: Cardinal;
XFIndex: Word);
var
lCell: PCell;
XFData: TXFListData;
begin
lCell := FWorksheet.GetCell(ARow, ACol);
if Assigned(lCell) then begin
ApplyCellFormatting(lCell, XFIndex);
end;
{ Applies the XF formatting referred to by XFIndex to the specified cell }
procedure TsSpreadBIFFReader.ApplyCellFormatting(ACell: PCell; XFIndex: Word);
var
XFData: TXFListData;
begin
if Assigned(ACell) then begin
XFData := TXFListData(FXFList.Items[XFIndex]);
// Font
if XFData.FontIndex = 1 then
Include(lCell^.UsedFormattingFields, uffBold)
Include(ACell^.UsedFormattingFields, uffBold)
else
if XFData.FontIndex > 1 then
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;
// Word wrap
if XFData.WordWrap then
Include(lCell^.UsedFormattingFields, uffWordWrap)
Include(ACell^.UsedFormattingFields, uffWordWrap)
else
Exclude(lCell^.UsedFormattingFields, uffWordWrap);
Exclude(ACell^.UsedFormattingFields, uffWordWrap);
// Text rotation
if XFData.TextRotation > trHorizontal then
Include(lCell^.UsedFormattingFields, uffTextRotation)
Include(ACell^.UsedFormattingFields, uffTextRotation)
else
Exclude(lCell^.UsedFormattingFields, uffTextRotation);
lCell^.TextRotation := XFData.TextRotation;
Exclude(ACell^.UsedFormattingFields, uffTextRotation);
ACell^.TextRotation := XFData.TextRotation;
// Borders
lCell^.BorderStyles := XFData.BorderStyles;
ACell^.BorderStyles := XFData.BorderStyles;
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 color
if XFData.BackgroundColor <> scTransparent then begin
Include(lCell^.UsedFormattingFields, uffBackgroundColor);
lCell^.BackgroundColor := XFData.BackgroundColor;
Include(ACell^.UsedFormattingFields, uffBackgroundColor);
ACell^.BackgroundColor := XFData.BackgroundColor;
end else
Exclude(lCell^.UsedFormattingFields, uffBackgroundColor);
Exclude(ACell^.UsedFormattingFields, uffBackgroundColor);
end;
end;
@ -986,6 +1009,34 @@ begin
end;
end;
// Reads a blank cell
procedure TsSpreadBIFFReader.ReadBlank(AStream: TStream);
var
ARow, ACol: Cardinal;
XF: Word;
rec: TBIFF58BlankRecord;
cell: PCell;
begin
AStream.ReadBuffer(rec.Row, SizeOf(TBIFF58BlankRecord) - 2*SizeOf(Word));
ARow := WordLEToN(rec.Row);
ACol := WordLEToN(rec.Col);
XF := WordLEToN(rec.XFIndex);
if FIsVirtualMode then begin
InitCell(ARow, ACol, FVirtualCell);
cell := @FVirtualCell;
end else
cell := FWorksheet.GetCell(ARow, ACol);
FWorksheet.WriteBlank(cell);
{ Add attributes to cell}
ApplyCellFormatting(cell, XF);
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
// In BIFF8 it seams to always use the UTF-16 codepage
procedure TsSpreadBIFFReader.ReadCodePage(AStream: TStream);
var
@ -1123,14 +1174,21 @@ begin
{ Not used }
AStream.ReadDWord;
{ Create cell }
if FIsVirtualMode then begin // "Virtual" cell
InitCell(ARow, ACol, FVirtualCell);
cell := @FVirtualCell;
end else
cell := FWorksheet.GetCell(ARow, ACol); // "Real" cell
// 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
@ -1142,9 +1200,10 @@ begin
ERR_OVERFLOW : err := errOverflow;
ERR_ARG_ERROR : err := errArgError;
end;
FWorksheet.WriteErrorValue(ARow, ACol, err);
FWorksheet.WriteErrorValue(cell, err);
end;
3: FWorksheet.WriteBlank(ARow, ACol);
3: FWorksheet.WriteBlank(cell);
end
else begin
if SizeOf(Double) <> 8 then
@ -1156,20 +1215,22 @@ begin
{Find out what cell type, set content type and value}
ExtractNumberFormat(XF, nf, nfs);
if IsDateTime(ResultFormula, nf, nfs, dt) then
FWorksheet.WriteDateTime(ARow, ACol, dt, nf, nfs)
FWorksheet.WriteDateTime(cell, dt, nf, nfs)
else
FWorksheet.WriteNumber(ARow, ACol, ResultFormula, nf, nfs); //, nd, ncs);
FWorksheet.WriteNumber(cell, ResultFormula, nf, nfs); //, nd, ncs);
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;
{Add attributes}
ApplyCellFormatting(ARow, ACol, XF);
ApplyCellFormatting(cell, XF);
if FIsVirtualMode and (cell <> FIncompleteCell) then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
// Reads multiple blank cell records
@ -1178,14 +1239,25 @@ procedure TsSpreadBIFFReader.ReadMulBlank(AStream: TStream);
var
ARow, fc, lc, XF: Word;
pending: integer;
cell: PCell;
begin
ARow := WordLEtoN(AStream.ReadWord);
fc := WordLEtoN(AStream.ReadWord);
pending := RecordSize - Sizeof(fc) - Sizeof(ARow);
if FIsVirtualMode then begin
InitCell(ARow, 0, FVirtualCell);
cell := @FVirtualCell;
end;
while pending > SizeOf(XF) do begin
XF := AStream.ReadWord; //XF record (not used)
FWorksheet.WriteBlank(ARow, fc);
ApplyCellFormatting(ARow, fc, XF);
if FIsVirtualMode then
cell^.Col := fc
else
cell := FWorksheet.GetCell(ARow, fc);
FWorksheet.WriteBlank(cell);
ApplyCellFormatting(cell, XF);
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, fc, cell);
inc(fc);
dec(pending, SizeOf(XF));
end;
@ -1209,20 +1281,32 @@ var
RK: DWORD;
nf: TsNumberFormat;
nfs: String;
cell: PCell;
begin
ARow := WordLEtoN(AStream.ReadWord);
fc := WordLEtoN(AStream.ReadWord);
pending := RecordSize - SizeOf(fc) - SizeOf(ARow);
if FIsVirtualMode then begin
InitCell(ARow, fc, FVirtualCell);
cell := @FVirtualCell;
end;
while pending > SizeOf(XF) + SizeOf(RK) do begin
XF := AStream.ReadWord; //XF record (used for date checking)
if FIsVirtualMode then
cell^.Col := fc
else
cell := FWorksheet.GetCell(ARow, fc);
RK := DWordLEtoN(AStream.ReadDWord);
lNumber := DecodeRKValue(RK);
{Find out what cell type, set contenttype and value}
ExtractNumberFormat(XF, nf, nfs);
if IsDateTime(lNumber, nf, nfs, lDateTime) then
FWorksheet.WriteDateTime(ARow, fc, lDateTime, nf, nfs)
FWorksheet.WriteDateTime(cell, lDateTime, nf, nfs)
else
FWorksheet.WriteNumber(ARow, fc, lNumber, nf, nfs);
FWorksheet.WriteNumber(cell, lNumber, nf, nfs);
ApplyCellFormatting(cell, XF);
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, fc, cell);
inc(fc);
dec(pending, SizeOf(XF) + SizeOf(RK));
end;
@ -1246,6 +1330,7 @@ var
dt: TDateTime;
nf: TsNumberFormat;
nfs: String;
cell: PCell;
begin
{ Read entire record, starting at Row }
AStream.ReadBuffer(rec.Row, SizeOf(TBIFF58NumberRecord) - 2*SizeOf(Word));
@ -1253,22 +1338,27 @@ begin
ACol := WordLEToN(rec.Col);
XF := WordLEToN(rec.XFIndex);
value := rec.Value;
(*
ReadRowColXF(AStream, ARow, ACol, XF);
{ IEE 754 floating-point value }
AStream.ReadBuffer(value, 8);
*)
{Find out what cell type, set content type and value}
ExtractNumberFormat(XF, nf, nfs);
{ Create cell }
if FIsVirtualMode then begin // "virtual" cell
InitCell(ARow, ACol, FVirtualCell);
cell := @FVirtualCell;
end else
cell := FWorksheet.GetCell(ARow, ACol); // "real" cell
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);
{ Add attributes to cell }
ApplyCellFormatting(ARow, ACol, XF);
ApplyCellFormatting(cell, XF);
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
// Read the palette
@ -1334,6 +1424,7 @@ var
XF: Word;
lDateTime: TDateTime;
Number: Double;
cell: PCell;
nf: TsNumberFormat; // Number format
nfs: String; // Number format string
begin
@ -1346,15 +1437,25 @@ begin
{Check RK codes}
Number := DecodeRKValue(RK);
{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 contenttype and value}
ExtractNumberFormat(XF, nf, nfs);
if IsDateTime(Number, nf, nfs, lDateTime) then
FWorksheet.WriteDateTime(ARow, ACol, lDateTime, nf, nfs)
FWorksheet.WriteDateTime(cell, lDateTime, nf, nfs)
else
FWorksheet.WriteNumber(ARow, ACol, Number, nf, nfs);
FWorksheet.WriteNumber(cell, Number, nf, nfs);
{Add attributes}
ApplyCellFormatting(ARow, ACol, XF);
ApplyCellFormatting(cell, XF);
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
// Read the part of the ROW record that is common to BIFF3-8 versions
@ -1748,16 +1849,8 @@ end;
different record structure. }
procedure TsSpreadBIFFWriter.WriteBlank(AStream: TStream;
const ARow, ACol: Cardinal; ACell: PCell);
type
TBlankRecord = packed record
RecordID: Word;
RecordSize: Word;
Row: Word;
Col: Word;
XFIndex: Word;
end;
var
rec: TBlankRecord;
rec: TBIFF58BlankRecord;
begin
{ BIFF record header }
rec.RecordID := WordToLE(INT_EXCEL_ID_BLANK);