paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fpspreadsheet: Write printranges and repeated cells to biff5 files. Related improvements in BIFFExplorer.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4501 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2016-02-14 17:03:20 +00:00
parent 42e34dc695
commit 8eff203daa
4 changed files with 300 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
components/fpspreadsheet/reference/BIFFExplorer/bebiffgrid.pas
View File

@ -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

152
components/fpspreadsheet/xlsbiff5.pas
View File

@ -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

64
components/fpspreadsheet/xlsbiff8.pas
View File

@ -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

101
components/fpspreadsheet/xlscommon.pas
View File

@ -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: