From 5a65855a48d44657dc7a2d98b849d2e695c77731 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Thu, 24 Jul 2014 11:51:34 +0000 Subject: [PATCH] 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) git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3372 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../examples/fpsspeedtest/mainform.lfm | 2 +- .../examples/fpsspeedtest/mainform.pas | 18 +- .../examples/other/demo_virtualmode_read.lpi | 116 ++++++++++ .../examples/other/demo_virtualmode_read.lpr | 93 ++++++++ .../examples/other/demo_virtualmode_write.lpr | 10 +- .../fpspreadsheet/examples/other/readme.txt | 4 + components/fpspreadsheet/fpspreadsheet.pas | 44 ++-- .../fpspreadsheet/tests/spreadtestgui.lpi | 4 - components/fpspreadsheet/xlsbiff5.pas | 57 +++-- components/fpspreadsheet/xlsbiff8.pas | 131 ++++++----- components/fpspreadsheet/xlscommon.pas | 203 +++++++++++++----- 11 files changed, 498 insertions(+), 184 deletions(-) create mode 100644 components/fpspreadsheet/examples/other/demo_virtualmode_read.lpi create mode 100644 components/fpspreadsheet/examples/other/demo_virtualmode_read.lpr diff --git a/components/fpspreadsheet/examples/fpsspeedtest/mainform.lfm b/components/fpspreadsheet/examples/fpsspeedtest/mainform.lfm index c14a76b9f..e8bab6510 100644 --- a/components/fpspreadsheet/examples/fpsspeedtest/mainform.lfm +++ b/components/fpspreadsheet/examples/fpsspeedtest/mainform.lfm @@ -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 diff --git a/components/fpspreadsheet/examples/fpsspeedtest/mainform.pas b/components/fpspreadsheet/examples/fpsspeedtest/mainform.pas index 696d9c25f..cd4a21a2b 100644 --- a/components/fpspreadsheet/examples/fpsspeedtest/mainform.pas +++ b/components/fpspreadsheet/examples/fpsspeedtest/mainform.pas @@ -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)); diff --git a/components/fpspreadsheet/examples/other/demo_virtualmode_read.lpi b/components/fpspreadsheet/examples/other/demo_virtualmode_read.lpi new file mode 100644 index 000000000..b2338f288 --- /dev/null +++ b/components/fpspreadsheet/examples/other/demo_virtualmode_read.lpi @@ -0,0 +1,116 @@ + + + + + + + + + + + + + + <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> diff --git a/components/fpspreadsheet/examples/other/demo_virtualmode_read.lpr b/components/fpspreadsheet/examples/other/demo_virtualmode_read.lpr new file mode 100644 index 000000000..eb6963258 --- /dev/null +++ b/components/fpspreadsheet/examples/other/demo_virtualmode_read.lpr @@ -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. + diff --git a/components/fpspreadsheet/examples/other/demo_virtualmode_write.lpr b/components/fpspreadsheet/examples/other/demo_virtualmode_write.lpr index 7d204d46f..9860daf3b 100644 --- a/components/fpspreadsheet/examples/other/demo_virtualmode_write.lpr +++ b/components/fpspreadsheet/examples/other/demo_virtualmode_write.lpr @@ -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; diff --git a/components/fpspreadsheet/examples/other/readme.txt b/components/fpspreadsheet/examples/other/readme.txt index 35562940f..842c3fe1e 100644 --- a/components/fpspreadsheet/examples/other/readme.txt +++ b/components/fpspreadsheet/examples/other/readme.txt @@ -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 diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index faf100508..8f06d518a 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -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; diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpi b/components/fpspreadsheet/tests/spreadtestgui.lpi index b8297869d..0b8a1cc2e 100644 --- a/components/fpspreadsheet/tests/spreadtestgui.lpi +++ b/components/fpspreadsheet/tests/spreadtestgui.lpi @@ -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"/> diff --git a/components/fpspreadsheet/xlsbiff5.pas b/components/fpspreadsheet/xlsbiff5.pas index 436853dc4..55b5cd3cb 100755 --- a/components/fpspreadsheet/xlsbiff5.pas +++ b/components/fpspreadsheet/xlsbiff5.pas @@ -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; diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas index 9e61bdc14..6e019d8d7 100755 --- a/components/fpspreadsheet/xlsbiff8.pas +++ b/components/fpspreadsheet/xlsbiff8.pas @@ -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; {******************************************************************* @@ -1539,7 +1525,8 @@ begin try // Only one stream is necessary for any number of worksheets OLEDocument.Stream := MemStream; - OLEStorage.ReadOLEFile(AFileName, OLEDocument,'Workbook'); + 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; diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas index ac77e470f..087e152ca 100644 --- a/components/fpspreadsheet/xlscommon.pas +++ b/components/fpspreadsheet/xlscommon.pas @@ -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);