From 8eff203daaca185df424366f4ef34e907892e23c Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sun, 14 Feb 2016 17:03:20 +0000 Subject: [PATCH] fpspreadsheet: Write printranges and repeated cells to biff5 files. Related improvements in BIFFExplorer. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4501 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../reference/BIFFExplorer/bebiffgrid.pas | 62 +++---- components/fpspreadsheet/xlsbiff5.pas | 152 +++++++++++++++++- components/fpspreadsheet/xlsbiff8.pas | 64 +++----- components/fpspreadsheet/xlscommon.pas | 101 +++++++++++- 4 files changed, 300 insertions(+), 79 deletions(-) diff --git a/components/fpspreadsheet/reference/BIFFExplorer/bebiffgrid.pas b/components/fpspreadsheet/reference/BIFFExplorer/bebiffgrid.pas index 92d1e5fae..a18286aa9 100644 --- a/components/fpspreadsheet/reference/BIFFExplorer/bebiffgrid.pas +++ b/components/fpspreadsheet/reference/BIFFExplorer/bebiffgrid.pas @@ -13,7 +13,7 @@ type TBIFFDetailsEvent = procedure(Sender: TObject; ADetails: TStrings) of object; TRichTextFormattingRun = packed record - FirstIndex, fontIndex: Word; + FirstIndex, FontIndex: Word; end; TRichTextFormattingRuns = array of TRichTextFormattingRun; @@ -153,7 +153,6 @@ type constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure SetBIFFNodeData(AData: TBIFFNodeData; ABuffer: TBIFFBuffer; AFormat: TsSpreadsheetFormat); -// procedure SetRecordType(ARecType: Word; ABuffer: TBIFFBuffer; AFormat: TsSpreadsheetFormat); published property OnDetails: TBIFFDetailsEvent read FOnDetails write FOnDetails; @@ -1676,8 +1675,7 @@ begin numBytes := lenName * sizeOf(ansiChar); SetLength(ansiStr, lenName); Move(FBuffer[FBufferIndex], ansiStr[1], numbytes); - ShowInRow(FCurrRow, FBufferIndex, numBytes, ansiStr, - 'Character array of the name'); + s := AnsiToUTF8(ansistr); end else begin if (FBuffer[FBufferIndex] and $01 = 0) //and (not IgnoreCompressedFlag) @@ -1692,29 +1690,29 @@ begin Move(FBuffer[FBufferIndex + 1], wideStr[1], lenName*SizeOf(WideChar)); s := UTF8Encode(WideStringLEToN(wideStr)); end; - if builtinName and (Length(s) = 1) then begin - s := Format('%s ($%x --> ', [s, ord(s[1])]); - case ord(s[1]) of - 0: s := s + 'Consolidate_Area)'; - 1: s := s + 'Auto_Open)'; - 2: s := s + 'Auto_Close)'; - 3: s := s + 'Extract)'; - 4: s := s + 'Database)'; - 5: s := s + 'Citeria)'; - 6: s := s + 'Print_Area)'; - 7: s := s + 'Print_Titles)'; - 8: s := s + 'Recorder)'; - 9: s := s + 'Data_Form)'; - 10: s := s + 'Auto_Activate)'; - 11: s := s + 'Auto_Deactivate)'; - 12: s := s + 'Sheet_Title)'; - 13: s := s + '_FilterDatabase)'; - else s := s + 'unknown meaning)'; - end; - end; - ShowInRow(FCurrRow, FBufferIndex, numbytes, s, - 'Name (Unicode string without length field)'); end; + if builtinName and (Length(s) = 1) then begin + s := Format('%s ($%x --> ', [s, ord(s[1])]); + case ord(s[1]) of + 0: s := s + 'Consolidate_Area)'; + 1: s := s + 'Auto_Open)'; + 2: s := s + 'Auto_Close)'; + 3: s := s + 'Extract)'; + 4: s := s + 'Database)'; + 5: s := s + 'Citeria)'; + 6: s := s + 'Print_Area)'; + 7: s := s + 'Print_Titles)'; + 8: s := s + 'Recorder)'; + 9: s := s + 'Data_Form)'; + 10: s := s + 'Auto_Activate)'; + 11: s := s + 'Auto_Deactivate)'; + 12: s := s + 'Sheet_Title)'; + 13: s := s + '_FilterDatabase)'; + else s := s + 'unknown meaning)'; + end; + end; + ShowInRow(FCurrRow, FBufferIndex, numbytes, s, + 'Name (Unicode string without length field)'); end; firstTokenBufIdx := FBufferIndex; @@ -1770,16 +1768,16 @@ begin if FFormat = sfExcel5 then begin if w and $8000 <> 0 then begin // negative value --> 3D reference ShowInRow(FCurrRow, FBufferIndex, numBytes, IntToStr(SmallInt(w)), - '3D reference, 1-based index to EXTERNSHEET record'); + 'negative --> 3D reference, 1-based index to EXTERNSHEET record = ' + IntToStr(-SmallInt(w))); numBytes := 8; ShowInRow(FCurrRow, FBufferIndex, numBytes, '', 'Not used'); numBytes := 2; Move(FBuffer[FBufferIndex], w, numBytes); ShowInRow(FCurrRow, FBufferIndex, numBytes, IntToStr(WordLEToN(w)), - 'Index to first referenced sheet ($FFFF = deleted sheet)'); + 'Zero-based index to first referenced sheet ($FFFF = deleted sheet)'); Move(FBuffer[FBufferIndex], w, numBytes); ShowInRow(FCurrRow, FBufferIndex, numBytes, IntToStr(WordLEToN(w)), - 'Index to last referenced sheet ($FFFF = deleted sheet)'); + 'Zero-based index to last referenced sheet ($FFFF = deleted sheet)'); end else begin ShowInRow(FCurrRow, FBufferIndex, numBytes, IntToStr(w), @@ -2050,13 +2048,15 @@ begin FDetails.Add('First character = $03: EXTERNSHEET stores a reference to one of the own sheets'); FDetails.Add('Document name: ' + Copy(s, 2, Length(s))); end else - if (s[1] = ':') and (Length(s) = 1) then begin + if (Length(s) = 1) and (s[1] = ':') then begin FDetails.Add('Special EXTERNSHEET record for an add-in function. EXTERNName record with the name of the function follows.'); end else FDetails.Add('Document name: ' + s); end; - if s[1] = #03 then + if s[1] = #03 then begin Delete(s, 1, 1); + s := '<#03>' + s; + end; ShowInRow(FCurrRow, FBufferIndex, numBytes, s, 'Encoded document and sheet name (Byte string, 8-bit string length)'); end else begin diff --git a/components/fpspreadsheet/xlsbiff5.pas b/components/fpspreadsheet/xlsbiff5.pas index bb869358e..7df56e416 100755 --- a/components/fpspreadsheet/xlsbiff5.pas +++ b/components/fpspreadsheet/xlsbiff5.pas @@ -49,7 +49,7 @@ AUTHORS: Felipe Monteiro de Carvalho unit xlsbiff5; {$ifdef fpc} - {$mode delphi}{$H+} + {$mode objfpc}{$H+} {$endif} {$define USE_NEW_OLE} @@ -101,6 +101,8 @@ type { Record writing methods } procedure WriteBOF(AStream: TStream; ADataType: Word); function WriteBoundsheet(AStream: TStream; ASheetName: string): Int64; + procedure WriteDefinedName(AStream: TStream; AWorksheet: TsWorksheet; + const AName: String; AIndexToREF: Word); override; procedure WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteEOF(AStream: TStream); procedure WriteFont(AStream: TStream; AFont: TsFont); @@ -1007,11 +1009,14 @@ begin WriteBOF(AStream, INT_BOF_WORKBOOK_GLOBALS); - WriteCodepage(AStream, FCodePage); - WriteWindow1(AStream); + WriteCODEPAGE(AStream, FCodePage); + WriteEXTERNCOUNT(AStream); + WriteEXTERNSHEET(AStream); + WriteDefinedNames(AStream); + WriteWINDOW1(AStream); WriteFonts(AStream); WriteNumFormats(AStream); - WritePalette(AStream); + WritePALETTE(AStream); WriteXFRecords(AStream); WriteStyle(AStream); @@ -1204,6 +1209,145 @@ begin AStream.WriteBuffer(xlsSheetName[1], Len); end; +{@@ ---------------------------------------------------------------------------- + Writes out a DEFINEDNAMES record +-------------------------------------------------------------------------------} +procedure TsSpreadBIFF5Writer.WriteDefinedName(AStream: TStream; + AWorksheet: TsWorksheet; const AName: String; AIndexToREF: Word); + + procedure WriteRangeFormula(MemStream: TMemoryStream; ARange: TsCellRange; + AIndexToREF, ACounter: Word); + var + sheetIdx: Integer; + begin + sheetIdx := FWorkbook.GetWorksheetIndex(AWorksheet); + + { Token for tArea3dR } + MemStream.WriteByte($3B); + + { 1-based sheet index, negative to indicate 3D reference } + MemStream.WriteWord(WordToLE(-(sheetIdx+1))); + + { 8 bytes not used } + MemStream.WriteDWord(0); + MemStream.WriteDWord(0); + + { Index to first reference worksheet } + MemStream.WriteWord(WordToLE(sheetIdx)); // THIS IS ONLY VALID FOR PRINTRANGE! + + { Index to last reference worksheet } + MemStream.WriteWord(WordToLE(sheetIdx)); // THIS IS ONLY VALID FOR PRINTRANGE! + + { First row index } + MemStream.WriteWord(WordToLE(ARange.Row1)); + + { Last row index } + MemStream.WriteWord(WordToLE(ARange.Row2)); + + { First column index } + MemStream.WriteByte(ARange.Col1); + + { Last column index } + MemStream.WriteByte(ARange.Col2); + + { Token for list if formula refers to more than 1 range } + if ACounter > 1 then + MemStream.WriteByte($10); + end; + +var + memstream: TMemoryStream; + rng: TsCellRange; + j: Integer; + idx: Integer; +begin + // Since this is a variable length record we begin by writing the formula + // to a memory stream + + memstream := TMemoryStream.Create; + try + case AName of + #06: begin // Print range + for j := 0 to AWorksheet.NumPrintRanges-1 do + begin + rng := AWorksheet.GetPrintRange(j); + WriteRangeFormula(memstream, rng, AIndexToRef, j+1); + end; + end; + #07: begin + j := 1; + if AWorksheet.HasRepeatedPrintCols then + begin + rng.Col1 := AWorksheet.PageLayout.RepeatedCols.FirstIndex; + rng.Col2 := AWorksheet.PageLayout.RepeatedCols.LastIndex; + if rng.Col2 = UNASSIGNED_ROW_COL_INDEX then rng.Col2 := rng.Col1; + rng.Row1 := 0; + rng.Row2 := 65535; + WriteRangeFormula(memstream, rng, AIndexToRef, j); + inc(j); + end; + if AWorksheet.HasRepeatedPrintRows then + begin + rng.Row1 := AWorksheet.PageLayout.RepeatedRows.FirstIndex; + rng.Row2 := AWorksheet.PageLayout.RepeatedRows.LastIndex; + if rng.Row2 = UNASSIGNED_ROW_COL_INDEX then rng.Row2 := rng.Row1; + rng.Col1 := 0; + rng.Col2 := 255; + WriteRangeFormula(memstream, rng, AIndexToRef, j); + end; + end; + else raise Exception.Create('Name not supported'); + end; // case + + idx := FWorkbook.GetWorksheetIndex(AWorksheet); + + { BIFF record header } + WriteBIFFHeader(AStream, INT_EXCEL_ID_DEFINEDNAME, 14 + Length(AName) + memstream.Size); + + { Option flags: built-in defined names only } + AStream.WriteWord(WordToLE($0020)); + + { Keyboard shortcut (only for command macro names) } + AStream.WriteByte(0); + + { Length of name (character count). Always 1 for built-in names } + AStream.WriteByte(Length(AName)); + + { Size of formula data } + AStream.WriteWord(WordToLE(memstream.Size)); + + { Global name, otherwise index to EXTERNSHEET record (1-based) } + AStream.WriteWord(WordToLE(AIndexToREF+1)); + + { Global name, otherwise index to sheet (1-based) } + AStream.WriteWord(WordToLE(idx+1)); + + { Length of menu text } + AStream.WriteByte(0); + + { Length of description text } + AStream.WriteByte(0); + + { Length of help topic text } + AStream.WriteByte(0); + + { Length of status bar text } + AStream.WriteByte(0); + + { Name } + if (Length(AName) = 1) and (AName[1] < #32) then + AStream.WriteByte(ord(AName[1])) else + raise Exception.Create('Name not supported.'); + + { Formula } + memstream.Position := 0; + AStream.CopyFrom(memstream, memstream.Size); + + finally + memstream.Free; + end; +end; + {@@ ---------------------------------------------------------------------------- Writes an Excel 5 DIMENSIONS record diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas index 0000e3fea..b3325517c 100755 --- a/components/fpspreadsheet/xlsbiff8.pas +++ b/components/fpspreadsheet/xlsbiff8.pas @@ -45,7 +45,7 @@ AUTHORS: Felipe Monteiro de Carvalho unit xlsbiff8; {$ifdef fpc} - {$mode delphi}{$H+} + {$mode objfpc}{$H+} {$endif} // The new OLE code is much better, so always use it @@ -132,12 +132,11 @@ type procedure WriteComment(AStream: TStream; ACell: PCell); override; procedure WriteComments(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteDefinedName(AStream: TStream; AWorksheet: TsWorksheet; - AIndexToREF: Word; AKind: Byte); - procedure WriteDefinedNames(AStream: TStream); + const AName: String; AIndexToREF: Word); override; procedure WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteEOF(AStream: TStream); procedure WriteEXTERNBOOK(AStream: TStream); - procedure WriteEXTERNSHEET(AStream: TStream); + procedure WriteEXTERNSHEET(AStream: TStream); override; procedure WriteFONT(AStream: TStream; AFont: TsFont); procedure WriteFonts(AStream: TStream); procedure WriteFORMAT(AStream: TStream; ANumFormatStr: String; @@ -658,8 +657,8 @@ var i: Integer; j: Integer; //j: SizeUInt; lLen: SizeInt; - RecordType: WORD; - RecordSize: WORD; + recType: WORD; + recSize: WORD; C: WideChar; begin StringFlags := AStream.ReadByte; @@ -699,12 +698,12 @@ begin Dec(PendingRecordSize); if (PendingRecordSize <= 0) and (i < lLen) then begin //A CONTINUE may have happened here - RecordType := WordLEToN(AStream.ReadWord); - RecordSize := WordLEToN(AStream.ReadWord); - if RecordType <> INT_EXCEL_ID_CONTINUE then begin + recType := WordLEToN(AStream.ReadWord); + recSize := WordLEToN(AStream.ReadWord); + if recType <> INT_EXCEL_ID_CONTINUE then begin Raise Exception.Create('[TsSpreadBIFF8Reader.ReadWideString] CONTINUE record expected, but not found.'); end else begin - PendingRecordSize := RecordSize; + PendingRecordSize := recSize; DecomprStrValue := copy(DecomprStrValue,1,i) + ReadWideString(AStream, ALength-i, ARichTextParams); break; end; @@ -718,12 +717,12 @@ begin for j := 0 to SmallInt(RunsCounter) - 1 do begin if (PendingRecordSize <= 0) then begin // A CONTINUE may happened here - RecordType := WordLEToN(AStream.ReadWord); - RecordSize := WordLEToN(AStream.ReadWord); - if RecordType <> INT_EXCEL_ID_CONTINUE then begin + recType := WordLEToN(AStream.ReadWord); + recSize := WordLEToN(AStream.ReadWord); + if recType <> INT_EXCEL_ID_CONTINUE then begin Raise Exception.Create('[TsSpreadBIFF8Reader.ReadWideString] CONTINUE record expected, but not found.'); end else begin - PendingRecordSize := RecordSize; + PendingRecordSize := recSize; end; end; // character start index: 0-based in file, 1-based in fps @@ -2239,7 +2238,7 @@ end; Implements only the builtin defined names for print ranges and titles! -------------------------------------------------------------------------------} procedure TsSpreadBIFF8Writer.WriteDefinedName(AStream: TStream; - AWorksheet: TsWorksheet; AIndexToREF: Word; AKind: Byte); + AWorksheet: TsWorksheet; const AName: String; AIndexToREF: Word); procedure WriteRangeFormula(MemStream: TMemoryStream; ARange: TsCellRange; AIndexToRef, ACounter: Word); @@ -2277,15 +2276,15 @@ begin memstream := TMemoryStream.Create; try - case AKind of - $06: begin // Print range + case AName of + #06: begin // Print range for j := 0 to AWorksheet.NumPrintRanges-1 do begin rng := AWorksheet.GetPrintRange(j); WriteRangeFormula(memstream, rng, AIndexToRef, j+1); end; end; - $07: begin + #07: begin // Print titles j := 1; if AWorksheet.HasRepeatedPrintCols then begin @@ -2307,6 +2306,8 @@ begin WriteRangeFormula(memstream, rng, AIndexToRef, j); end; end; + else + raise Exception.Create('Name not supported'); end; // case { BIFF record header } @@ -2344,7 +2345,9 @@ begin AStream.WriteByte(0); { Name } - AStream.WriteWord(WordToLE(AKind shl 8)); + if (Length(AName) = 1) and (AName[1] < #32) then + AStream.WriteWord(WordToLE(ord(AName[1]) shl 8)) else + raise Exception.Create('Name not supported.'); { Formula } memstream.Position := 0; @@ -2355,29 +2358,6 @@ begin end; end; -procedure TsSpreadBIFF8Writer.WriteDefinedNames(AStream: TStream); -var - sheet: TsWorksheet; - i: Integer; - n: Word; -begin - n := 0; - for i:=0 to FWorkbook.GetWorksheetCount-1 do - begin - sheet := FWorkbook.GetWorksheetByIndex(i); - if (sheet.NumPrintRanges > 0) or - sheet.HasRepeatedPrintCols or sheet.HasRepeatedPrintRows then - begin - if sheet.NumPrintRanges > 0 then - WriteDefinedName(AStream, sheet, n, $06); - if sheet.HasRepeatedPrintCols or sheet.HasRepeatedPrintRows then - WriteDefinedName(AStream, sheet, n, $07); - inc(n); - end; - end; -end; - - {@@ ---------------------------------------------------------------------------- Writes an Excel 8 DIMENSIONS record diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas index 91b472e9e..e7256746c 100644 --- a/components/fpspreadsheet/xlscommon.pas +++ b/components/fpspreadsheet/xlscommon.pas @@ -35,9 +35,12 @@ const INT_EXCEL_ID_CODEPAGE = $0042; INT_EXCEL_ID_DEFCOLWIDTH = $0055; + { RECORD IDs which did not changed across versions 2-5 } + INT_EXCEL_ID_EXTERNCOUNT = $0016; // does not exist in BIFF8 + { RECORD IDs which did not change across versions 2, 5, 8} INT_EXCEL_ID_FORMULA = $0006; // BIFF3: $0206, BIFF4: $0406 - INT_EXCEL_ID_DEFINEDNAME = $0018; // BIFF3: $0218, BIFF4: $0218 + INT_EXCEL_ID_DEFINEDNAME = $0018; // BIFF3-4: $0218 INT_EXCEL_ID_FONT = $0031; // BIFF3-4: $0231 { RECORD IDs which did not change across version 3-8} @@ -499,10 +502,18 @@ type procedure WriteDateMode(AStream: TStream); // Writes out a TIME/DATE/TIMETIME procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; - const AValue: TDateTime; ACell: PCell); override; + const AValue: TDateTime; ACell: PCell); override; + // Writes out DEFINEDNAMES records + procedure WriteDefinedName(AStream: TStream; AWorksheet: TsWorksheet; + const AName: String; AIndexToREF: Word); virtual; + procedure WriteDefinedNames(AStream: TStream); // Writes out ERROR cell record procedure WriteError(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TsErrorValue; ACell: PCell); override; + // Writes out an EXTERNCOUNT record + procedure WriteEXTERNCOUNT(AStream: TStream); + // Writes out an EXTERNSHEET record + procedure WriteEXTERNSHEET(AStream: TStream); virtual; // Writes out a FORMAT record procedure WriteFORMAT(AStream: TStream; ANumFormatStr: String; ANumFormatIndex: Integer); virtual; @@ -2884,6 +2895,34 @@ begin WriteNumber(AStream, ARow, ACol, ExcelDateSerial, ACell); end; +procedure TsSpreadBIFFWriter.WriteDefinedName(AStream: TStream; + AWorksheet: TsWorksheet; const AName: String; AIndexToREF: Word); +begin + // Override +end; + +procedure TsSpreadBIFFWriter.WriteDefinedNames(AStream: TStream); +var + sheet: TsWorksheet; + i: Integer; + n: Word; +begin + n := 0; + for i:=0 to FWorkbook.GetWorksheetCount-1 do + begin + sheet := FWorkbook.GetWorksheetByIndex(i); + if (sheet.NumPrintRanges > 0) or + sheet.HasRepeatedPrintCols or sheet.HasRepeatedPrintRows then + begin + if sheet.NumPrintRanges > 0 then + WriteDefinedName(AStream, sheet, #6, n); + if sheet.HasRepeatedPrintCols or sheet.HasRepeatedPrintRows then + WriteDefinedName(AStream, sheet, #7, n); + inc(n); + end; + end; +end; + {@@ ---------------------------------------------------------------------------- Writes an ERROR cell record. Valid for BIFF3-BIFF8. Override for BIFF2. @@ -2915,6 +2954,64 @@ begin AStream.WriteBuffer(rec, SizeOf(rec)); end; +{@@ ---------------------------------------------------------------------------- + Writes a BIFF EXTERNCOUNT record. + Valid for BIFF2-BIFF5. +-------------------------------------------------------------------------------} +procedure TsSpreadBIFFWriter.WriteEXTERNCOUNT(AStream: TStream); +var + i: Integer; + n: Word; + sheet: TsWorksheet; +begin + n := 0; + for i := 0 to FWorkbook.GetWorksheetCount-1 do + begin + sheet := FWorkbook.GetWorksheetByIndex(i); + if (sheet.NumPrintRanges > 0) or + sheet.HasRepeatedPrintCols or sheet.HasRepeatedPrintRows then inc(n); + end; + + if n < 1 then + exit; + + { BIFF record header } + WriteBIFFHeader(AStream, INT_EXCEL_ID_EXTERNCOUNT, 2); + + { Count of EXTERNSHEET records following } + AStream.WriteWord(WordToLE(n)); +end; + +{@@ ---------------------------------------------------------------------------- + Writes a BIFF EXTERNSHEET record. + Valid for BIFF2-BIFF5. +-------------------------------------------------------------------------------} +procedure TsSpreadBIFFWriter.WriteEXTERNSHEET(AStream: TStream); +var + sheet: TsWorksheet; + i: Integer; +begin + for i := 0 to FWorkbook.GetWorksheetCount-1 do + begin + sheet := FWorkbook.GetWorksheetByIndex(i); + if (sheet.NumPrintRanges > 0) or + sheet.HasRepeatedPrintCols or sheet.HasRepeatedPrintRows then + begin + { BIFF record header } + WriteBIFFHeader(AStream, INT_EXCEL_ID_EXTERNSHEET, 2 + Length(sheet.Name)); + + { Character count in worksheet name } + AStream.WriteByte(Length(sheet.Name)); + + { Flag for identification as own sheet } + AStream.WriteByte($03); + + { Sheet name } + AStream.WriteBuffer(sheet.Name[1], Length(sheet.Name)); + end; + end; +end; + {@@ ---------------------------------------------------------------------------- Writes the a margin record for printing (margin is in inches). The margin is identified by the parameter AMargin: