From be3e5d16ac47d07a2661bbf8b81cdd8a826c13b7 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Tue, 15 Jul 2014 14:59:48 +0000 Subject: [PATCH] fpspreadsheet: Speed up biff writing for number and label cells in woSaveMemory mode by a factor of 4 (writing complete records instead of single bytes and words) git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3321 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../examples/excel8demo/excel8write.lpi | 2 +- .../examples/other/test_virtualmode.lpr | 16 ++--- components/fpspreadsheet/xlsbiff8.pas | 53 ++++++++++++++--- components/fpspreadsheet/xlscommon.pas | 58 ++++++++++++++++++- 4 files changed, 112 insertions(+), 17 deletions(-) diff --git a/components/fpspreadsheet/examples/excel8demo/excel8write.lpi b/components/fpspreadsheet/examples/excel8demo/excel8write.lpi index 7291286ae..dc6cee5f3 100644 --- a/components/fpspreadsheet/examples/excel8demo/excel8write.lpi +++ b/components/fpspreadsheet/examples/excel8demo/excel8write.lpi @@ -113,7 +113,7 @@ - + diff --git a/components/fpspreadsheet/examples/other/test_virtualmode.lpr b/components/fpspreadsheet/examples/other/test_virtualmode.lpr index 93b6f1a7e..14f8a445e 100644 --- a/components/fpspreadsheet/examples/other/test_virtualmode.lpr +++ b/components/fpspreadsheet/examples/other/test_virtualmode.lpr @@ -41,12 +41,12 @@ var // This makes the style of the "headerTemplate" cell available to // formatting of all virtual cells in row 0. // Important: The template cell must be an existing cell in the worksheet. - end else - if odd(random(10)) then begin + end else { + if odd(random(10)) then }begin s := Format('R=%d-C=%d', [ARow, ACol]); AData := s; - end else - AData := 10000*ARow + ACol; + end {else + AData := 10000*ARow + ACol}; // you can use the OnNeedData also to provide feedback on how the process // progresses: @@ -65,8 +65,8 @@ begin { These are the essential commands to activate virtual mode: } -// workbook.WritingOptions := [woVirtualMode, woSaveMemory]; - workbook.WritingOptions := [woVirtualMode]; + workbook.WritingOptions := [woVirtualMode, woSaveMemory]; +// workbook.WritingOptions := [woVirtualMode]; { woSaveMemory can be omitted, but is essential for large files: it causes writing temporaray data to a file stream instead of a memory stream. woSaveMemory, however, considerably slows down writing of biff files. } @@ -93,8 +93,8 @@ begin worksheet.WriteRowHeight(0, 3); worksheet.WriteColWidth(0, 30); { In case of a database, you would open the dataset before calling this: } - 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); finally workbook.Free; diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas index e0f7ffc53..2540ca7a9 100755 --- a/components/fpspreadsheet/xlsbiff8.pas +++ b/components/fpspreadsheet/xlsbiff8.pas @@ -924,18 +924,29 @@ 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 - MaxBytes=32758; + MAXBYTES = 32758; var L, RecLen: Word; TextTooLong: boolean=false; WideValue: WideString; + rec: TLabelRecord; + buf: array of byte; begin WideValue := UTF8Decode(AValue); //to UTF16 - if WideValue = '' then - begin + if WideValue = '' then begin // Badly formatted UTF8String (maybe ANSI?) if Length(AValue)<>0 then begin //Quite sure it was an ANSI string written as UTF8, so raise exception. @@ -944,15 +955,43 @@ begin Exit; end; - if Length(WideValue)>MaxBytes then - begin + if Length(WideValue) > MAXBYTES then begin // Rather than lose data when reading it, let the application programmer deal // with the problem or purposefully ignore it. TextTooLong := true; - SetLength(WideValue,MaxBytes); //may corrupt the string (e.g. in surrogate pairs), but... too bad. + SetLength(WideValue, MaxBytes); //may corrupt the string (e.g. in surrogate pairs), but... too bad. end; L := Length(WideValue); + { BIFF record header } + rec.RecordID := WordToLE(INT_EXCEL_ID_LABEL); + rec.RecordSize := 8 + 1 + L * SizeOf(WideChar); + + { BIFF record data } + rec.Row := WordToLE(ARow); + rec.Col := WordToLE(ACol); + + { Index to XF record, according to formatting } + rec.XFIndex := WordToLE(FindXFIndex(ACell)); + + { Byte String with 16-bit length } + rec.TextLen := WordToLE(L); + + { Byte flags, 1 means regular unicode LE encoding } + rec.TextFlags := 1; + + { Copy the text characters into a buffer immediately after rec } + SetLength(buf, SizeOf(rec) + L*SizeOf(WideChar)); + Move(rec, buf[0], SizeOf(Rec)); + Move(WideStringToLE(WideValue)[1], buf[SizeOf(Rec)], L*SizeOf(WideChar)); + + { Write out } + AStream.WriteBuffer(buf[0], SizeOf(rec) + L*SizeOf(WideChar)); + + { Clean up } + SetLength(buf, 0); + + (* { BIFF Record header } AStream.WriteWord(WordToLE(INT_EXCEL_ID_LABEL)); RecLen := 8 + 1 + L * SizeOf(WideChar); @@ -978,7 +1017,7 @@ begin 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; {******************************************************************* diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas index ecf69c262..181e8aefa 100644 --- a/components/fpspreadsheet/xlscommon.pas +++ b/components/fpspreadsheet/xlscommon.pas @@ -448,6 +448,7 @@ type FLastCol: Cardinal; procedure AddDefaultFormats; override; procedure CreateNumFormatList; override; + function FindXFIndex(ACell: PCell): Integer; procedure GetLastRowCallback(ACell: PCell; AStream: TStream); function GetLastRowIndex(AWorksheet: TsWorksheet): Integer; procedure GetLastColCallback(ACell: PCell; AStream: TStream); @@ -1655,6 +1656,32 @@ begin FNumFormatList := TsBIFFNumFormatList.Create(Workbook); end; +{ Determines the index of the XF record, according to formatting of the given cell } +function TsSpreadBIFFWriter.FindXFIndex(ACell: PCell): Integer; +var + idx: Integer; + xfIndex: Word; + cell: TCell; +begin + // First try the fast methods for default formats + if ACell^.UsedFormattingFields = [] then begin + Result := 15; //XF15; see TsSpreadBIFF8Writer.AddDefaultFormats + Exit; + end; + + // If not, then we need to search in the list of dynamic formats + // But we have to consider that the number formats of the cell is in fpc syntax, + // but the number format list of the writer is in Excel syntax. + cell := ACell^; + idx := FindFormattingInList(@cell); + + // Carefully check the index + if (idx < 0) or (idx > Length(FFormattingStyles)) then + Result := -1 + else + Result := FFormattingStyles[idx].Row; +end; + function TsSpreadBIFFWriter.FormulaElementKindToExcelTokenID( AElementKind: TFEKind; out ASecondaryID: Word): Word; begin @@ -1836,7 +1863,36 @@ end; Valid for BIFF5 and BIFF8 (BIFF2 has a different record structure.). } procedure TsSpreadBIFFWriter.WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double; ACell: PCell); +type + TNumberRecord = packed record + RecordID: Word; + RecordSize: Word; + Row: Word; + Col: Word; + XFIndex: Word; + Value: Double; + end; +var + rec: TNumberRecord; begin + { BIFF Record header } + rec.RecordID := WordToLE(INT_EXCEL_ID_NUMBER); + rec.RecordSize := WordToLE(14); + + { BIFF Record data } + rec.Row := WordToLE(ARow); + rec.Col := WordToLE(ACol); + + { Index to XF record } + rec.XFIndex := FindXFIndex(ACell); + + { IEE 754 floating-point value } + rec.Value := AValue; + + AStream.WriteBuffer(rec, sizeof(Rec)); +end; + (* + { BIFF Record header } AStream.WriteWord(WordToLE(INT_EXCEL_ID_NUMBER)); AStream.WriteWord(WordToLE(14)); @@ -1850,7 +1906,7 @@ begin { IEE 754 floating-point value } AStream.WriteBuffer(AValue, 8); -end; +end; *) procedure TsSpreadBIFFWriter.WritePalette(AStream: TStream); var