fpspreadsheet: Fix PageLayout. Separate BIFF5 and BIFF8 handling of 3d references.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6412 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-05-15 07:37:50 +00:00
parent 60128ccaed
commit 4ab667eb30
4 changed files with 826 additions and 555 deletions

View File

@ -105,7 +105,8 @@ type
procedure WriteBOF(AStream: TStream; ADataType: Word);
function WriteBoundsheet(AStream: TStream; AWorkSheet: TsWorksheet): Int64;
procedure WriteDefinedName(AStream: TStream; AWorksheet: TsWorksheet;
const AName: String; AIndexToREF: Word); override;
const AName: String; AIndexToREF, ASheetIndex: Word;
AKind: TsBIFFExternKind); override;
procedure WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet);
procedure WriteEOF(AStream: TStream);
procedure WriteFont(AStream: TStream; AFont: TsFont);
@ -117,10 +118,6 @@ type
procedure WriteLABEL(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: string; ACell: PCell); override;
procedure WriteLocalLinkTable(AStream: TStream; AWorksheet: TsWorksheet);
(*
function WriteRPNCellAddress3D(AStream: TStream; ASheet, ARow, ACol: Cardinal;
AFlags: TsRelFlags): Word; override;
*)
function WriteRPNSheetIndex(AStream: TStream; ADocumentURL: String;
ASheet1, ASheet2: Integer): Word; override;
procedure WriteStringRecord(AStream: TStream; AString: String); override;
@ -482,14 +479,15 @@ begin
case RecordType of
INT_EXCEL_ID_BOF : ;
INT_EXCEL_ID_BOUNDSHEET : ReadBoundSheet(AStream);
INT_EXCEL_ID_CODEPAGE : ReadCodePage(AStream);
INT_EXCEL_ID_BOUNDSHEET : ReadBOUNDSHEET(AStream);
INT_EXCEL_ID_CODEPAGE : ReadCODEPAGE(AStream);
INT_EXCEL_ID_DEFINEDNAME : ReadDefinedName(AStream);
INT_EXCEL_ID_EOF : SectionEOF := True;
INT_EXCEL_ID_EXTERNSHEET : ReadExternSheet(AStream);
INT_EXCEL_ID_FONT : ReadFont(AStream);
INT_EXCEL_ID_FORMAT : ReadFormat(AStream);
INT_EXCEL_ID_PALETTE : ReadPalette(AStream);
INT_EXCEL_ID_EXTERNCOUNT : ReadEXTERNCOUNT(AStream, nil);
INT_EXCEL_ID_EXTERNSHEET : ReadEXTERNSHEET(AStream, nil);
INT_EXCEL_ID_FONT : ReadFONT(AStream);
INT_EXCEL_ID_FORMAT : ReadFORMAT(AStream);
INT_EXCEL_ID_PALETTE : ReadPALETTE(AStream);
INT_EXCEL_ID_PASSWORD : ReadPASSWORD(AStream);
INT_EXCEL_ID_PROTECT : ReadPROTECT(AStream);
INT_EXCEL_ID_XF : ReadXF(AStream);
@ -532,8 +530,8 @@ begin
INT_EXCEL_ID_COLINFO : ReadColInfo(AStream);
INT_EXCEL_ID_DEFCOLWIDTH : ReadDefColWidth(AStream);
INT_EXCEL_ID_EOF : SectionEOF := True;
INT_EXCEL_ID_EXTERNCOUNT : ReadEXTERNCOUNT(AStream);
INT_EXCEL_ID_EXTERNSHEET : ReadEXTERNSHEET(AStream);
INT_EXCEL_ID_EXTERNCOUNT : ReadEXTERNCOUNT(AStream, FWorksheet);
INT_EXCEL_ID_EXTERNSHEET : ReadEXTERNSHEET(AStream, FWorksheet);
INT_EXCEL_ID_FOOTER : ReadHeaderFooter(AStream, false);
INT_EXCEL_ID_FORMULA : ReadFormula(AStream);
INT_EXCEL_ID_HEADER : ReadHeaderFooter(AStream, true);
@ -653,12 +651,16 @@ procedure TsSpreadBIFF5Reader.ReadRPNSheetIndex(AStream: TStream;
var
idx: Int16;
s: String;
sheetList: TsBIFFExternSheetList;
sheet: TsWorksheet;
extsheet: TsBIFFExternSheet;
begin
ADocumentURL := '';
ASheet1 := -1;
ASheet2 := -1;
{ One-based index to EXTERNSHEET record. Negative to indicate a 3D reference.
{ One-based index to EXTERNSHEET record in the booklist.
Negative to indicate a 3D reference.
Positive to indicate an external reference }
idx := WordLEToN(AStream.ReadWord);
@ -668,31 +670,24 @@ begin
// Skip 8 unused bytes
AStream.Position := AStream.Position + 8;
// one-based index to first referenced sheet (-1 = deleted sheet)
idx := Int16(WordLEToN(AStream.ReadWord));
if idx <> -1 then begin
s := FExternSheets.Strings[idx-1];
ASheet1 := FWorkbook.GetWorksheetIndex(s);
end;
// zero-based index to first referenced sheet in workbook (-1 = deleted sheet)
ASheet1 := Int16(WordLEToN(AStream.ReadWord));
// one-based index to last referenced sheet (-1 = deleted sheet)
idx := WordLEToN(AStream.ReadWord);
if idx <> -1 then begin
s := FExternSheets.Strings[idx-1];
ASheet2 := FWorkbook.GetWorksheetIndex(s);
end;
// zero-based index to last referenced sheet in workbook (-1 = deleted sheet)
ASheet2 := WordLEToN(AStream.ReadWord);
end
else begin
{ *** External reference *** }
// Skip 12 unused byes
AStream.Position := AStream.Position + 12;
{ !!! NOT CLEAR IF THIS IS CORRECT .... !!! }
dec(idx); // 1-based index to 0-based index
s := FExternSheets[idx];
sheetlist := FLinkLists.GetLocalLinks(FWorksheet);
extSheet := sheetlist.Items[idx - 1]; // Convert 1-based to 0-based index
s := ConvertEncoding(extSheet.SheetName, FCodePage, encodingUTF8);
ADocumentURL := s;
// NOTE: THIS IS NOT COMPLETE !!!
// Skip 12 unused byes
AStream.Position := AStream.Position + 12;
end;
end;
@ -1447,32 +1442,45 @@ end;
Writes out a DEFINEDNAMES record
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF5Writer.WriteDefinedName(AStream: TStream;
AWorksheet: TsWorksheet; const AName: String; AIndexToREF: Word);
AWorksheet: TsWorksheet; const AName: String; AIndexToREF, ASheetIndex: Word;
AKind: TsBIFFExternKind);
procedure WriteRangeFormula(MemStream: TMemoryStream; ARange: TsCellRange;
AIndexToREF, ACounter: Word);
AIndexToREF, ASheetIndex, ACounter: Word);
var
sheetIdx: Integer;
idx: Word;
begin
Unused(AIndexToREF);
sheetIdx := FWorkbook.GetWorksheetIndex(AWorksheet);
{ Token for tArea3dR }
MemStream.WriteByte($3B);
{ 1-based sheet index, negative to indicate 3D reference }
MemStream.WriteWord(WordToLE(-(sheetIdx+1)));
if AKind = ebkInternal then begin
{ INTERNAL REFERENCE:
1-based sheet index, negative to indicate 3D reference }
idx := word(-int16(AIndexToRef + 1));
MemStream.WriteWord(WordToLE(idx));
{ 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!
MemStream.WriteWord(WordToLE(ASheetIndex));
{ Index to last reference worksheet }
MemStream.WriteWord(WordToLE(sheetIdx)); // THIS IS ONLY VALID FOR PRINTRANGE!
MemStream.WriteWord(WordToLE(ASheetIndex));
end
else
begin
{ EXTERNAL REFERENCE:
always positive, 1-based index to EXTERNSHEET record }
idx := AIndexToRef;
MemStream.WriteWord(WordToLE(idx));
{ 12 bytes not used }
MemStream.WriteDWord(0);
MemStream.WriteDWord(0);
MemStream.WriteDWord(0);
end;
{ First row index }
MemStream.WriteWord(WordToLE(ARange.Row1));
@ -1494,12 +1502,11 @@ procedure TsSpreadBIFF5Writer.WriteDefinedName(AStream: TStream;
var
memstream: TMemoryStream;
rng: TsCellRange;
j: Integer;
idx: Integer;
j: 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
@ -1507,7 +1514,7 @@ begin
for j := 0 to AWorksheet.PageLayout.NumPrintRanges-1 do
begin
rng := AWorksheet.PageLayout.PrintRange[j];
WriteRangeFormula(memstream, rng, AIndexToRef, j+1);
WriteRangeFormula(memstream, rng, AIndexToRef, ASheetIndex, j+1);
end;
end;
#07: begin
@ -1519,7 +1526,7 @@ begin
if rng.Col2 = UNASSIGNED_ROW_COL_INDEX then rng.Col2 := rng.Col1;
rng.Row1 := 0;
rng.Row2 := 65535;
WriteRangeFormula(memstream, rng, AIndexToRef, j);
WriteRangeFormula(memstream, rng, AIndexToRef, ASheetIndex, j);
inc(j);
end;
if AWorksheet.PageLayout.HasRepeatedRows then
@ -1529,14 +1536,12 @@ begin
if rng.Row2 = UNASSIGNED_ROW_COL_INDEX then rng.Row2 := rng.Row1;
rng.Col1 := 0;
rng.Col2 := 255;
WriteRangeFormula(memstream, rng, AIndexToRef, j);
WriteRangeFormula(memstream, rng, AIndexToRef, ASheetIndex, j);
end;
end;
else raise EFPSpreadsheetWriter.Create('Name not supported');
end; // case
idx := FWorkbook.GetWorksheetIndex(AWorksheet);
{ BIFF record header }
WriteBIFFHeader(AStream, INT_EXCEL_ID_DEFINEDNAME, 14 + Length(AName) + Word(memstream.Size));
@ -1553,10 +1558,10 @@ begin
AStream.WriteWord(WordToLE(memstream.Size));
{ Global name, otherwise index to EXTERNSHEET record (1-based) }
AStream.WriteWord(WordToLE(AIndexToREF+1));
AStream.WriteWord(WordToLE(AIndexToREF + 1));
{ Global name, otherwise index to sheet (1-based) }
AStream.WriteWord(WordToLE(idx+1));
AStream.WriteWord(WordToLE(ASheetIndex + 1));
{ Length of menu text }
AStream.WriteByte(0);
@ -1756,28 +1761,25 @@ end;
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF5Writer.WriteGlobalLinkTable(AStream: TStream);
var
L: TStringList;
i: Integer;
sheet: TsWorksheet;
globalLinks: TsBIFFExternSheetList;
sheetList: TsBIFFExternSheetList;
i: Integer;
begin
L := TStringList.Create;
try
for i := 0 to FWorkbook.GetWorksheetCount-1 do
begin
sheet := FWorkbook.GetWorksheetByIndex(i);
with sheet.PageLayout do
if (NumPrintRanges > 0) or HasRepeatedCols or HasRepeatedRows then
L.Add(sheet.Name);
end;
if L.Count = 0 then
{ collect the global links data }
CollectExternData;
{ get global link list }
globalLinks := FLinkLists.GetGlobalLinks;
if (globalLinks = nil) or (globalLinks.Count = 0) then
exit;
WriteEXTERNCOUNT(AStream, L.Count);
for i:=0 to L.Count-1 do
WriteEXTERNSHEET(AStream, L[i], true);
finally
L.Free;
end;
{ Write number of EXTERNSHEET records }
WriteEXTERNCOUNT(AStream, globalLinks.Count);
{ For each sheet write an EXTERNSHEET record. }
for i:=0 to globalLinks.Count-1 do
WriteEXTERNSHEET(AStream, globalLinks[i].SheetName, true);
end;
{@@ ----------------------------------------------------------------------------
@ -1914,36 +1916,32 @@ var
cell: PCell;
found: Boolean;
i, j, n: Integer;
sheetref: PsBIFFExternSheet;
book: TsBIFFExternBook;
sheet: TsWorksheet;
externSheetList: TsBIFFExternSheetList;
externsheet: TsBIFFExternSheet;
begin
CollectExternData(FWorksheet);
if (FExternBooks = nil) or (FExternSheets = nil) then
i := CollectExternData(AWorksheet);
if i = -1 then
exit;
if FLinkLists[i] = nil then
exit;
// Write the count of records in the local link table
n := FExternSheets.Count;
externSheetlist := TsBIFFLinkListItem(FLinkLists.Items[i]).SheetList;
if externSheetList = nil then
exit;
// Write the count of records to the local link table
n := externSheetList.Count;
WriteEXTERNCOUNT(AStream, word(n));
// Write a EXTERNSHEET record for each linked sheet
for i := 0 to n-1 do begin
sheetref := FExternSheets[i];
book := FExternBooks[sheetref^.ExternBookIndex];
if book.Kind = ebkInternal then
begin
for j := sheetref^.FirstSheetIndex to sheetref^.LastSheetIndex do
begin
sheet := FWorkbook.GetWorksheetByIndex(j);
if sheet = AWorksheet then
WriteEXTERNSHEET(AStream, '', true)
for i := 0 to externSheetList.Count-1 do begin
externSheet := externSheetList[i];
if externSheet.Kind = ebkInternal then
WriteEXTERNSHEET(AStream, externSheet.SheetName, true)
else
WriteEXTERNSHEET(AStream, sheet.Name, true);
end;
end else
begin
// Handle external links here
end;
;
end;
end;
(*
@ -1991,40 +1989,35 @@ function TsSpreadBIFF5Writer.WriteRPNSheetIndex(AStream: TStream;
ADocumentURL: String; ASheet1, ASheet2: Integer): Word;
var
p: Int64;
bookidx: Integer;
book: TsBIFFExternBook;
refidx: Integer;
sheetref: PsBIFFExternSheet;
externSheetList: TsBIFFExternSheetList;
externSheetIdx1, externSheetIdx2: Integer;
s: String;
begin
if ADocumentURL <> '' then // Supporting only internal links
exit;
p := AStream.Position;
// Find stored information on this link
bookidx := FExternBooks.FindBook(ADocumentURL);
refidx := FExternSheets.FindSheets(ADocumentURL, ASheet1, ASheet2);
sheetref := FExternSheets[refidx];
book := FExternBooks[sheetRef^.ExternBookIndex];
if book.Kind = ebkExternal then
exit($FFFF);
externSheetList := FLinkLists.GetLocalLinks(FWorksheet);
s := FWorkbook.GetWorksheetByIndex(ASheet1).Name;
externSheetIdx1 := externSheetList.IndexOfSheet(s);
if ASheet2 = -1 then
ASheet2 := ASheet1;
// One-based index of the EXTERNBOOK record to which this reference belongs.
// For internal references ("3D references") this must be written as a
// negative value.
AStream.WriteWord(WordToLE(word(-(bookidx+1))));
AStream.WriteWord(WordToLE(word(-(externSheetIdx1 + 1))));
// 8 unused bytes
AStream.WriteDWord(0);
AStream.WriteDWord(0);
AStream.WriteQWord(0);
// Zero-based index to first referenced sheet (FFFFH = deleted sheet)
// Zero-based index to first referenced sheet of the workbook (FFFFH = deleted sheet)
AStream.WriteWord(WordToLE(ASheet1));
// Single sheet reference
if ASheet2 < 0 then ASheet2 := ASheet1;
// Zero-based index to last referenced sheet (FFFFH = deleted sheet)
// Zero-based index to last referenced sheet of the workbook (FFFFH = deleted sheet)
AStream.WriteWord(WordToLE(ASheet2));
Result := AStream.Position - p;

View File

@ -64,6 +64,56 @@ uses
fpsutils;
type
{ TsBiff8ExternSheet - Information on sheets used in out-of-sheet references }
TsBIFF8ExternSheet = packed record
ExternBookIndex: Word;
FirstSheetIndex: Word;
LastSheetIndex: Word;
end;
PsBIFF8ExternSheet = ^TsBIFF8ExternSheet;
{ TsBIFF8ExternBook - Information on where out-of-sheet references are stored. }
TsBIFF8ExternBook = class
Kind: TsBIFFExternKind;
// The following fields are used only for external workbooks.
DocumentURL: String;
SheetNames: String; // List of worksheetnames separated by #1
function GetWorksheetName(AIndex: Integer): String;
end;
{ TsBIFF8ExternBookList }
TsBIFF8ExternBookList = class(TFPObjectlist)
private
function GetItem(AIndex: Integer): TsBIFF8ExternBook;
procedure SetItem(AIndex: Integer; AValue: TsBIFF8ExternBook);
public
function AddBook(ABookName: String; ASheetNames: TStrings): Integer;
function AddInternal: Integer;
function FindBook(ABookName: String): TsBIFF8ExternBook;
function FindInternalBook: TsBIFF8ExternBook;
function IndexOfBook(ABookName: String): Integer;
function IndexOfInternalbook: Integer;
property Items[AIndex: Integer]: TsBIFF8ExternBook read GetItem write SetItem; default;
end;
{ A list for sheets used in out-of-sheet references }
TsBIFF8ExternSheetList = class(TFPList)
private
FBookList: TsBIFF8ExternBookList;
function GetItem(AIndex: Integer): PsBIFF8ExternSheet;
procedure SetItem(AIndex: Integer; AValue: PsBIFF8ExternSheet);
public
constructor Create(ABookList: TsBIFF8ExternBookList);
destructor Destroy; override;
function AddInternalSheets(ASheetIndex1, ASheetIndex2: Integer): Integer;
function AddSheets(ABookName: String; ASheetNames: TStrings;
ASheetIndex1, ASheetIndex2: Integer): Integer;
procedure Clear;
function IndexOfSheets(ABookName: String; ASheetIndex1, ASheetIndex2: Integer): Integer;
property Item[AIndex: Integer]: PsBIFF8ExternSheet read GetItem write SetItem; default;
end;
{ TsSpreadBIFF8Reader }
TsSpreadBIFF8Reader = class(TsSpreadBIFFReader)
private
@ -73,8 +123,8 @@ type
FCommentPending: Boolean;
FCommentID: Integer;
FCommentLen: Integer;
FBiff8ExternBooks: TFPObjectList;
FBiff8ExternSheets: array of TsBiffExternSheet;
FBiff8ExternBooks: TsBiff8ExternBookList;
FBiff8ExternSheetArray: array of TsBiff8ExternSheet;
function ReadString(const AStream: TStream; const ALength: Word;
out ARichTextParams: TsRichTextParams): String;
function ReadUnformattedWideString(const AStream: TStream;
@ -89,7 +139,7 @@ type
procedure ReadCONTINUE(const AStream: TStream);
procedure ReadDEFINEDNAME(const AStream: TStream);
procedure ReadEXTERNBOOK(const AStream: TStream);
procedure ReadEXTERNSHEET(const AStream: TStream); virtual;
procedure ReadEXTERNSHEET(const AStream: TStream);
procedure ReadFONT(const AStream: TStream);
procedure ReadFORMAT(AStream: TStream); override;
procedure ReadHeaderFooter(AStream: TStream; AIsHeader: Boolean); override;
@ -137,8 +187,11 @@ type
private
FSharedStringTable: TStringList;
FNumStrings: DWord;
FBiff8ExternBooks: TsBIFF8ExternbookList;
FBiff8ExternSheets: TsBIFF8ExternSheetList;
private
procedure BeginCONTINUERecord(AStream: TStream; out ASizePos: Int64);
procedure CollectExternData;
procedure FixRecordSize(AStream: TStream; ASizePos: Int64; ASize: Word);
function WriteStringHelper(AStream: TStream; const AText: RawByteString;
const ARichTextParams: TsRichTextParams; Is8BitString: Boolean;
@ -159,10 +212,12 @@ type
procedure WriteComment(AStream: TStream; ACell: PCell); override;
procedure WriteComments(AStream: TStream; AWorksheet: TsWorksheet);
procedure WriteDefinedName(AStream: TStream; AWorksheet: TsWorksheet;
const AName: String; AIndexToREF: Word); override;
const AName: String; AIndexToREF, ASheetIndex: Word;
AKind: TsBIFFExternKind);
procedure WriteDefinedNames(AStream: TStream);
procedure WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet);
procedure WriteEOF(AStream: TStream);
procedure WriteEXTERNBOOK(AStream: TStream);
procedure WriteEXTERNBOOK(AStream: TStream; AUrl: String);
procedure WriteEXTERNSHEET(AStream: TStream);
procedure WriteFONT(AStream: TStream; AFont: TsFont);
procedure WriteFonts(AStream: TStream);
@ -189,10 +244,6 @@ type
out AContinueInString: Boolean): Boolean;
function WriteRPNCellAddress(AStream: TStream; ARow, ACol: Cardinal;
AFlags: TsRelFlags): word; override;
(*
function WriteRPNCellAddress3D(AStream: TStream; ASheet, ARow, ACol: Cardinal;
AFlags: TsRelFlags): Word; override;
*)
function WriteRPNCellOffset(AStream: TStream; ARowOffset, AColOffset: Integer;
AFlags: TsRelFlags): Word; override;
function WriteRPNCellRangeAddress(AStream: TStream; ARow1, ACol1, ARow2, ACol2: Cardinal;
@ -490,14 +541,235 @@ type
end;
procedure InitBIFF8Limitations(out ALimitations: TsSpreadsheetFormatLimitations);
{ -----------------------------------------------------------------------------}
{ TsBIFF8ExternBook }
{ -----------------------------------------------------------------------------}
function TsBIFF8ExternBook.GetWorksheetName(AIndex: Integer): String;
var
L: TStrings;
begin
InitBiffLimitations(ALimitations);
Result := '';
if Kind = ebkExternal then begin
L := TStringList.Create;
try
L.Delimiter := #1;
L.DelimitedText := SheetNames;
Result := L[AIndex];
finally
L.Free;
end;
end;
end;
{ TsSpreadBIFF8Reader }
{------------------------------------------------------------------------------}
{ TsBIFF8ExternBookList }
{------------------------------------------------------------------------------}
function TsBIFF8ExternBookList.AddBook(ABookName: String;
ASheetNames: TStrings): Integer;
var
book: TsBIFF8ExternBook;
s: String;
i: Integer;
begin
if ABookName = '' then
Result := AddInternal
else
begin
Result := IndexOfBook(ABookName);
if Result = -1 then begin
book := TsBIFF8ExternBook.Create;
book.DocumentURL := ABookName;
book.Kind := ebkExternal;
if ASheetNames.Count > 0 then begin
s := ASheetNames[0];
for i:=1 to ASheetNames.Count-1 do
s := s + #1 + ASheetNames[i];
book.SheetNames := s;
end;
Result := Add(book);
end;
end;
end;
function TsBIFF8ExternBookList.AddInternal: Integer;
var
book: TsBIFF8ExternBook;
begin
Result := IndexOfInternalBook;
if Result = -1 then begin
book := TsBIFF8ExternBook.Create;
book.Kind := ebkInternal;
Result := Add(book);
end;
end;
function TsBIFF8ExternBookList.FindBook(ABookName: String): TsBIFF8ExternBook;
var
idx: Integer;
begin
idx := IndexOfBook(ABookName);
if idx <> -1 then
Result := Items[idx]
else
Result := nil;
end;
function TsBIFF8ExternBookList.FindInternalBook: TsBIFF8ExternBook;
var
idx: Integer;
begin
idx := IndexOfInternalBook;
if idx <> -1 then
Result := Items[idx]
else
Result := nil;
end;
function TsBIFF8ExternBookList.GetItem(AIndex: Integer): TsBIFF8ExternBook;
begin
Result := TsBIFF8ExternBook(inherited Items[AIndex]);
end;
function TsBIFF8ExternBookList.IndexOfBook(ABookName: String): Integer;
var
book: TsBIFF8ExternBook;
begin
if ABookName = '' then
Result := IndexOfInternalBook
else
begin
for Result := 0 to Count-1 do
begin
book := Items[Result];
if (book.Kind = ebkExternal) and (book.DocumentURL = ABookName) then
exit;
end;
Result := -1;
end;
end;
function TsBIFF8ExternBookList.IndexOfInternalBook: Integer;
begin
for Result := 0 to Count-1 do
if Items[Result].Kind = ebkInternal then exit;
Result := -1;
end;
procedure TsBIFF8ExternBookList.SetItem(AIndex: Integer;
AValue: TsBIFF8ExternBook);
begin
inherited Items[AIndex] := AValue;
end;
{------------------------------------------------------------------------------}
{ TsBIFF8ExternSheetList }
{------------------------------------------------------------------------------}
constructor TsBIFF8ExternSheetList.Create(ABookList: TsBIFF8ExternBookList);
begin
inherited Create;
FBookList := ABookList;
end;
destructor TsBIFF8ExternSheetList.Destroy;
begin
Clear;
inherited;
end;
function TsBIFF8ExternSheetList.AddInternalSheets(
ASheetIndex1, ASheetIndex2: Integer): Integer;
begin
Result := AddSheets('', nil, ASheetIndex1, ASheetIndex2);
end;
function TsBIFF8ExternSheetList.AddSheets(ABookName: String;
ASheetNames: TStrings; ASheetIndex1, ASheetIndex2: Integer): Integer;
var
P: PsBIFF8ExternSheet;
idx: Integer;
begin
Result := IndexOfSheets(ABookName, ASheetIndex1, ASheetIndex2);
if Result = -1 then
begin
New(P);
idx := FBookList.IndexOfBook(ABookName);
if idx = -1 then
idx := FBookList.AddBook(ABookName, ASheetNames);
P^.ExternBookIndex := idx;
if ASheetIndex2 = -1 then
ASheetIndex2 := ASheetIndex1;
if ASheetIndex2 < ASheetIndex1 then
begin
P^.FirstSheetIndex := ASheetIndex2;
P^.LastSheetIndex := ASheetIndex1;
end else
begin
P^.FirstSheetIndex := ASheetIndex1;
P^.LastSheetIndex := ASheetIndex2;
end;
Result := Add(P);
end;
end;
procedure TsBIFF8ExternSheetList.Clear;
var
i: Integer;
P: PsBIFF8ExternSheet;
begin
for i:=0 to Count-1 do begin
P := Item[i];
Dispose(P);
end;
inherited;
end;
function TsBIFF8ExternSheetList.IndexOfSheets(ABookName: String;
ASheetIndex1, ASheetIndex2: Integer): Integer;
var
book: TsBIFF8ExternBook;
P: PsBIFF8ExternSheet;
tmp: Integer;
idx: Integer;
begin
if ASheetIndex2 = -1 then ASheetIndex2 := ASheetIndex1;
if ASheetIndex2 < ASheetIndex1 then begin
tmp := ASheetIndex1;
ASheetIndex1 := ASheetIndex2;
ASheetIndex2 := tmp;
end;
idx := FBookList.IndexOfBook(ABookName);
if idx = -1 then
exit(-1);
for Result := 0 to Count-1 do begin
P := Item[Result];
if (P^.ExternBookIndex = idx) and
(P^.FirstSheetIndex = ASheetIndex1) and
(P^.LastSheetIndex = ASheetIndex2)
then
exit;
end;
Result := -1;
end;
function TsBIFF8ExternSheetList.GetItem(AIndex: Integer): PsBIFF8ExternSheet;
begin
Result := PsBIFF8ExternSheet(inherited Items[AIndex]);
end;
procedure TsBIFF8ExternSheetList.SetItem(AIndex: Integer; AValue: PsBIFF8ExternSheet);
begin
inherited Items[AIndex] := AValue;
end;
{------------------------------------------------------------------------------}
{ TsSpreadBIFF8Reader }
{------------------------------------------------------------------------------}
constructor TsSpreadBIFF8Reader.Create(AWorkbook: TsWorkbook);
begin
inherited;
@ -508,9 +780,11 @@ destructor TsSpreadBIFF8Reader.Destroy;
var
j: Integer;
begin
SetLength(FBiff8ExternSheets, 0);
{ Destroy linked data }
SetLength(FBiff8ExternSheetArray, 0);
FBiff8ExternBooks.Free;
{ Destroy shared string table }
if Assigned(FSharedStringTable) then
begin
for j := FSharedStringTable.Count-1 downto 0 do
@ -1322,15 +1596,15 @@ end;
procedure TsSpreadBIFF8Reader.ReadRPNSheetIndex(AStream: TStream;
out ADocumentURL: String; out ASheet1, ASheet2: Integer);
var
refIndex: Word;
ref: TsBiffExternSheet;
book: TsBiffExternBook;
refIndex: Int16;
ref: TsBiff8ExternSheet;
book: TsBiff8ExternBook;
begin
// Index to REF entry in EXTERNSHEET record
refIndex := WordLEToN(AStream.ReadWord);
ref := FBiff8ExternSheets[refIndex];
book := FBiff8ExternBooks[ref.ExternBookIndex] as TsBiffExternBook;
ref := FBiff8ExternSheetArray[refIndex];
book := FBiff8ExternBooks[ref.ExternBookIndex] as TsBiff8ExternBook;
// Only links to internal sheets supported so far.
if book.Kind <> ebkInternal then
@ -1841,14 +2115,14 @@ var
i, n: Integer;
url: widestring;
sheetnames: widestring;
book: TsBiffExternbook;
book: TsBiff8Externbook;
p: Int64;
t: array[0..1] of byte = (0, 0);
begin
if FBiff8ExternBooks = nil then
FBiff8ExternBooks := TsBIFFExternBookList.Create(true);
FBiff8ExternBooks := TsBIFF8ExternBookList.Create(true);
book := TsBiffExternBook.Create;
book := TsBiff8ExternBook.Create;
// Count of sheets in book
n := WordLEToN(AStream.ReadWord);
@ -1897,11 +2171,11 @@ var
i: Integer;
begin
numItems := WordLEToN(AStream.ReadWord);
SetLength(FBiff8ExternSheets, numItems);
SetLength(FBiff8ExternSheetArray, numItems);
for i := 0 to numItems-1 do begin
AStream.ReadBuffer(FBiff8ExternSheets[i], Sizeof(FBiff8ExternSheets[i]));
with FBiff8ExternSheets[i] do
AStream.ReadBuffer(FBiff8ExternSheetArray[i], Sizeof(FBiff8ExternSheetArray[i]));
with FBiff8ExternSheetArray[i] do
begin
ExternBookIndex := WordLEToN(ExternBookIndex);
FirstSheetIndex := WordLEToN(FirstSheetIndex);
@ -2244,6 +2518,8 @@ end;
destructor TsSpreadBIFF8Writer.Destroy;
begin
FSharedStringTable.Free;
FBiff8ExternSheets.Free;
FBiff8ExternBooks.Free;
inherited;
end;
@ -2260,6 +2536,79 @@ begin
AStream.WriteWord(0);
end;
{@@ ----------------------------------------------------------------------------
Collects the data for out-of-sheet links found in the specified worksheet
(or all worksheets if the parameter is omitted).
The found data are written to the FExternBooks and FExternSheets lists.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.CollectExternData;
procedure DoCollectForSheet(ASheet: TsWorksheet);
var
cell: PCell;
parser: TsExpressionParser;
rpn: TsRPNFormula;
fe: TsFormulaElement;
j: Integer;
begin
for cell in ASheet.Cells do
begin
if not HasFormula(cell) then
Continue;
if not (cf3dFormula in cell^.Flags) then
Continue;
parser := TsSpreadsheetParser.Create(ASheet);
try
parser.Expression := cell^.FormulaValue;
rpn := parser.RPNFormula;
for j:=0 to High(rpn) do
begin
fe := rpn[j];
if fe.ElementKind in [fekCell3d, fekCellRef3d, fekCellRange3d] then
FBiff8ExternSheets.AddSheets('', nil, fe.Sheet, fe.Sheet2);
// FIXME: '' --> supporting only internal 3d links so far
end;
finally
parser.Free;
rpn := nil;
end;
end;
end;
var
sheet: TsWorksheet;
i: Integer;
writeIt: Boolean;
begin
if FBiff8ExternBooks <> nil then
raise Exception.Create('[TsSpreadBIFF8Writer.CollectExternData] Can be entered only once.');
FBiff8ExternBooks := TsBIFF8ExternBookList.Create;
FBiff8ExternSheets := TsBIFF8ExternSheetList.Create(FBiff8ExternBooks);
{ Add sheets used in print ranges, repeated cols or repeated rows }
for i:=0 to FWorkbook.GetWorksheetCount-1 do begin
sheet := FWorkbook.GetWorksheetByIndex(i);
with sheet.PageLayout do
writeIt := (NumPrintRanges > 0) or HasRepeatedCols or HasRepeatedRows;
if writeIt then
FBiff8ExternSheets.AddInternalSheets(i, i);
end;
{ Add sheets related to 3d references of all sheets }
for i:=0 to FWorkbook.GetWorksheetCount-1 do
begin
sheet := FWorkbook.GetWorksheetByIndex(i);
DoCollectForSheet(sheet);
end;
if FBiff8ExternSheets.Count = 0 then begin
FreeAndNil(FBiff8ExternSheets);
FreeAndNil(FBiff8ExternBooks);
end;
end;
{@@ ----------------------------------------------------------------------------
Sometimes the size of records is not known when writing them (see
BeginCONTINUERecord). This method rewinds the stream to the position where
@ -2344,7 +2693,7 @@ begin
for i := 0 to Workbook.GetWorksheetCount - 1 do
sheetPos[i] := WriteBoundsheet(AStream, Workbook.GetWorksheetByIndex(i));
WriteEXTERNBOOK(AStream);
WriteEXTERNBOOK(AStream, '');
WriteEXTERNSHEET(AStream);
WriteDefinedNames(AStream);
WriteSST(AStream);
@ -2661,7 +3010,8 @@ end;
Implements only the builtin defined names for print ranges and titles!
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteDefinedName(AStream: TStream;
AWorksheet: TsWorksheet; const AName: String; AIndexToREF: Word);
AWorksheet: TsWorksheet; const AName: String; AIndexToREF, ASheetIndex: Word;
AKind: TsBIFFExternKind);
procedure WriteRangeFormula(MemStream: TMemoryStream; ARange: TsCellRange;
AIndexToRef, ACounter: Word);
@ -2782,6 +3132,38 @@ begin
end;
end;
procedure TsSpreadBIFF8Writer.WriteDefinedNames(AStream: TStream);
var
externbook: TsBIFF8ExternBook;
bookIdx: Integer;
sheet: TsWorksheet;
i: Integer;
idx: Word;
extSheetIdx: Integer;
sheetList: TsBIFFExternSheetList;
begin
if (FBiff8ExternBooks = nil) or (FBiff8ExternSheets = nil) then
exit;
// Defined names in "internal" book only
bookIdx := FBiff8ExternBooks.IndexOfInternalbook;
for i:=0 to FWorkbook.GetWorksheetCount-1 do
begin
sheet := FWorkbook.GetWorksheetByIndex(i);
if (sheet.PageLayout.NumPrintRanges > 0) or
sheet.PageLayout.HasRepeatedCols or sheet.PageLayout.HasRepeatedRows then
begin
// idx := sheetList.IndexOfSheet(sheet.Name);
// Write 1-based index. And negate it to indicate an internal reference.
if sheet.PageLayout.NumPrintRanges > 0 then
WriteDefinedName(AStream, sheet, #6, bookIdx, i, ebkInternal);
if sheet.PageLayout.HasRepeatedCols or sheet.PageLayout.HasRepeatedRows then
WriteDefinedName(AStream, sheet, #7, bookIdx, i, ebkInternal);
end;
end;
end;
{@@ ----------------------------------------------------------------------------
Writes an Excel 8 DIMENSIONS record
@ -2829,41 +3211,47 @@ end;
NOTE: This writes only the case for "internal references" required for print
ranges and titles.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteEXTERNBOOK(AStream: TStream);
procedure TsSpreadBIFF8Writer.WriteEXTERNBOOK(AStream: TStream; AUrl: string);
begin
if (FExternBooks = nil) or (FExternBooks.Count = 0) then
if (FBiff8ExternBooks = nil) or (FBiff8ExternBooks.Count = 0) then
exit;
{ BIFF record header }
WriteBIFFHeader(AStream, INT_EXCEL_ID_EXTERNBOOK, 4);
// To do: When external books are activated then the "4" must be replaced !!!
{ Current workbook -- assuming that it has index 0 in list FExternBook8 }
if AUrl = '' then begin
{ Number of sheets in this workbook }
AStream.WriteWord(WordToLE(FWorkbook.GetWorksheetCount));
{ Relict from BIFF5 }
AStream.WriteWord(WordToLE($0401));
end else
raise Exception.Create('[WriteEXTERNBOOK] External books not supported.');
end;
{@@ ----------------------------------------------------------------------------
Writes an EXTERNSHEET record needed for defined names and links.
NOTE: This writes only what is required for print ranges and titles.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteEXTERNSHEET(AStream: TStream);
var
n, i: Integer;
sheetRef: PsBIFFExternSheet;
book: TsBIFFExternBook;
sheetRef: PsBIFF8ExternSheet;
book: TsBIFF8ExternBook;
begin
if (FExternSheets = nil) or (FExternBooks = nil) then
if (FBiff8ExternSheets = nil) or (FBiff8ExternBooks = nil) then
exit;
{ Count the following REF structures }
{ We support only internal links. Once external links are supported the
following code probably can be dropped. }
n := 0;
for i := 0 to FExternSheets.Count-1 do begin
sheetRef := FExternSheets[i];
book := FExternBooks[sheetRef^.ExternBookIndex];
for i := 0 to FBiff8ExternSheets.Count-1 do begin
sheetRef := FBiff8ExternSheets[i];
book := FBiff8ExternBooks[sheetRef^.ExternBookIndex];
if (book.Kind = ebkInternal) then inc(n);
end;
@ -2873,9 +3261,9 @@ begin
{ Write the determined count of REF structures }
AStream.WriteWord(WordToLE(n));
for i:= 0 to FExternSheets.Count-1 do begin
sheetRef := FExternSheets[i];
book := FExternBooks[sheetRef^.ExternBookIndex];
for i:= 0 to FBiff8ExternSheets.Count-1 do begin
sheetRef := FBiff8ExternSheets[i];
book := FBiff8ExternBooks[sheetRef^.ExternBookIndex];
if (book.Kind = ebkInternal) then
begin
AStream.WriteWord(WordToLE(sheetRef^.ExternBookIndex));
@ -2885,94 +3273,6 @@ begin
end;
end;
(*
{ Since sheet range are not supported we simply note every sheet here. }
n := FWorkbook.GetWorksheetCount;
{ BIFF record header }
WriteBIFFHeader(AStream, INT_EXCEL_ID_EXTERNSHEET, 2 + 6*n);
{ Count of following REF structures }
AStream.WriteWord(WordToLE(n));
{ REF record for each sheet }
for i := 0 to n-1 do
begin
AStream.WriteWord(0); // Index to EXTERNBOOK record, always 0
AStream.WriteWord(WordToLE(i)); // Index to first sheet in EXTERNBOOK sheet list
AStream.WriteWord(WordToLE(i)); // Index to last sheet in EXTERNBOOK sheet list
end;
end;
*)
(*
write a record for
// every sheet
type
TExternRefRec = record
FirstIndex, LastIndex: Word;
end;
const
BUF_COUNT = 10;
var
extern: Array of TExternRefRec;
sheet: TsWorksheet;
cell: PCell;
i, j: Integer;
n: Word;
writeIt: Boolean;
begin
n := 0;
SetLength(extern, BUF_COUNT);
// Find sheets used in formula references
for i:=0 to FWorkBook.GetWorksheetCount-1 do begin
sheet := FWorkBook.GetWorksheetByIndex(i);
for cell in sheet.Cells do
if HasFormula(cell) then
if pos('!', cell^.FormulaValue) > 0 then
for j:=0 to FWorkbook.GetWorksheetCount-1 do
if pos(FWorksbook.GetWorksheetByIndex(j).Name, cell1.FormulaValue) = 1 then begin
extern[n].FirstIndex := j;
extern[n].LastIndex := j;
// NOTE: This must be extended to allow a range of sheets !!!
inc(n);
if n mod BUF_COUNT = 0 then
Setlength(extern, Length(extern) + BUF_COUNT);
end;
end;
// Find sheets used in print ranges, repeated cols or repeated rows
for i:=0 to FWorkbook.GetWorksheetCount-1 do begin
sheet := FWorkbook.GetWorksheetbyIndex(i);
with sheet.PageLayout do
writeIt := (NumPrintRanges > 0) or HasRepeatedCols or HasRepeatedRows;
if writeIt then begin
extern[n].FirstIndex := i;
extern[n].LastIndex := i;
inc(n);
if n mod BUF_COUNT = 0 then
SetLength(extern, Length(extern) + BUF_COUNT);
end;
end;
SetLength(extern, n);
{ BIFF record header }
WriteBIFFHeader(AStream, INT_EXCEL_ID_EXTERNSHEET, 2 + 6*n);
{ Count of following REF structures }
AStream.WriteWord(WordToLE(n));
{ REF record for each sheet }
for i := 0 to n-1 do
begin
AStream.WriteWord(0); // Index to EXTERNBOOK record, always 0
AStream.WriteWord(WordToLE(extern[i])); // Index to first sheet in EXTERNBOOK sheet list
AStream.WriteWord(WordToLE(extern[i])); // Index to last sheet in EXTERNBOOK sheet list
end;
end; *)
{@@ ----------------------------------------------------------------------------
Writes an Excel 8 FONT record.
@ -3820,9 +4120,9 @@ function TsSpreadBIFF8Writer.WriteRPNSheetIndex(AStream: TStream;
var
idx: Integer;
begin
idx := FExternSheets.FindSheets(ADocumentURL, ASheet1, ASheet2);
idx := FBiff8ExternSheets.IndexOfSheets(ADocumentURL, ASheet1, ASheet2);
if idx = -1 then
Result := $FFFE
Result := $FFFE // E at the end: sheets not found
else begin
AStream.WriteWord(WordToLE(word(idx)));
Result := 2;
@ -4714,6 +5014,15 @@ begin
end;
{------------------------------------------------------------------------------}
{ Global utilities }
{------------------------------------------------------------------------------}
procedure InitBIFF8Limitations(out ALimitations: TsSpreadsheetFormatLimitations);
begin
InitBiffLimitations(ALimitations);
end;
initialization
// Registers this reader / writer in fpSpreadsheet

View File

@ -334,6 +334,8 @@ const
ROWHEIGHT_EPS = 1E-2;
type
TsBIFFExternKind = (ebkExternal, ebkInternal, ebkAddInFunc, ebkDDE_OLE);
TDateMode = (dm1900, dm1904); //DATEMODE values, 5.28
// Adjusts Excel float (date, date/time, time) with the file's base date to get a TDateTime
@ -379,50 +381,39 @@ type
property ValidOnSheet: Integer read FValidOnSheet;
end;
{ TsExternBook - Information on where out-of-sheet references are stored. }
TsBIFFExternBookKind = (ebkExternal, ebkInternal, ebkAddInFunc, ebkDDE_OLE);
TsBIFFExternBook = class
Kind: TsBIFFExternBookKind;
// The following fields are used only for external workbooks.
DocumentURL: String;
SheetNames: String; // List of worksheetnames separated by #1
function GetWorksheetName(AIndex: Integer): String;
end;
{ TsBIFFExternBookList }
TsBIFFExternBookList = class(TFPObjectlist)
{ TsBIFFExternBook - Information on where out-of-sheet references are stored. }
TsBIFFExternSheet = class
private
function GetItem(AIndex: Integer): TsBIFFExternBook;
procedure SetItem(AIndex: Integer; AValue: TsBIFFExternBook);
FKind: TsBIFFExternKind;
FSheetName: String;
public
function AddBook(ABookName: String): Integer;
function AddInternal: Integer;
function FindBook(ABookName: String): Integer;
function FindInternalBook: Integer;
property Item[AIndex: Integer]: TsBIFFExternBook read GetItem write SetItem; default;
constructor Create(ASheetName: String; AKind: TsBIFFExternKind);
property Kind: TsBIFFExternKind read FKind;
property SheetName: String read FSheetName;
end;
{ TsExternSheet - Information on a sheets used in out-of-sheet references }
TsBIFFExternSheet = packed record
ExternBookIndex: Word;
FirstSheetIndex: Word;
LastSheetIndex: Word;
end;
PsBIFFExternSheet = ^TsBIFFExternSheet;
{ A list for sheets used in out-of-sheet references }
TsBIFFExternSheetList = class(TFPList)
TsBIFFExternSheetList = class(TFPObjectList)
private
FBookList: TsBIFFExternBookList;
function GetItem(AIndex: Integer): PsBIFFExternSheet;
procedure SetItem(AIndex: Integer; AValue: PsBIFFExternSheet);
function GetItem(AIndex: Integer): TsBIFFExternSheet;
procedure SetItem(AIndex: Integer; AValue: TsBIFFExternSheet);
public
constructor Create(ABookList: TsBIFFExternBookList);
function AddSheet(ASheetName: String; AKind: TsBIFFExternKind): Integer;
function FindSheet(ASheetName: String): TsBIFFExternSheet;
function IndexOfSheet(ASheetName: String): Integer;
property Items[AIndex: Integer]: TsBIFFExternSheet read GetItem write SetItem; default;
end;
TsBIFFLinkListItem = class
Worksheet: TsWorksheet;
Sheetlist: TsBIFFExternSheetList;
destructor Destroy; override;
function AddSheets(ABookName: String; ASheetIndex1, ASheetIndex2: Integer): Integer;
procedure Clear;
function FindSheets(ABookName: String; ASheetIndex1, ASheetIndex2: Integer): Integer;
property Item[AIndex: Integer]: PsBIFFExternSheet read GetItem write SetItem; default;
end;
TsBIFFLinkLists = class(TFPObjectList)
public
function GetSheetList(AWorksheet: TsWorksheet): TsBiffExternSheetList;
function GetGlobalLinks: TsBiffExternSheetList;
function GetLocalLinks(AWorksheet: TsWorksheet): TsBiffExternSheetList;
end;
@ -437,11 +428,11 @@ type
FIncompleteNoteLength: Word;
FFirstNumFormatIndexInFile: Integer;
FPalette: TsPalette;
FDefinedNames: TFPList;
FDefinedNames: TFPObjectList;
FWorksheetData: TFPList;
FCurSheetIndex: Integer;
FActivePane: Integer;
FExternSheets: TStrings;
FLinkLists: TsBIFFLinkLists;
procedure AddBuiltinNumFormats; override;
procedure ApplyCellFormatting(ACell: PCell; XFIndex: Word); virtual;
@ -483,9 +474,9 @@ type
// Read the default row height
procedure ReadDefRowHeight(AStream: TStream);
// Read an EXTERNCOUNT record
procedure ReadEXTERNCOUNT(AStream: TStream);
procedure ReadEXTERNCOUNT(AStream: TStream; AWorksheet: TsWorksheet);
// Read an EXTERNSHEET record (defined names)
procedure ReadEXTERNSHEET(AStream: TStream); virtual;
procedure ReadEXTERNSHEET(AStream: TStream; AWorksheet: TsWorksheet);
// Read FORMAT record (cell formatting)
procedure ReadFormat(AStream: TStream); virtual;
// Read FORMULA record
@ -575,11 +566,10 @@ type
FCodePage: String; // in a format prepared for lconvencoding.ConvertEncoding
FFirstNumFormatIndexInFile: Integer;
FPalette: TsPalette;
FExternBooks: TsBIFFExternBookList;
FExternSheets: TsBIFFExternSheetList;
FLinkLists: TsBiffLinkLists;
procedure AddBuiltinNumFormats; override;
procedure CollectExternData(AWorksheet: TsWorksheet = nil);
function CollectExternData(AWorksheet: TsWorksheet = nil): Integer;
function FindXFIndex(AFormatIndex: Integer): Integer; virtual;
function FixLineEnding(const AText: String): String;
function FormulaSupported(ARPNFormula: TsRPNFormula; out AUnsupported: String): Boolean;
@ -619,7 +609,8 @@ type
procedure WriteDefaultRowHeight(AStream: TStream; AWorksheet: TsWorksheet);
// Writes out DEFINEDNAMES records
procedure WriteDefinedName(AStream: TStream; AWorksheet: TsWorksheet;
const AName: String; AIndexToREF: Word); virtual;
const AName: String; AIndexToREF, ASheetIndex: Word;
AKind: TsBIFFExternKind); virtual;
procedure WriteDefinedNames(AStream: TStream);
// Writes out ERROR cell record
procedure WriteError(AStream: TStream; const ARow, ACol: Cardinal;
@ -959,194 +950,107 @@ end;
{ -----------------------------------------------------------------------------}
{ TsBIFFExternBook }
{ TsBIFFExternSheet }
{ -----------------------------------------------------------------------------}
function TsBIFFExternBook.GetWorksheetName(AIndex: Integer): String;
var
L: TStrings;
begin
Result := '';
if Kind = ebkExternal then begin
L := TStringList.Create;
try
L.Delimiter := #1;
L.DelimitedText := SheetNames;
Result := L[AIndex];
finally
L.Free;
end;
end;
end;
{------------------------------------------------------------------------------}
{ TsBIFFExternBookList }
{------------------------------------------------------------------------------}
function TsBIFFExternBookList.AddBook(ABookName: String): Integer;
var
book: TsBIFFExternBook;
begin
if ABookName = '' then
Result := AddInternal
else
begin
Result := FindBook(ABookName);
if Result = -1 then begin
book := TsBIFFExternBook.Create;
book.DocumentURL := ABookName;
book.Kind := ebkExternal;
Result := Add(book);
end;
end;
end;
function TsBIFFExternBookList.AddInternal: Integer;
var
book: TsBIFFExternBook;
begin
Result := FindInternalBook;
if Result = -1 then begin
book := TsBIFFExternBook.Create;
book.Kind := ebkInternal;
Result := Add(book);
end;
end;
function TsBIFFExternBookList.FindBook(ABookName: String): Integer;
var
book: TsBIFFExternBook;
begin
if ABookName = '' then
Result := FindInternalBook
else
begin
for Result:=0 to Count-1 do
begin
book := Item[Result];
if (book.Kind = ebkExternal) and (book.DocumentURL = ABookName) then
exit;
end;
Result := -1;
end;
end;
function TsBIFFExternBookList.FindInternalBook: Integer;
begin
for Result := 0 to Count-1 do
if Item[Result].Kind = ebkInternal then exit;
Result := -1;
end;
function TsBIFFExternBookList.GetItem(AIndex: Integer): TsBIFFExternBook;
begin
Result := TsBIFFExternBook(inherited Items[AIndex]);
end;
procedure TsBIFFExternBookList.SetItem(AIndex: Integer;
AValue: TsBIFFExternBook);
begin
inherited Items[AIndex] := AValue;
end;
{------------------------------------------------------------------------------}
{ TsBiffExternSheetList }
{------------------------------------------------------------------------------}
constructor TsBIFFExternSheetList.Create(ABookList: TsBIFFExternBookList);
constructor TsBIFFExternSheet.Create(ASheetName: string;
AKind: TsBiffExternKind);
begin
inherited Create;
FBookList := ABookList;
FSheetName := ASheetName;
FKind := AKind;
end;
destructor TsBIFFExternSheetList.Destroy;
begin
Clear;
inherited;
end;
function TsBIFFExternSheetList.AddSheets(ABookName: String;
ASheetIndex1, ASheetIndex2: Integer): Integer;
{ -----------------------------------------------------------------------------}
{ TsBIFFExternSheetList }
{ -----------------------------------------------------------------------------}
function TsBIFFExternSheetList.AddSheet(ASheetName: String;
AKind: TsBIFFExternKind): Integer;
var
sheet: TsBIFFExternSheet;
begin
Result := IndexOfSheet(ASheetName);
if Result = -1 then begin
sheet := TsBIFFExternSheet.Create(ASheetName, AKind);
Result := inherited Add(sheet);
end;
end;
function TsBIFFExternSheetList.FindSheet(ASheetName: string): TsBIFFExternSheet;
var
P: PsBIFFExternSheet;
idx: Integer;
begin
Result := FindSheets(ABookName, ASheetIndex1, ASheetIndex2);
if Result = -1 then
begin
New(P);
idx := FBookList.FindBook(ABookName);
if idx = -1 then
idx := FBookList.AddBook(ABookName);
P^.ExternBookIndex := idx;
if ASheetIndex2 = -1 then
ASheetIndex2 := ASheetIndex1;
if ASheetIndex2 < ASheetIndex1 then
begin
P^.FirstSheetIndex := ASheetIndex2;
P^.LastSheetIndex := ASheetIndex1;
end else
begin
P^.FirstSheetIndex := ASheetIndex1;
P^.LastSheetIndex := ASheetIndex2;
end;
Result := Add(P);
end;
idx := IndexOfSheet(ASheetName);
if idx <> -1 then
Result := Items[idx]
else
Result := nil;
end;
procedure TsBIFFExternSheetList.Clear;
var
i: Integer;
P: PsBIFFExternSheet;
function TsBIFFExternSheetList.GetItem(AIndex: Integer): TsBIFFExternSheet;
begin
for i:=0 to Count-1 do begin
P := Item[i];
Dispose(P);
end;
inherited;
Result := TsBIFFExternSheet(inherited Items[AIndex]);
end;
function TsBIFFExternSheetList.FindSheets(ABookName: String;
ASheetIndex1, ASheetIndex2: Integer): Integer;
function TsBIFFExternSheetList.IndexOfSheet(ASheetName: string): Integer;
var
book: TsBIFFExternBook;
P: PsBIFFExternSheet;
tmp: Integer;
idx: Integer;
sheet: TsBIFFExternSheet;
begin
if ASheetIndex2 = -1 then ASheetIndex2 := ASheetIndex1;
if ASheetIndex2 < ASheetIndex1 then begin
tmp := ASheetIndex1;
ASheetIndex1 := ASheetIndex2;
ASheetIndex2 := tmp;
end;
idx := FBookList.FindBook(ABookName);
if idx = -1 then
exit(-1);
for Result:=0 to Count-1 do begin
P := Item[Result];
if (P^.ExternBookIndex = idx) and
(P^.FirstSheetIndex = ASheetIndex1) and
(P^.LastSheetIndex = ASheetIndex2)
then
for Result := 0 to Count-1 do begin
sheet := GetItem(Result);
if sheet.SheetName = ASheetName then
exit;
end;
Result := -1;
end;
function TsBIFFExternSheetList.GetItem(AIndex: Integer): PsBIFFExternSheet;
begin
Result := PsBIFFExternSheet(inherited Items[AIndex]);
end;
procedure TsBIFFExternSheetList.SetItem(AIndex: Integer; AValue: PsBIFFExternSheet);
procedure TsBIFFExternSheetList.SetItem(AIndex: Integer;
AValue: TsBIFFExternSheet);
begin
inherited Items[AIndex] := AValue;
end;
{------------------------------------------------------------------------------}
{ TsBIFFLinkListItem }
{------------------------------------------------------------------------------}
destructor TsBIFFLinkListItem.Destroy;
begin
SheetList.Free;
inherited;
end;
{------------------------------------------------------------------------------}
{ TsBIFFLinkLists }
{------------------------------------------------------------------------------}
function TsBIFFLinkLists.GetSheetList(
AWorksheet: TsWorksheet): TsBiffExternSheetList;
var
i: Integer;
item: TsBIFFLinkListItem;
begin
for i := 0 to Count-1 do begin
item := TsBIFFLinkListItem(Items[i]);
if item.Worksheet = AWorksheet then begin
Result := item.SheetList;
exit;
end;
end;
Result := nil;
end;
function TsBIFFLinkLists.GetGlobalLinks: TsBIFFExternSheetList;
begin
Result := GetSheetList(nil);
end;
function TsBIFFLinkLists.GetLocalLinks(
AWorksheet: TsWorksheet): TsBIFFExternSheetList;
begin
Result := GetSheetList(AWorksheet);
end;
{------------------------------------------------------------------------------}
{ TsBIFFDefinedName }
@ -1231,7 +1135,8 @@ begin
FCellFormatList := TsCellFormatList.Create(true);
// true = allow duplicates! XF indexes get out of sync if not all format records are in list
FDefinedNames := TFPList.Create;
FLinkLists := TsBIFFLinkLists.Create;
FDefinedNames := TFPObjectList.Create;
// Initial base date in case it won't be read from file
FDateMode := dm1900;
@ -1247,13 +1152,9 @@ end;
Destructor of the reader class
-------------------------------------------------------------------------------}
destructor TsSpreadBIFFReader.Destroy;
var
j: Integer;
begin
for j:=0 to FDefinedNames.Count-1 do TObject(FDefinedNames[j]).Free;
FDefinedNames.Free;
FExternSheets.Free;
FLinkLists.Free;
FPalette.Free;
inherited Destroy;
@ -1857,12 +1758,19 @@ begin
FWorksheet.WriteDefaultRowHeight(TwipsToPts(hw), suPoints);
end;
procedure TsSpreadBIFFReader.ReadEXTERNCOUNT(AStream: TStream);
procedure TsSpreadBIFFReader.ReadEXTERNCOUNT(AStream: TStream;
AWorksheet: TsWorksheet);
var
item: TsBIFFLinkListItem;
begin
AStream.ReadWord;
{ We ignore the value of the record, but use the presence of the record
to create the FExternSheets list. }
FExternSheets := TStringList.Create;
to create the link list item. The data themselves follow in the next
record. }
item := TsBIFFLinkListItem.Create;
item.Worksheet := AWorksheet;
item.Sheetlist := TsBIFFExternSheetList.Create;
FLinkLists.Add(item);
end;
{@@ ----------------------------------------------------------------------------
@ -1875,12 +1783,18 @@ end;
NOTE: The string length field is decreased by 1, if the EXTERNSHEET stores
a reference to one of the own sheets (first character is #03).
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFReader.ReadExternSheet(AStream: TStream);
procedure TsSpreadBIFFReader.ReadEXTERNSHEET(AStream: TStream;
AWorksheet: TsWorksheet);
var
len, b: Byte;
ansistr: AnsiString;
s: String;
sheetlist: TsBIFFExternSheetList;
sheet: TsBIFFExternSheet;
idx: Integer;
begin
sheetList := FLinkLists.GetSheetList(AWorksheet);
len := AStream.ReadByte;
b := AStream.ReadByte;
if b = 3 then
@ -1888,9 +1802,16 @@ begin
SetLength(ansistr, len);
AStream.ReadBuffer(ansistr[2], len-1);
Delete(ansistr, 1, 1);
// ansistr[1] := char(b);
s := ConvertEncoding(ansistr, FCodePage, encodingUTF8);
FExternSheets.AddObject(s, TObject(PtrInt(b)));
if b = 3 then
{ Internal (within-workbook) references }
sheetList.AddSheet(s, ebkInternal)
else
begin
{ External references }
// to do: implement external references
end;
end;
{@@ ----------------------------------------------------------------------------
@ -3435,12 +3356,14 @@ begin
// Color palette
FPalette := TsPalette.Create;
PopulatePalette(AWorkbook);
{ List for external links }
FLinkLists := TsBIFFLinkLists.Create;
end;
destructor TsSpreadBIFFWriter.Destroy;
begin
FExternSheets.Free;
FExternBooks.Free;
FLinkLists.Free;
FPalette.Free;
inherited Destroy;
end;
@ -3475,18 +3398,22 @@ end;
{@@ ----------------------------------------------------------------------------
Collects the data for out-of-sheet links found in the specified worksheet
(or all worksheets if the parameter is omitted).
The found data are written to the FExternBooks and FExternSheets lists.
The found data are written to the a TBIFFLinkListItem which is added to
FLinkLists. The function returns the index of the new TBIFFLinkListItem.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFWriter.CollectExternData(AWorksheet: TsWorksheet = nil);
function TsSpreadBIFFWriter.CollectExternData(AWorksheet: TsWorksheet = nil): Integer;
procedure DoCollectForSheet(ASheet: TsWorksheet);
procedure DoCollectForSheet(ASheet: TsWorksheet; ASheetList: TsBIFFExternSheetList);
var
cell: PCell;
workbook: TsWorkbook;
parser: TsExpressionParser;
rpn: TsRPNFormula;
fe: TsFormulaElement;
j: Integer;
i, j: Integer;
kind: TsBIFFExternKind;
begin
workbook := ASheet.Workbook;
for cell in ASheet.Cells do
begin
if not HasFormula(cell) then
@ -3494,15 +3421,28 @@ procedure TsSpreadBIFFWriter.CollectExternData(AWorksheet: TsWorksheet = nil);
if not (cf3dFormula in cell^.Flags) then
Continue;
if (pos('[', ASheet.Name) = 0) then
kind := ebkInternal
else
kind := ebkExternal;
parser := TsSpreadsheetParser.Create(ASheet);
try
parser.Expression := cell^.FormulaValue;
rpn := parser.RPNFormula;
for j:=0 to High(rpn) do
for i:=0 to High(rpn) do
begin
fe := rpn[j];
if fe.ElementKind in [fekCell3d, fekCellRef3d, fekCellRange3d] then
FExternSheets.AddSheets('', fe.Sheet, fe.Sheet2); // '' --> supporting only internal 3d links so far
fe := rpn[i];
if fe.ElementKind in [fekCell3d, fekCellRef3d, fekCellRange3d] then begin
if fe.Sheet = -1 then
ASheetList.AddSheet(ASheet.Name, kind)
else
if fe.Sheet2 = -1 then
ASheetList.AddSheet(workbook.GetWorksheetByIndex(fe.Sheet).Name, kind)
else
for j :=fe.Sheet to fe.Sheet2 do
ASheetList.AddSheet(workbook.GetWorksheetbyIndex(j).Name, kind);
end;
end;
finally
parser.Free;
@ -3514,24 +3454,37 @@ procedure TsSpreadBIFFWriter.CollectExternData(AWorksheet: TsWorksheet = nil);
var
sheet: TsWorksheet;
i: Integer;
writeIt: boolean;
linkList: TsBIFFLinkListItem;
begin
FExternBooks.Free;
FExternBooks := TsBIFFExternBookList.Create;
FExternSheets.Free;
FExternSheets := TsBIFFExternSheetList.Create(FExternBooks);
linkList := TsBIFFLinkListItem.Create;
linkList.SheetList := TsBIFFExternSheetList.Create;
if AWorksheet <> nil then
DoCollectForSheet(AWorksheet)
else
begin
{ This part is active when called from WriteLocalLinkList }
linklist.Worksheet := AWorksheet;
DoCollectForSheet(AWorksheet, linklist.SheetList)
end else
begin
{ This part is active when called from WriteGlobalLinkList }
{ Find sheets used in print ranges, repeated cols or repeated rows }
linkList.Worksheet := nil; // signals global linklist
for i:=0 to FWorkbook.GetWorksheetCount-1 do
begin
sheet := FWorkbook.GetWorksheetbyIndex(i);
DoCollectForSheet(sheet);
with sheet.PageLayout do
writeIt := (NumPrintRanges > 0) or HasRepeatedCols or HasRepeatedRows;
if writeIt then
linkList.SheetList.AddSheet(sheet.Name, ebkInternal);
end;
end;
if FExternSheets.Count = 0 then begin
FreeAndNil(FExternSheets);
FreeAndNil(FExternBooks);
if linkList.SheetList.Count <> 0 then
Result := FLinkLists.Add(linklist)
else begin
linkList.Free; // destroys booklist, too.
Result := -1;
end;
end;
@ -3998,10 +3951,12 @@ begin
end;
procedure TsSpreadBIFFWriter.WriteDefinedName(AStream: TStream;
AWorksheet: TsWorksheet; const AName: String; AIndexToREF: Word);
AWorksheet: TsWorksheet; const AName: String; AIndexToREF, ASheetIndex: Word;
AKind: TsBIFFExternKind);
begin
Unused(AStream, AWorksheet);
Unused(Aname, AIndexToREF);
Unused(AKind);
// Override
end;
@ -4009,20 +3964,28 @@ procedure TsSpreadBIFFWriter.WriteDefinedNames(AStream: TStream);
var
sheet: TsWorksheet;
i: Integer;
n: Word;
idx: Word;
extSheetIdx: Integer;
sheetList: TsBIFFExternSheetList;
begin
n := 0;
{ Find sheetlist of global link table }
sheetList := FLinkLists.GetGlobalLinks;
if sheetList = nil then
exit;
for i:=0 to FWorkbook.GetWorksheetCount-1 do
begin
sheet := FWorkbook.GetWorksheetByIndex(i);
extSheetIdx := sheetList.IndexOfSheet(sheet.Name);
if (sheet.PageLayout.NumPrintRanges > 0) or
sheet.PageLayout.HasRepeatedCols or sheet.PageLayout.HasRepeatedRows then
begin
// idx := sheetList.IndexOfSheet(sheet.Name);
// Write 1-based index. And negate it to indicate an internal reference.
if sheet.PageLayout.NumPrintRanges > 0 then
WriteDefinedName(AStream, sheet, #6, n);
WriteDefinedName(AStream, sheet, #6, extSheetIdx, i, ebkInternal);
if sheet.PageLayout.HasRepeatedCols or sheet.PageLayout.HasRepeatedRows then
WriteDefinedName(AStream, sheet, #7, n);
inc(n);
WriteDefinedName(AStream, sheet, #7, extSheetIdx, i, ebkInternal);
end;
end;
end;
@ -5040,6 +5003,8 @@ begin
n := WriteRPNSheetIndex(AStream, '', AFormula[i].Sheet, AFormula[i].Sheet2);
if n = $FFFF then
FWorkbook.AddErrorMsg('3D cell addresses are not supported.')
else if n = $FFFE then
raise Exception.Create('[TsSpreadBIFFWriter.WriteRPNTokenArray] Worksheet(s) not found.')
else begin
inc(n, WriteRPNCellAddress(AStream, AFormula[i].Row, AFormula[i].Col, AFormula[i].RelFlags));
inc(RPNLength, n);
@ -5062,8 +5027,8 @@ begin
n := WriteRPNSheetIndex(AStream, '', AFormula[i].Sheet, AFormula[i].Sheet2);
if n = $FFFF then
FWorkbook.AddErrorMsg('3D cell address ranges are not supported.')
else if n = $FFF3 then
FWorkbook.AddErrorMsg('Sheets not found in LinkTable.')
else if n = $FFFE then
raise Exception.Create('[TsSpreadBIFFWriter.WriteRPNTokenArray] Worksheet(s) not found.')
else begin
inc(n, WriteRPNCellRangeAddress(AStream,
AFormula[i].Row, AFormula[i].Col,

View File

@ -7,8 +7,8 @@ interface
uses
// Not using Lazarus package as the user may be working with multiple versions
// Instead, add .. to unit search path
Classes, SysUtils, fpcunit, testutils, testregistry,
fpstypes, fpsallformats, fpspreadsheet, fpsexprparser,
Classes, SysUtils, fpcunit, testregistry,
fpstypes, fpspreadsheet, fpsexprparser,
xlsbiff8 {and a project requirement for lclbase for utf8 handling},
testsutility;
@ -62,7 +62,7 @@ uses
{$IFDEF FORMULADEBUG}
LazLogger,
{$ENDIF}
math, typinfo, lazUTF8, fpsUtils;
typinfo, lazUTF8, fpsUtils;
{ TSpreadExtendedFormulaTests }
@ -96,6 +96,7 @@ var
begin
TempFile := GetTempFileName;
try
// Create test workbook and write test formula and needed cells
workbook := TsWorkbook.Create;
try
@ -159,7 +160,10 @@ begin
CheckEquals(AFormula, actualformula, 'Saved formula text mismatch.');
finally
workbook.Free;
DeleteFile(TempFile);
end;
finally
if FileExists(TempFile) then DeleteFile(TempFile);
end;
end;