diff --git a/components/fpspreadsheet/fpolebasic.pas b/components/fpspreadsheet/fpolebasic.pas
index 6e11aa420..058442aee 100644
--- a/components/fpspreadsheet/fpolebasic.pas
+++ b/components/fpspreadsheet/fpolebasic.pas
@@ -35,6 +35,7 @@ type
public
procedure WriteOLEFile(AFileName: string; AOLEDocument: TOLEDocument; const AOverwriteExisting: Boolean = False; const AStreamName: UTF8String='Book');
procedure ReadOLEFile(AFileName: string; AOLEDocument: TOLEDocument; const AStreamName: UTF8String='Book');
+ procedure ReadOLEStream(AStream: TStream; AOLEDocument: TOLEDocument; const AStreamName: UTF8String='Book');
procedure FreeOLEDocumentData(AOLEDocument: TOLEDocument);
end;
@@ -88,12 +89,31 @@ procedure TOLEStorage.ReadOLEFile(AFileName: string;
AOLEDocument: TOLEDocument; const AStreamName: UTF8String);
var
RealFile: TFileStream;
+begin
+ RealFile:=TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
+ try
+ ReadOLEStream(RealFile, AOLEDocument, AStreamName);
+ finally
+ RealFile.Free;
+ end;
+end;
+
+
+procedure TOLEStorage.ReadOLEStream(AStream: TStream; AOLEDocument: TOLEDocument;
+ const AStreamName: UTF8String = 'Book');
+var
fsOLE: TVirtualLayer_OLE;
OLEStream: TStream;
VLAbsolutePath: UTF8String;
begin
VLAbsolutePath:='/'+AStreamName; //Virtual layer always use absolute paths.
+ fsOLE := TVirtualLayer_OLE.Create(AStream);
try
+ fsOLE.Initialize(); //Initialize the OLE container.
+ OLEStream := fsOLE.CreateStream(VLAbsolutePath, fmOpenRead);
+ try
+
+ {
RealFile:=nil;
RealFile:=TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
try
@@ -114,12 +134,25 @@ begin
finally
OLEStream.Free;
end;
+ }
+ if Assigned(OLEStream) then begin
+ if not AssigneD(AOLEDocument.Stream) then
+ AOLEDocument.Stream := TMemoryStream.Create
+ else
+ (AOLEDocument.Stream as TMemoryStream).Clear;
+ AOLEDocument.Stream.CopyFrom(OLEStream, OLEStream.Size);
+ end;
finally
- fsOLE.Free;
+ OLEStream.Free;
end;
+ finally
+ fsOLE.Free;
+ end;
+ {
finally
RealFile.Free;
end;
+ }
end;
{@@
diff --git a/components/fpspreadsheet/fpsnumformatparser.pas b/components/fpspreadsheet/fpsnumformatparser.pas
index ac664c7b1..9db9e715c 100644
--- a/components/fpspreadsheet/fpsnumformatparser.pas
+++ b/components/fpspreadsheet/fpsnumformatparser.pas
@@ -1253,6 +1253,9 @@ end;
procedure TsNumFormatParser.ScanFormat;
var
done: Boolean;
+ s: String;
+ n: Integer;
+ uch: Cardinal;
begin
done := false;
while (FCurrent < FEnd) and (FStatus = psOK) and (not done) do begin
@@ -1270,7 +1273,15 @@ begin
'_': // Excel: Leave width of next character empty
begin
FToken := NextToken;
- AddElement(nftEmptyCharWidth, FToken);
+ uch := UTF8CharacterToUnicode(FCurrent, n);
+ if n > 1 then
+ begin
+ AddElement(nftEmptyCharWidth, UnicodeToUTF8(uch));
+ inc(FCurrent, n-1);
+ FToken := NextToken;
+ Continue;
+ end else
+ AddElement(nftEmptyCharWidth, FToken);
end;
'@': // Excel: Indicates text format
begin
@@ -1301,7 +1312,13 @@ begin
Exit;
end;
else
- AddElement(nftText, FToken);
+ uch := UTF8CharacterToUnicode(FCurrent, n);
+ if n > 1 then
+ begin
+ AddElement(nftText, UnicodeToUTF8(uch));
+ inc(FCurrent, n-1);
+ end else
+ AddElement(nftText, FToken);
end;
FToken := NextToken;
end;
diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas
index 78010e768..8d215be28 100755
--- a/components/fpspreadsheet/fpsopendocument.pas
+++ b/components/fpspreadsheet/fpsopendocument.pas
@@ -149,6 +149,7 @@ type
private
FColumnStyleList: TFPList;
FRowStyleList: TFPList;
+ FRichTextFontList: TStringList;
FHeaderFooterFontList: TObjectList;
// Routines to write parts of files
@@ -163,6 +164,7 @@ type
procedure WriteRowsAndCells(AStream: TStream; ASheet: TsWorksheet);
procedure WriteTableSettings(AStream: TStream);
procedure WriteTableStyles(AStream: TStream);
+ procedure WriteTextStyles(AStream: TStream);
procedure WriteVirtualCells(AStream: TStream; ASheet: TsWorksheet);
function WriteBackgroundColorStyleXMLAsString(const AFormat: TsCellFormat): String;
@@ -232,7 +234,7 @@ type
implementation
uses
- StrUtils, Variants, LazFileUtils, URIParser,
+ StrUtils, Variants, LazFileUtils, URIParser, LazUTF8,
{$IFDEF FPS_VARISBOOL}
fpsPatches,
{$ENDIF}
@@ -958,7 +960,7 @@ end;
The function result is false if a style with the given name could not be found }
function TsSpreadOpenDocReader.ApplyStyleToCell(ACell: PCell; AStyleName: String): Boolean;
var
- fmt: PsCellFormat;
+ fmt: TsCellFormat;
styleIndex: Integer;
i: Integer;
begin
@@ -980,8 +982,14 @@ begin
exit;
styleIndex := TColumnData(FColumnList[i]).DefaultCellStyleIndex;
end;
- fmt := FCellFormatList.Items[styleIndex];
- ACell^.FormatIndex := FWorkbook.AddCellFormat(fmt^);
+ fmt := FCellFormatList.Items[styleIndex]^;
+ if (styleIndex = 0) and FWorksheet.HasHyperlink(ACell) then
+ begin
+ // Make sure to use hyperlink font for hyperlink cells in case of default cell style
+ fmt.FontIndex := HYPERLINK_FONTINDEX;
+ Include(fmt.UsedFormattingFields, uffFont);
+ end;
+ ACell^.FormatIndex := FWorkbook.AddCellFormat(fmt);
Result := true;
end;
@@ -1660,7 +1668,9 @@ var
fntSize: Single;
fntStyles: TsFontStyles;
fntColor: TsColor;
+ fntPosition: TsFontPosition;
s: String;
+ p: Integer;
begin
if ANode = nil then
begin
@@ -1687,9 +1697,20 @@ begin
if not ((s = '') or (s = 'none')) then
Include(fntStyles, fssUnderline);
s := GetAttrValue(ANode, 'style:text-line-through-style');
+ if s = '' then s := GetAttrValue(ANode, 'style:text-line-through-type');
if not ((s = '') or (s = 'none')) then
Include(fntStyles, fssStrikeout);
+ fntPosition := fpNormal;
+ s := GetAttrValue(ANode, 'style:text-position');
+ if Length(s) >= 3 then
+ begin
+ if (s[3] = 'b') or (s[1] = '-') then
+ fntPosition := fpSubscript
+ else
+ fntPosition := fpSuperscript;
+ end;
+
s := GetAttrValue(ANode, 'fo:color');
if s <> '' then
fntColor := HTMLColorStrToColor(s)
@@ -1703,13 +1724,13 @@ begin
end else
if (APreferredIndex > -1) then
begin
- FWorkbook.ReplaceFont(APreferredIndex, fntName, fntSize, fntStyles, fntColor);
+ FWorkbook.ReplaceFont(APreferredIndex, fntName, fntSize, fntStyles, fntColor, fntPosition);
Result := APreferredIndex;
end else
begin
- Result := FWorkbook.FindFont(fntName, fntSize, fntStyles, fntColor);
+ Result := FWorkbook.FindFont(fntName, fntSize, fntStyles, fntColor, fntPosition);
if Result = -1 then
- Result := FWorkbook.AddFont(fntName, fntSize, fntStyles, fntColor);
+ Result := FWorkbook.AddFont(fntName, fntSize, fntStyles, fntColor, fntPosition);
end;
end;
@@ -1825,6 +1846,10 @@ begin
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
+{ In principle, this method could be simplified by calling ReadFromStream which
+ is essentially a duplication of ReadFromFile. But ReadFromStream leads to
+ worse memory usage. --> KEEP READFROMFILE INTACT
+ See fpspeedtest, ods 20k x 100 cells --> out of mem in Win7-32 bit, 4 GB}
procedure TsSpreadOpenDocReader.ReadFromFile(AFileName: string);
var
Doc : TXMLDocument;
@@ -1935,12 +1960,132 @@ begin
end;
procedure TsSpreadOpenDocReader.ReadFromStream(AStream: TStream);
+var
+ Doc : TXMLDocument;
+// FilePath : string;
+// UnZip : TUnZipper;
+// FileList : TStringList;
+ BodyNode, SpreadSheetNode, TableNode: TDOMNode;
+ StylesNode: TDOMNode;
+ OfficeSettingsNode: TDOMNode;
+ nodename: String;
+ pageLayout: PsPageLayout;
+ XMLStream: TStream;
+begin
+ {
+ //unzip files into AFileName path
+ FilePath := GetTempDir(false);
+ UnZip := TUnZipper.Create;
+ FileList := TStringList.Create;
+ try
+ FileList.Add('styles.xml');
+ FileList.Add('content.xml');
+ FileList.Add('settings.xml');
+ UnZip.OutputPath := FilePath;
+ Unzip.UnZipFiles(AFileName,FileList);
+ finally
+ FreeAndNil(FileList);
+ FreeAndNil(UnZip);
+ end; //try
+ }
+ Doc := nil;
+ try
+ // process the styles.xml file
+ XMLStream := TMemoryStream.Create;
+ try
+ if UnzipToStream(AStream, 'styles.xml', XMLStream) then
+ ReadXMLStream(Doc, XMLStream);
+ finally
+ XMLStream.Free;
+ end;
+
+ StylesNode := Doc.DocumentElement.FindNode('office:styles');
+ ReadNumFormats(StylesNode);
+ ReadStyles(StylesNode);
+ ReadAutomaticStyles(Doc.DocumentElement.FindNode('office:automatic-styles'));
+ ReadMasterStyles(Doc.DocumentElement.FindNode('office:master-styles'));
+ FreeAndNil(Doc);
+
+ //process the content.xml file
+ XMLStream := TMemoryStream.Create;
+ try
+ if UnzipToStream(AStream, 'content.xml', XMLStream) then
+ ReadXMLStream(Doc, XMLStream);
+ finally
+ XMLStream.Free;
+ end;
+
+ StylesNode := Doc.DocumentElement.FindNode('office:automatic-styles');
+ ReadNumFormats(StylesNode);
+ ReadStyles(StylesNode);
+
+ BodyNode := Doc.DocumentElement.FindNode('office:body');
+ if not Assigned(BodyNode) then
+ raise Exception.Create('[TsSpreadOpenDocReader.ReadFromStream] Node "office:body" not found.');
+
+ SpreadSheetNode := BodyNode.FindNode('office:spreadsheet');
+ if not Assigned(SpreadSheetNode) then
+ raise Exception.Create('[TsSpreadOpenDocReader.ReadFromStream] Node "office:spreadsheet" not found.');
+
+ ReadDateMode(SpreadSheetNode);
+
+ //process each table (sheet)
+ TableNode := SpreadSheetNode.FindNode('table:table');
+ while Assigned(TableNode) do
+ begin
+ nodename := TableNode.Nodename;
+ // These nodes occur due to leading spaces which are not skipped
+ // automatically any more due to PreserveWhiteSpace option applied
+ // to ReadXMLFile
+ if nodeName <> 'table:table' then
+ begin
+ TableNode := TableNode.NextSibling;
+ continue;
+ end;
+ FWorkSheet := FWorkbook.AddWorksheet(GetAttrValue(TableNode, 'table:name'), true);
+ // Collect column styles used
+ ReadColumns(TableNode);
+ // Process each row inside the sheet and process each cell of the row
+ ReadRowsAndCells(TableNode);
+ // Read page layout
+ pageLayout := ReadPageLayout(StylesNode, GetAttrValue(TableNode, 'table:style-name'));
+ if pageLayout <> nil then
+ FWorksheet.PageLayout := pagelayout^;
+ // Handle columns and rows
+ ApplyColWidths;
+ // Page layout
+ FixCols(FWorksheet);
+ FixRows(FWorksheet);
+ // Continue with next table
+ TableNode := TableNode.NextSibling;
+ end; //while Assigned(TableNode)
+
+ FreeAndNil(Doc);
+
+ // process the settings.xml file (Note: it does not always exist!)
+ XMLStream := TMemoryStream.Create;
+ try
+ if UnzipToStream(AStream, 'settings.xml', XMLStream) then
+ begin
+ ReadXMLStream(Doc, XMLStream);
+ OfficeSettingsNode := Doc.DocumentElement.FindNode('office:settings');
+ ReadSettings(OfficeSettingsNode);
+ end;
+ finally
+ XMLStream.Free;
+ end;
+
+ finally
+ FreeAndNil(Doc);
+ end;
+end;
+{
begin
Unused(AStream);
raise Exception.Create('[TsSpreadOpenDocReader.ReadFromStream] '+
'Method not implemented. Use "ReadFromFile" instead.');
end;
-
+ }
procedure TsSpreadOpenDocReader.ReadHeaderFooterFont(ANode: TDOMNode;
var AFontName: String; var AFontSize: Double;
var AFontStyle: TsHeaderFooterFontStyles; var AFontColor: TsColor);
@@ -1998,13 +2143,16 @@ end;
procedure TsSpreadOpenDocReader.ReadLabel(ARow, ACol: Cardinal;
ACellNode: TDOMNode);
var
- cellText: String;
+ cellText, spanText: String;
styleName: String;
childnode: TDOMNode;
subnode: TDOMNode;
nodeName: String;
cell: PCell;
hyperlink: string;
+ fmt: TsCellFormat;
+ rtParams: TsRichTextParams;
+ idx: Integer;
procedure AddToCellText(AText: String);
begin
@@ -2020,6 +2168,7 @@ begin
like below is much better: }
cellText := '';
hyperlink := '';
+ SetLength(rtParams, 0);
childnode := ACellNode.FirstChild;
while Assigned(childnode) do
begin
@@ -2041,7 +2190,21 @@ begin
AddToCellText(subnode.TextContent);
end;
'text:span':
- AddToCellText(subnode.TextContent);
+ begin
+ spanText := subnode.TextContent;
+ stylename := GetAttrValue(subnode, 'text:style-name');
+ if stylename <> '' then begin
+ idx := FCellFormatList.FindIndexOfName(stylename);
+ if idx > -1 then
+ begin
+ SetLength(rtParams, Length(rtParams)+1);
+ rtParams[High(rtParams)].FontIndex := FCellFormatList[idx]^.FontIndex;
+ rtParams[High(rtParams)].StartIndex := Length(cellText);
+ rtParams[High(rtParams)].EndIndex := Length(cellText + spanText);
+ end;
+ end;
+ AddToCelLText(spanText);
+ end;
end;
subnode := subnode.NextSibling;
end;
@@ -2056,7 +2219,7 @@ begin
end else
cell := FWorksheet.AddCell(ARow, ACol);
- FWorkSheet.WriteUTF8Text(cell, cellText);
+ FWorkSheet.WriteUTF8Text(cell, cellText, rtParams);
if hyperlink <> '' then
begin
// ODS sees relative paths relative to the internal own file structure
@@ -2917,6 +3080,7 @@ var
nodeName: String;
family: String;
styleName: String;
+ parentstyle: String;
fmt: TsCellFormat;
numFmtIndexDefault: Integer;
numFmtName: String;
@@ -2925,6 +3089,7 @@ var
numFmtParams: TsNumFormatParams;
clr: TsColor;
s: String;
+ idx: Integer;
procedure SetBorderStyle(ABorder: TsCellBorder; AStyleValue: String);
const
@@ -3013,6 +3178,7 @@ begin
if nodeName = 'style:style' then
begin
family := GetAttrValue(styleNode, 'style:family');
+ parentstyle := GetAttrValue(stylenode, 'style:parent-style-name');
// Column styles
if family = 'table-column' then
@@ -3028,6 +3194,13 @@ begin
styleName := GetAttrValue(styleNode, 'style:name');
InitFormatRecord(fmt);
+
+ if parentstyle <> '' then
+ begin
+ idx := FCellFormatList.FindIndexOfName(parentstyle);
+ if idx > -1 then
+ fmt := FCellFormatList[idx]^;
+ end;
fmt.Name := styleName;
numFmtIndex := -1;
@@ -3173,8 +3346,28 @@ begin
end;
styleChildNode := styleChildNode.NextSibling;
end;
-
FCellFormatList.Add(fmt);
+ end
+ else
+ if family = 'text' then
+ begin
+ // "Rich-text formatting run" style
+ styleName := GetAttrValue(styleNode, 'style:name');
+ styleChildNode := styleNode.FirstChild;
+ while Assigned(styleChildNode) do
+ begin
+ nodeName := styleChildNode.NodeName;
+ if nodeName = 'style:text-properties' then
+ begin
+ InitFormatRecord(fmt);
+ fmt.Name := styleName;
+ fmt.FontIndex := ReadFont(styleChildNode);
+ if fmt.FontIndex > 0 then
+ Include(fmt.UsedFormattingFields, uffFont);
+ FCellFormatList.Add(fmt);
+ end;
+ styleChildNode := stylechildNode.NextSibling;
+ end;
end;
end;
styleNode := styleNode.NextSibling;
@@ -3410,6 +3603,9 @@ begin
FSMetaInfManifest.Position := 0;
end;
+{ Writes the node "office:automatic-styles". Although this node occurs in both
+ "contents.xml" and "styles.xml" files, this method is called only for writing
+ to "styles.xml". }
procedure TsSpreadOpenDocWriter.WriteAutomaticStyles(AStream: TStream);
var
i: Integer;
@@ -3640,11 +3836,12 @@ begin
AppendToStream(FSContent,
'');
- WriteNumFormats(FSContent);
- WriteColStyles(FSContent);
- WriteRowStyles(FSContent);
- WriteTableStyles(FSContent);
- WriteCellStyles(FSContent);
+ WriteNumFormats(FSContent); // "N1" ...
+ WriteColStyles(FSContent); // "co1" ...
+ WriteRowStyles(FSContent); // "ro1" ...
+ WriteTableStyles(FSContent); // "ta1" ...
+ WriteCellStyles(FSContent); // "ce1" ...
+ WriteTextStyles(FSContent); // "T1" ...
AppendToStream(FSContent,
'');
@@ -4221,6 +4418,7 @@ begin
FColumnStyleList := TFPList.Create;
FRowStyleList := TFPList.Create;
+ FRichTextFontList := TStringList.Create;
FHeaderFooterFontList := TObjectList.Create;
FPointSeparatorSettings := SysUtils.DefaultFormatSettings;
@@ -4242,6 +4440,7 @@ begin
for j:=FRowStyleList.Count-1 downto 0 do TObject(FRowStyleList[j]).Free;
FRowStyleList.Free;
+ FRichTextFontList.Free; // Do not destroy fonts, they are owned by Workbook
FHeaderFooterFontList.Free;
inherited Destroy;
@@ -4614,6 +4813,12 @@ begin
if fssStrikeout in AFont.Style then
Result := Result + 'style:text-line-through-style="solid" ';
+ if AFont.Position = fpSubscript then
+ Result := Result + 'style:text-position="sub 58%" ';
+
+ if AFont.Position = fpSuperscript then
+ Result := Result + 'style:text-position="super 58%" ';
+
if AFont.Color <> defFnt.Color then
Result := Result + Format('fo:color="%s" ', [ColorToHTMLColorStr(AFont.Color)]);
end;
@@ -4879,9 +5084,44 @@ begin
end;
end;
+procedure TsSpreadOpenDocWriter.WriteTextStyles(AStream: TStream);
+var
+ cell: PCell;
+ rtp: TsRichTextParam;
+ styleCounter: Integer;
+ fnt: TsFont;
+ fntStr: String;
+ styleName: String;
+ sheet: TsWorksheet;
+ i: Integer;
+begin
+ styleCounter := 0;
+ for i := 0 to FWorkbook.GetWorksheetCount-1 do
+ begin
+ sheet := FWorkbook.GetWorksheetByIndex(i);
+ for cell in sheet.Cells do
+ begin
+ if Length(cell^.RichTextParams) = 0 then
+ Continue;
+ for rtp in cell^.RichTextParams do
+ begin
+ inc(styleCounter);
+ stylename := Format('T%d', [stylecounter]);
+ fnt := FWorkbook.GetFont(rtp.FontIndex);
+ FRichTextFontList.AddObject(stylename, fnt);
+ fntStr := WriteFontStyleXMLAsString(fnt);
+ AppendToStream(AStream,
+ '' +
+ '' +
+ '');
+ end;
+ end;
+ end;
+end;
+
{@@ ----------------------------------------------------------------------------
- Creates an XML string for inclusion of the textrotation style option into the
+ Creates an XML string for inclusion of the text rotation style option into the
written file from the textrotation setting in the format cell.
Is called from WriteStyles (via WriteStylesXMLAsString).
-------------------------------------------------------------------------------}
@@ -5196,8 +5436,11 @@ var
txt: ansistring;
textp, target, bookmark, comment: String;
fmt: TsCellFormat;
+ fnt: TsFont;
hyperlink: PsHyperlink;
u: TUri;
+ i, idx, n, len: Integer;
+ rtParam: TsRichTextParam;
begin
Unused(ARow, ACol);
@@ -5254,8 +5497,52 @@ begin
'', [target, txt]);
end else
+ begin
// No hyperlink, normal text only
- textp := '' + txt + '';
+ if Length(ACell^.RichTextParams) = 0 then
+ // Standard text formatting
+ textp := '' + txt + ''
+ else
+ begin
+ // "Rich-text" formatting
+ len := UTF8Length(AValue);
+ textp := '';
+ rtParam := ACell^.RichTextParams[0];
+ if rtParam.StartIndex > 0 then
+ begin
+ txt := UTF8Copy(AValue, 1, rtParam.StartIndex);
+ ValidXMLText(txt);
+ textp := textp + txt;
+ end;
+ for i := 0 to High(ACell^.RichTextParams) do
+ begin
+ rtParam := ACell^.RichTextParams[i];
+ fnt := FWorkbook.GetFont(rtParam.FontIndex);
+ idx := FRichTextFontList.IndexOfObject(fnt);
+ n := rtParam.EndIndex - rtParam.StartIndex;
+ txt := UTF8Copy(AValue, rtParam.StartIndex+1, n);
+ ValidXMLText(txt);
+ textp := textp +
+ '' +
+ txt +
+ '';
+ if (rtParam.EndIndex < len) and (i = High(ACell^.RichTextParams)) then
+ begin
+ txt := UTF8Copy(AValue, rtParam.EndIndex+1, MaxInt);
+ ValidXMLText(txt);
+ textp := textp + txt;
+ end else
+ if (i < High(ACell^.RichTextParams)) and (rtParam.EndIndex < ACell^.RichTextParams[i+1].StartIndex)
+ then begin
+ n := ACell^.RichTextParams[i+1].StartIndex - rtParam.EndIndex;
+ txt := UTF8Copy(AValue, rtParam.EndIndex+1, n);
+ ValidXMLText(txt);
+ textp := textp + txt;
+ end;
+ end;
+ textp := textp + '';
+ end;
+ end;
// Write it ...
AppendToStream(AStream, Format(
diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas
index 509a524af..c3bcb9ebe 100755
--- a/components/fpspreadsheet/fpspreadsheet.pas
+++ b/components/fpspreadsheet/fpspreadsheet.pas
@@ -1,3 +1,14 @@
+{**
+ Unit: fpspreadsheet
+
+ implements **spreadsheet documents** and their properties and methods.
+
+ AUTHORS: Felipe Monteiro de Carvalho, Reinier Olislagers, Werner Pamler
+
+ LICENSE: See the file COPYING.modifiedLGPL.txt, included in the Lazarus
+ distribution, for details about the license.
+}
+
{@@ ----------------------------------------------------------------------------
Unit fpspreadsheet implements spreadsheet documents and their
properties and methods.
@@ -31,6 +42,18 @@ type
TsBasicSpreadReader = class;
TsBasicSpreadWriter = class;
+ {**
+ Type: TRow -- record containing information about a spreadsheet row
+
+ Members:
+ - Row -- The index of the row (beginning with 0)
+ - Height -- The height of the row (expressed as line count of the default font)
+
+ Notes:
+ - Only rows with heights that cannot be derived from the font height have
+ a row record.
+ }
+
{@@ The record TRow contains information about a spreadsheet row:
@param Row The index of the row (beginning with 0)
@param Height The height of the row (expressed as lines count of the default font)
@@ -239,9 +262,10 @@ type
procedure WriteRPNFormula(ACell: PCell;
AFormula: TsRPNFormula); overload;
- function WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring): PCell; overload;
-// procedure WriteUTF8Text(ACell: PCell; AText: ansistring); overload;
- procedure WriteUTF8Text(ACell: PCell; AText: String; ARichTextparams: TsRichTextParams = nil); overload;
+ function WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring;
+ ARichTextParams: TsRichTextParams = nil): PCell; overload;
+ procedure WriteUTF8Text(ACell: PCell; AText: String;
+ ARichTextparams: TsRichTextParams = nil); overload;
{ Writing of cell attributes }
function WriteBackground(ARow, ACol: Cardinal; AStyle: TsFillStyle;
@@ -890,9 +914,9 @@ begin
end;
-{*******************************************************************************
-* TsWorksheet *
-*******************************************************************************}
+{------------------------------------------------------------------------------}
+{ TsWorksheet }
+{------------------------------------------------------------------------------}
{@@ ----------------------------------------------------------------------------
Constructor of the TsWorksheet class.
@@ -3461,15 +3485,22 @@ end;
On formats that don't support unicode, the text will be converted
to ISO Latin 1.
- @param ARow The row of the cell
- @param ACol The column of the cell
- @param AText The text to be written encoded in utf-8
+ @param ARow The row of the cell
+ @param ACol The column of the cell
+ @param AText The text to be written encoded in utf-8
+ @param ARichTextParams Array of formatting instructions for characters or
+ groups of characters (see TsRichTextParam).
+
@return Pointer to cell created or used
+
+ @see TsRichTextParams
+ @see TsRichTextParam
-------------------------------------------------------------------------------}
-function TsWorksheet.WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring): PCell;
+function TsWorksheet.WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring;
+ ARichTextParams: TsRichTextParams = nil): PCell;
begin
Result := GetCell(ARow, ACol);
- WriteUTF8Text(Result, AText);
+ WriteUTF8Text(Result, AText, ARichTextParams);
end;
{@@ ----------------------------------------------------------------------------
@@ -3478,8 +3509,13 @@ end;
On formats that don't support unicode, the text will be converted
to ISO Latin 1.
- @param ACell Pointer to the cell
- @param AText The text to be written encoded in utf-8
+ @param ACell Pointer to the cell
+ @param AText The text to be written encoded in utf-8
+ @param ARichTextParams Array of formatting instructions for characters or
+ groups of characters (see TsRichTextParam).
+
+ @see TsRichTextParams
+ @see TsRichTextParam
-------------------------------------------------------------------------------}
procedure TsWorksheet.WriteUTF8Text(ACell: PCell; AText: String;
ARichTextParams: TsRichTextParams = nil);
@@ -3537,6 +3573,7 @@ end;
@param ARow Cell row index
@param ACol Cell column index
@param ANumber Number to be written
+
@return Pointer to cell created or used
-------------------------------------------------------------------------------}
function TsWorksheet.WriteNumber(ARow, ACol: Cardinal; ANumber: double): PCell;
@@ -6032,9 +6069,9 @@ begin
end;
-{*******************************************************************************
-* TsWorkbook *
-*******************************************************************************}
+{------------------------------------------------------------------------------}
+{ TsWorkbook }
+{------------------------------------------------------------------------------}
{@@ ----------------------------------------------------------------------------
Helper method called before reading the workbook. Clears the error log.
@@ -7664,9 +7701,9 @@ begin
end;
*)
-{*******************************************************************************
-* TsBasicSpreadReaderWriter *
-*******************************************************************************}
+{------------------------------------------------------------------------------}
+{ TsBasicSpreadReaderWriter }
+{------------------------------------------------------------------------------}
{@@ ----------------------------------------------------------------------------
Constructor of the reader/writer. Has the workbook to be read/written as a
@@ -7696,9 +7733,9 @@ begin
end;
-{*******************************************************************************
-* TsBasicSpreadWriter *
-*******************************************************************************}
+{------------------------------------------------------------------------------}
+{ TsBasicSpreadWriter }
+{------------------------------------------------------------------------------}
{@@ ----------------------------------------------------------------------------
Checks limitations of the writer, e.g max row/column count
@@ -7724,5 +7761,4 @@ initialization
finalization
SetLength(GsSpreadFormats, 0);
-end.
-
+end. {** End Unit: fpspreadsheet }
diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas
index 0e47cb262..47142d688 100644
--- a/components/fpspreadsheet/fpspreadsheetgrid.pas
+++ b/components/fpspreadsheet/fpspreadsheetgrid.pas
@@ -598,17 +598,6 @@ uses
fpCanvas, fpsStrings, fpsUtils, fpsVisualUtils, fpsNumFormat;
const
- {@@ Translation of the fpspreadsheet type of horizontal text alignment to that
- used in the graphics unit. }
- HOR_ALIGNMENTS: array[haLeft..haRight] of TAlignment = (
- taLeftJustify, taCenter, taRightJustify
- );
- {@@ Translation of the fpspreadsheet type of vertical text alignment to that
- used in the graphics unit. }
- VERT_ALIGNMENTS: array[TsVertAlignment] of TTextLayout = (
- tlBottom, tlTop, tlCenter, tlBottom
- );
-
{@@ Default number of columns prepared for a new empty worksheet }
DEFAULT_COL_COUNT = 26;
{@@ Default number of rows prepared for a new empty worksheet }
@@ -2100,7 +2089,7 @@ var
txtRot: TsTextRotation;
fntIndex: Integer;
lCell: PCell;
- justif: Byte;
+// justif: Byte;
fmt: PsCellFormat;
begin
if (Worksheet = nil) then
@@ -2169,7 +2158,7 @@ begin
txt := GetCellText(GetGridRow(lCell^.Col), GetGridCol(lCell^.Row));
if txt = '' then
exit;
-
+ {
case txtRot of
trHorizontal:
case horAlign of
@@ -2190,7 +2179,7 @@ begin
vaCenter: justif := 1;
vaBottom: justif := 0;
end;
- end;
+ end; }
InternalDrawTextInCell(txt, ARect, horAlign, vertAlign, txtRot, wrapped,
fntIndex, lCell^.RichTextParams);
{
diff --git a/components/fpspreadsheet/fpstypes.pas b/components/fpspreadsheet/fpstypes.pas
index df6c79950..ee9121a48 100644
--- a/components/fpspreadsheet/fpstypes.pas
+++ b/components/fpspreadsheet/fpstypes.pas
@@ -404,7 +404,7 @@ type
TsFontStyles = set of TsFontStyle;
{@@ Font position (subscript or superscript) }
- TsFontPosition = (fpNormal, fpSubscript, fpSuperscript);
+ TsFontPosition = (fpNormal, fpSuperscript, fpSubscript); // Keep order for compatibility with xls!
{@@ Font record used in fpspreadsheet. Contains the font name, the font size
(in points), the font style, and the font color. }
@@ -432,7 +432,7 @@ type
TsRichTextParams = array of TsRichTextParam;
{@@ Excel rich-text formatting run }
- TsRichTextFormattingRun = record
+ TsRichTextFormattingRun = packed record
FirstIndex: Integer;
FontIndex: Integer;
end;
diff --git a/components/fpspreadsheet/fpsvisualutils.pas b/components/fpspreadsheet/fpsvisualutils.pas
index d8635b521..17cd06185 100644
--- a/components/fpspreadsheet/fpsvisualutils.pas
+++ b/components/fpspreadsheet/fpsvisualutils.pas
@@ -196,7 +196,7 @@ var
totalHeight, linelen, stackPeriod: Integer;
procedure InitFont(P: PChar; out rtState: TRtState;
- PendingRtpIndex: Integer; out AHeight: Integer);
+ PendingRtpIndex: Integer; out AHeight: Integer; out AFontPos: TsFontPosition);
var
fnt: TsFont;
hasRtp: Boolean;
@@ -216,12 +216,13 @@ var
Convert_sFont_to_Font(fnt, ACanvas.Font);
AHeight := ACanvas.TextHeight('Tg');
if (fnt <> nil) and (fnt.Position <> fpNormal) then
- ACanvas.Font.Size := round(ACanvas.Font.Size * SUBSCRIPT_SUPERSCRIPT_FACTOR);
+ ACanvas.Font.Size := round(fnt.Size * SUBSCRIPT_SUPERSCRIPT_FACTOR);
+ AFontPos := fnt.Position;
end;
procedure UpdateFont(P:PChar; var rtState: TRtState;
var PendingRtpIndex: Integer; var AHeight: Integer;
- out AFontPos: TsFontPosition);
+ var AFontPos: TsFontPosition);
var
hasRtp: Boolean;
rtp: TsRichTextParam;
@@ -238,7 +239,8 @@ var
Convert_sFont_to_Font(fnt, ACanvas.Font);
AHeight := ACanvas.TextHeight('Tg');
if fnt.Position <> fpNormal then
- ACanvas.Font.Size := round(ACanvas.Font.Size * SUBSCRIPT_SUPERSCRIPT_FACTOR);
+ ACanvas.Font.Size := round(fnt.Size * SUBSCRIPT_SUPERSCRIPT_FACTOR);
+ AFontPos := fnt.Position;
rtState := rtEnter;
end else
if (p - pStartText >= rtp.EndIndex) and (rtState = rtEnter) then
@@ -264,10 +266,10 @@ var
Convert_sFont_to_Font(fnt, ACanvas.Font);
AHeight := ACanvas.TextHeight('Tg');
if fnt.Position <> fpNormal then
- ACanvas.Font.Size := round(ACanvas.Font.Size * SUBSCRIPT_SUPERSCRIPT_FACTOR);
+ ACanvas.Font.Size := round(fnt.Size * SUBSCRIPT_SUPERSCRIPT_FACTOR);
+ AFontPos := fnt.Position;
end;
end;
- AFontPos := fnt.Position;
end;
procedure ScanLine(var P: PChar; var NumSpaces: Integer;
@@ -287,7 +289,7 @@ var
begin
NumSpaces := 0;
- InitFont(p, rtState, PendingRtpIndex, h);
+ InitFont(p, rtState, PendingRtpIndex, h, fntpos);
height := h;
pEOL := p;
@@ -365,12 +367,12 @@ var
p: PChar;
rtState: TRtState;
h, w: Integer;
- fntpos: TsFontPosition;
+ fntpos: TsFontPosition = fpNormal;
s: utf8String;
charLen: Integer;
begin
p := pStart;
- InitFont(p, rtState, PendingRtpIndex, h);
+ InitFont(p, rtState, PendingRtpIndex, h, fntpos);
while p^ <> #0 do begin
s := UnicodeToUTF8(UTF8CharacterToUnicode(p, charLen));
UpdateFont(p, rtState, PendingRtpIndex, h, fntpos);
diff --git a/components/fpspreadsheet/fpsxmlcommon.pas b/components/fpspreadsheet/fpsxmlcommon.pas
index b40e1ba6a..d94ec0597 100644
--- a/components/fpspreadsheet/fpsxmlcommon.pas
+++ b/components/fpspreadsheet/fpsxmlcommon.pas
@@ -16,12 +16,15 @@ type
TsSpreadXMLReader = class(TsCustomSpreadReader)
protected
procedure ReadXMLFile(out ADoc: TXMLDocument; AFileName: String);
+ procedure ReadXMLStream(out ADoc: TXMLDocument; AStream: TStream);
end;
function GetAttrValue(ANode : TDOMNode; AAttrName : string) : string;
function GetNodeValue(ANode: TDOMNode): String;
-procedure UnzipFile(AZipFileName, AZippedFile, ADestFolder: String);
+procedure UnzipFile(AZipFileName, AZippedFile, ADestFolder: String);
+function UnzipToStream(AZipStream: TStream; const AZippedFile: String;
+ ADestStream: TStream): Boolean;
implementation
@@ -33,9 +36,13 @@ uses
{$ENDIF}
fpsStreams;
-{ Gets value for the specified attribute. Returns empty string if attribute
- not found. }
-function {TsSpreadXMLReader.}GetAttrValue(ANode : TDOMNode; AAttrName : string) : string;
+{------------------------------------------------------------------------------}
+{ Utilities }
+{------------------------------------------------------------------------------}
+
+{ Gets value for the specified attribute of the given node.
+ Returns empty string if attribute is not found. }
+function GetAttrValue(ANode : TDOMNode; AAttrName : string) : string;
var
i: LongWord;
Found: Boolean;
@@ -58,7 +65,7 @@ end;
{ Returns the text value of a node. Normally it would be sufficient to call
"ANode.NodeValue", but since the DOMParser needs to preserve white space
(for the spaces in date/time formats), we have to go more into detail. }
-function {TsSpreadXMLReader.}GetNodeValue(ANode: TDOMNode): String;
+function GetNodeValue(ANode: TDOMNode): String;
var
child: TDOMNode;
begin
@@ -68,38 +75,109 @@ begin
Result := child.NodeValue;
end;
+
+{------------------------------------------------------------------------------}
+{ Unzipping }
+{------------------------------------------------------------------------------}
+type
+ TStreamUnzipper = class(TUnzipper)
+ private
+ FInputStream: TStream;
+ FOutputStream: TStream;
+ FSuccess: Boolean;
+ procedure CloseInputStream(Sender: TObject; var AStream: TStream);
+ procedure CreateStream(Sender: TObject; var AStream: TStream;
+ AItem: TFullZipFileEntry);
+ procedure DoneStream(Sender: TObject; var AStream: TStream;
+ AItem: TFullZipFileEntry);
+ procedure OpenInputStream(Sender: TObject; var AStream: TStream);
+ public
+ constructor Create(AInputStream: TStream);
+ function UnzipFile(const AZippedFile: string; ADestStream: TStream): Boolean;
+ end;
+
+constructor TStreamUnzipper.Create(AInputStream: TStream);
+begin
+ inherited Create;
+ OnCloseInputStream := @CloseInputStream;
+ OnCreateStream := @CreateStream;
+ OnDoneStream := @DoneStream;
+ OnOpenInputStream := @OpenInputStream;
+ FInputStream := AInputStream
+end;
+
+procedure TStreamUnzipper.CloseInputStream(Sender: TObject; var AStream: TStream);
+begin
+ AStream := nil;
+end;
+
+procedure TStreamUnzipper.CreateStream(Sender: TObject; var AStream: TStream;
+ AItem: TFullZipFileEntry);
+begin
+ FSuccess := True;
+ AStream := FOutputStream;
+end;
+
+procedure TStreamUnzipper.DoneStream(Sender: TObject; var AStream: TStream;
+ AItem: TFullZipFileEntry);
+begin
+ AStream := nil;
+end;
+
+procedure TStreamUnzipper.OpenInputStream(Sender: TObject; var AStream: TStream);
+begin
+ AStream := FInputStream;
+end;
+
+function TStreamUnzipper.UnzipFile(const AZippedFile: string;
+ ADestStream: TStream): Boolean;
+begin
+ FOutputStream := ADestStream;
+ FSuccess := False;
+ Files.Clear;
+ Files.Add(AZippedFile);
+ UnZipAllFiles;
+ Result := FSuccess;
+end;
+
{ We have to use our own ReadXMLFile procedure (there is one in xmlread)
because we have to preserve spaces in element text for date/time separator.
As a side-effect we have to skip leading spaces by ourselves. }
procedure TsSpreadXMLReader.ReadXMLFile(out ADoc: TXMLDocument; AFileName: String);
var
- parser: TDOMParser;
- src: TXMLInputSource;
stream: TStream;
begin
if (boBufStream in Workbook.Options) then
- stream := TBufStream.Create(AFileName, fmOpenRead + fmShareDenyWrite)
+ stream := TBufStream.Create(AFilename, fmOpenRead + fmShareDenyWrite)
else
stream := TFileStream.Create(AFileName, fmOpenRead + fmShareDenyWrite);
try
- parser := TDOMParser.Create;
- try
- parser.Options.PreserveWhiteSpace := true; // This preserves spaces!
- src := TXMLInputSource.Create(stream);
- try
- parser.Parse(src, ADoc);
- finally
- src.Free;
- end;
- finally
- parser.Free;
- end;
+ ReadXMLStream(ADoc, stream);
finally
stream.Free;
end;
end;
+procedure TsSpreadXMLReader.ReadXMLStream(out ADoc: TXMLDocument; AStream: TStream);
+var
+ parser: TDOMParser;
+ src: TXMLInputSource;
+begin
+ parser := TDOMParser.Create;
+ try
+ parser.Options.PreserveWhiteSpace := true; // This preserves spaces!
+ src := TXMLInputSource.Create(AStream);
+ try
+ parser.Parse(src, ADoc);
+ finally
+ src.Free;
+ end;
+ finally
+ parser.Free;
+ end;
+end;
+
procedure UnzipFile(AZipFileName, AZippedFile, ADestFolder: String);
var
list: TStringList;
@@ -121,5 +199,21 @@ begin
end;
+function UnzipToStream(AZipStream: TStream; const AZippedFile: String;
+ ADestStream: TStream): Boolean;
+var
+ unzip: TStreamUnzipper;
+ p: Int64;
+begin
+ p := ADestStream.Position;
+ unzip := TStreamUnzipper.Create(AZipStream);
+ try
+ Result := unzip.UnzipFile(AZippedFile, ADestStream);
+ ADestStream.Position := p;
+ finally
+ unzip.Free;
+ end;
+end;
+
end.
diff --git a/components/fpspreadsheet/reference/BIFFExplorer/bebiffgrid.pas b/components/fpspreadsheet/reference/BIFFExplorer/bebiffgrid.pas
index cce3c1636..68e765699 100644
--- a/components/fpspreadsheet/reference/BIFFExplorer/bebiffgrid.pas
+++ b/components/fpspreadsheet/reference/BIFFExplorer/bebiffgrid.pas
@@ -101,6 +101,7 @@ type
procedure ShowRefreshAll;
procedure ShowRightMargin;
procedure ShowRK;
+ procedure ShowRString;
procedure ShowRow;
procedure ShowSelection;
procedure ShowSharedFormula;
@@ -132,7 +133,12 @@ type
ACharCount: Integer; out AString: String; out ANumbytes: Integer); overload;
procedure ExtractString(ABufIndex: Integer; ALenBytes: Byte; AUnicode: Boolean;
out AString: String; out ANumBytes: Integer;
+ out ARichTextRuns: TsRichTextFormattingRuns;
+ out ABufIndexOfFirstRichTextRun: LongWord;
IgnoreCompressedFlag: Boolean = false); overload;
+ procedure ExtractString(ABufIndex: Integer; ALenbytes: Byte; AUnicode: Boolean;
+ out AString: String; out ANumBytes: Integer;
+ IgnoreCompressedFlag: Boolean=False); overload;
procedure PopulateGrid;
procedure ShowInRow(var ARow: Integer; var AOffs: LongWord; ASize: Word;
AValue,ADescr: String; ADescrOnly: Boolean = false);
@@ -225,7 +231,7 @@ end;
The string is assumed to be a UTF16 string if AUnicode=true, otherwise it is
an ansi string. }
procedure TBIFFGrid.ExtractString(ABufIndex: Integer; AUnicode: Boolean;
- ACharCount: Integer;out AString: String; out ANumbytes: Integer);
+ ACharCount: Integer; out AString: String; out ANumbytes: Integer);
var
sa: AnsiString;
sw: WideString;
@@ -265,7 +271,21 @@ begin
end;
procedure TBIFFGrid.ExtractString(ABufIndex: Integer; ALenBytes: Byte; AUnicode: Boolean;
- out AString: String; out ANumBytes: Integer; IgnoreCompressedFlag: Boolean = false);
+ out AString: String; out ANumBytes: Integer;
+ IgnoreCompressedFlag: Boolean = false);
+var
+ rtfRuns: TsRichTextFormattingRuns;
+ rtfIndex: LongWord;
+begin
+ ExtractString(ABufIndex, ALenbytes, AUnicode, AString, ANumBytes,
+ rtfRuns, rtfIndex, IgnoreCompressedFlag);
+end;
+
+procedure TBIFFGrid.ExtractString(ABufIndex: Integer; ALenBytes: Byte; AUnicode: Boolean;
+ out AString: String; out ANumBytes: Integer;
+ out ARichTextRuns: TsRichTextFormattingRuns;
+ out ABufIndexOfFirstRichTextRun: LongWord;
+ IgnoreCompressedFlag: Boolean = false);
var
ls: Integer; // Character count of string
w: Word;
@@ -273,12 +293,17 @@ var
optn: Byte;
n: Integer; // Byte count in string character array
asianPhoneticBytes: DWord;
- richRuns: Word;
+ numRichRuns: Word;
offs: Integer;
+ rtfBufIndex: Int64;
+ rtfIndex: Integer;
begin
+ ABufIndexOfFirstRichTextRun := LongWord(-1);
+ SetLength(ARichTextRuns, 0);
+
if Length(FBuffer) = 0 then begin
AString := '';
- ANumBytes := 0;
+ ANumBytes := 0;
exit;
end;
if ALenBytes = 1 then
@@ -291,13 +316,16 @@ begin
offs := ALenBytes;
optn := FBuffer[ABufIndex + ALenBytes];
inc(offs, 1);
+
if optn and $08 <> 0 then // rich text
begin
Move(FBuffer[ABufIndex + offs], w, 2);
- richRuns := WordLEToN(w);
+ numRichRuns := WordLEToN(w);
inc(offs, 2);
end else
- richRuns := 0;
+ numRichRuns := 0;
+ SetLength(ARichTextRuns, numRichRuns);
+
if optn and $04 <> 0 then // Asian phonetic
begin
Move(FBuffer[ABufIndex + offs], dw, 4);
@@ -305,16 +333,31 @@ begin
inc(offs, 4);
end else
asianPhoneticBytes := 0;
+
if (optn and $01 = 0) and (not IgnoreCompressedFlag) then
// compressed --> 1 byte per character
ExtractString(ABufIndex + offs, false, ls, AString, n)
else
// non-compressed unicode
ExtractString(ABufIndex + offs, true, ls, AString, n);
- ANumBytes := offs + n + richRuns * 4 + asianPhoneticBytes;
+
+ ANumBytes := offs + n + numRichRuns * 4 + asianPhoneticBytes;
+
+ rtfIndex := 0;
+ rtfBufIndex := ABufIndex + offs + n;
+ ABufIndexOfFirstRichTextRun := rtfBufIndex;
+ while rtfIndex < numRichRuns do begin
+ Move(FBuffer[rtfBufIndex], w, 2);
+ ARichTextRuns[rtfIndex].FirstIndex := WordLEToN(w);
+ Move(FBuffer[rtfBufIndex+2], w, 2);
+ ARichTextRuns[rtfIndex].FontIndex := WordLEToN(w);
+ inc(rtfIndex);
+ inc(rtfBufIndex, 4);
+ end;
end else
begin
// ansi string
+ SetLength(ARichTextRuns, 0); // no rich text formatting for ansi strings
ExtractString(ABufIndex + ALenBytes, false, ls, AString, n);
ANumbytes := ALenBytes + n;
end;
@@ -471,6 +514,8 @@ begin
ShowMulBlank;
$00BD:
ShowMulRK;
+ $00D6:
+ ShowRString;
$00D7:
ShowDBCell;
$00DA:
@@ -1235,12 +1280,14 @@ var
sa: ansistring;
sw: widestring;
ls: Integer;
- i: Integer;
+ i, j: Integer;
w: Word;
n: Integer;
run: Integer;
total2: Integer;
optn: Byte;
+ rtfRuns: TsRichTextFormattingRuns;
+ rtfBufferIndex: LongWord;
begin
case FInfo of
BIFFNODE_TXO_CONTINUE1:
@@ -1345,9 +1392,20 @@ begin
for i:=FCounterSST+1 to FTotalSST do
begin
FCounterSST := i;
- ExtractString(FBufferIndex, 2, true, s, numBytes);
+ ExtractString(FBufferIndex, 2, true, s, numBytes, rtfRuns, rtfBufferIndex);
ShowInRow(FCurrRow, FBufferIndex, numBytes, s, Format('Shared string #%d', [i]));
inc(n);
+ if Length(rtfRuns) > 0 then begin
+ numBytes := 2;
+ for j:=0 to High(rtfRuns) do
+ begin
+ ShowInRow(FCurrRow, rtfBufferIndex, 2, IntToStr(rtfRuns[j].FirstIndex),
+ Format('Rich-Text formatting run #%d, index of first character', [j]));
+ ShowInRow(FCurrRow, rtfBufferIndex, 2, IntToStr(rtfRuns[j].FontIndex),
+ Format('Rich-Text formatting run #%d, font index', [j]));
+ inc(n, 2);
+ end;
+ end;
if FPendingCharCount > 0 then
begin
FInfo := BIFFNODE_SST_CONTINUE;
@@ -1838,6 +1896,7 @@ var
ansiStr: AnsiString;
s: String;
i, n: Integer;
+ rtfRuns: TsRichTextFormattingRuns;
begin
BeginUpdate;
RowCount := FixedRows + 1000;
@@ -2112,7 +2171,7 @@ begin
numBytes := 2;
Move(FBuffer[FBufferIndex], w, numBytes);
w := WordLEToN(w);
- ShowInRow(FCurrRow, FBufferIndex, numBytes, IntToStr(2), 'Color index');
+ ShowInRow(FCurrRow, FBufferIndex, numBytes, IntToStr(w), 'Color index');
numBytes := 2;
Move(FBuffer[FBufferIndex], w, numBytes);
@@ -3309,6 +3368,7 @@ begin
'Index to XF record');
end;
+// Called for LABEL
procedure TBIFFGrid.ShowLabelCell;
var
numBytes: Integer;
@@ -4997,6 +5057,72 @@ begin
end;
+procedure TBIFFGrid.ShowRString;
+var
+ numBytes: Integer;
+ b: Byte;
+ w: Word;
+ s: String;
+ len: Integer;
+ j: Integer;
+ wideStr: wideString;
+ ansiStr: ansiString;
+begin
+ if FFormat < sfExcel5 then
+ exit;
+
+ RowCount := FixedRows + 5;
+
+ ShowRowColData(FBufferIndex);
+
+ numBytes := 2;
+ Move(FBuffer[FBufferIndex], w, numBytes);
+ w := WordLEToN(w);
+ ShowInRow(FCurrRow, FBufferIndex, numBytes, Format('%d ($%.4x)', [w, w]),
+ 'Index of XF record');
+
+ // String length
+ Move(FBuffer[FBufferIndex], w, 2);
+ len := WordLEToN(w);
+
+ if FFormat = sfExcel8 then
+ begin
+ SetLength(widestr, len);
+ Move(FBuffer[FBufferIndex+3], widestr[1], len*2);
+ s := UTF8Encode(WideStringLEToN(widestr));
+ numbytes := 3 + len*2;
+ end else
+ begin
+ SetLength(ansistr, len);
+ Move(FBuffer[FBufferIndex+2], ansistr[1], len);
+ s := AnsiToUTF8(ansistr);
+ numbytes := 2 + len;
+ end;
+
+ ShowInRow(FCurrRow, FBufferIndex, numbytes, s,
+ Format('%s string, 16-bit string length', [GetStringType]));
+
+ // Number of rich-text formatting runs
+ numbytes := IfThen(FFormat = sfExcel8, 2, 1);
+ Move(FBuffer[FBufferIndex], w, numbytes);
+ len := WordLEToN(w);
+ ShowInRow(FCurrRow, FBufferIndex, numbytes, IntToStr(len),
+ 'Count of rich-text formatting runs');
+
+ // Formatting run data
+ RowCount := RowCount + 2*len;
+ for j:=0 to len-1 do
+ begin
+ Move(FBuffer[FBufferIndex], w, numbytes);
+ ShowInRow(FCurrRow, FBufferIndex, numbytes, IntToStr(WordLEToN(w)),
+ Format('Rich-Text formatting run #%d, index of first character', [j]));
+ Move(FBuffer[FBufferIndex], w, numbytes);
+ ShowInRow(FCurrRow, FBufferIndex, numbytes, IntToStr(WordLEToN(w)),
+ Format('Rich-Text formatting run #%d, font index', [j]));
+ end;
+end;
+
+
procedure TBIFFGrid.ShowSelection;
var
numBytes: Integer;
@@ -5195,7 +5321,10 @@ var
numBytes: Integer;
s: String;
total1, total2: DWord;
- i, n: Integer;
+ i, j, n: Integer;
+ rtfRuns: TsRichTextFormattingRuns;
+ rtfIndex: LongWord;
+ w: Word;
begin
numBytes := 4;
Move(FBuffer[FBufferIndex], total1, numBytes);
@@ -5204,7 +5333,7 @@ begin
total2 := DWordLEToN(total2);
FTotalSST := total2;
- RowCount := FixedRows + 2 + total2;
+ RowCount := FixedRows + 1000;
ShowInRow(FCurrRow, FBufferIndex, numBytes, IntToStr(total1),
'Total number of shared strings in the workbook');
@@ -5215,10 +5344,22 @@ begin
n := 0;
for i:=1 to FTotalSST do begin
FCounterSST := i;
- ExtractString(FBufferIndex, 2, true, s, numBytes); // BIFF8 only --> 2 length bytes
+ ExtractString(FBufferIndex, 2, true, s, numBytes, rtfRuns, rtfIndex); // BIFF8 only --> 2 length bytes
inc(n);
- if FPendingCharCount = 0 then
- ShowInRow(FCurrRow, FBufferIndex, numBytes, s, Format('Shared string #%d', [i]))
+ if FPendingCharCount = 0 then begin
+ ShowInRow(FCurrRow, FBufferIndex, numbytes, s, IfThen(Length(rtfRuns) > 0,
+ Format('Shared string #%d (Count of Rich-Text formatting runs: %d)', [i, Length(rtfRuns)]),
+ Format('Shared string #%d', [i])));
+// ShowInRow(FCurrRow, FBufferIndex, numBytes, s, Format('Shared string #%d', [i]));
+ for j:=0 to High(rtfRuns) do
+ begin
+ ShowInRow(FCurrRow, rtfIndex, 2, IntToStr(rtfRuns[j].FirstIndex),
+ Format(' Rich-Text formatting run #%d, index of first character', [j]));
+ ShowInRow(FCurrRow, rtfIndex, 2, IntToStr(rtfRuns[j].FontIndex),
+ Format(' Rich-Text formatting run #%d, font index', [j]));
+ inc(n, 2);
+ end;
+ end
else
begin
ShowInRow(FCurrRow, FBufferIndex, numbytes, s, Format('Shared string #%d - partial (--> CONTINUE)', [i]));
diff --git a/components/fpspreadsheet/xlsbiff5.pas b/components/fpspreadsheet/xlsbiff5.pas
index e027a9727..4c88a6347 100755
--- a/components/fpspreadsheet/xlsbiff5.pas
+++ b/components/fpspreadsheet/xlsbiff5.pas
@@ -73,9 +73,6 @@ type
{ TsSpreadBIFF5Reader }
TsSpreadBIFF5Reader = class(TsSpreadBIFFReader)
- private
- FWorksheetNames: TStringList;
- FCurrentWorksheet: Integer;
protected
procedure PopulatePalette; override;
{ Record writing methods }
@@ -83,15 +80,15 @@ type
procedure ReadFONT(const AStream: TStream);
procedure ReadFORMAT(AStream: TStream); override;
procedure ReadLABEL(AStream: TStream); override;
- procedure ReadWorkbookGlobals(AStream: TStream);
- procedure ReadWorksheet(AStream: TStream);
- procedure ReadRichString(AStream: TStream);
+ procedure ReadRSTRING(AStream: TStream);
procedure ReadStandardWidth(AStream: TStream; ASheet: TsWorksheet);
procedure ReadStringRecord(AStream: TStream); override;
+ procedure ReadWorkbookGlobals(AStream: TStream); override;
+ procedure ReadWorksheet(AStream: TStream); override;
procedure ReadXF(AStream: TStream);
public
{ General reading methods }
- procedure ReadFromFile(AFileName: string); override;
+// procedure ReadFromFile(AFileName: string); override;
procedure ReadFromStream(AStream: TStream); override;
end;
@@ -323,6 +320,13 @@ type
TextLen: Word;
end;
+ TBiff5_RichTextFormattingRun = packed record
+ FirstIndex: Byte;
+ FontIndex: Byte;
+ end;
+
+ TBiff5_RichTextFormattingRuns = array of TBiff5_RichTextFormattingRun;
+
TBIFF5_XFRecord = packed record
RecordID: Word;
RecordSize: Word;
@@ -426,7 +430,7 @@ begin
INT_EXCEL_ID_RIGHTMARGIN : ReadMargin(AStream, 1);
INT_EXCEL_ID_RK : ReadRKValue(AStream); //(RK) This record represents a cell that contains an RK value (encoded integer or floating-point value). If a floating-point value cannot be encoded to an RK value, a NUMBER record will be written. This record replaces the record INTEGER written in BIFF2.
INT_EXCEL_ID_ROW : ReadRowInfo(AStream);
- INT_EXCEL_ID_RSTRING : ReadRichString(AStream); //(RSTRING) This record stores a formatted text cell (Rich-Text). In BIFF8 it is usually replaced by the LABELSST record. Excel still uses this record, if it copies formatted text cells to the clipboard.
+ INT_EXCEL_ID_RSTRING : ReadRString(AStream); //(RSTRING) This record stores a formatted text cell (Rich-Text). In BIFF8 it is usually replaced by the LABELSST record. Excel still uses this record, if it copies formatted text cells to the clipboard.
INT_EXCEL_ID_SHAREDFMLA : ReadSharedFormula(AStream);
INT_EXCEL_ID_SHEETPR : ReadSHEETPR(AStream);
INT_EXCEL_ID_STANDARDWIDTH : ReadStandardWidth(AStream, FWorksheet);
@@ -508,12 +512,11 @@ begin
SetLength(s, Len);
AStream.ReadBuffer(s[1], Len*SizeOf(AnsiChar));
-// sheetName := AnsiToUTF8(s);
sheetName := ConvertEncoding(s, FCodePage, EncodingUTF8);
FWorksheetNames.Add(sheetName);
end;
-procedure TsSpreadBIFF5Reader.ReadRichString(AStream: TStream);
+procedure TsSpreadBIFF5Reader.ReadRSTRING(AStream: TStream);
var
L: Word;
B, F: Byte;
@@ -593,6 +596,7 @@ begin
FIncompleteCell := nil;
end;
+(*
procedure TsSpreadBIFF5Reader.ReadFromFile(AFileName: string);
var
MemStream: TMemoryStream;
@@ -620,7 +624,7 @@ begin
OLEStorage.Free;
end;
end;
-
+*)
procedure TsSpreadBIFF5Reader.ReadXF(AStream: TStream);
var
rec: TBIFF5_XFRecord;
@@ -642,15 +646,7 @@ begin
AStream.ReadBuffer(rec.FontIndex, SizeOf(rec) - 2*SizeOf(Word));
// Font index
- i := WordLEToN(rec.FontIndex);
-// if i > 4 then dec(i); // Watch out for the nasty missing font #4...
- fmt.FontIndex := FixFontIndex(i);
- {
- fnt := TsFont(FFontList[i]);
- fmt.FontIndex := Workbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
- if fmt.FontIndex = -1 then
- fmt.FontIndex := Workbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
- }
+ fmt.FontIndex := FixFontIndex(WordLEToN(rec.FontIndex));
if fmt.FontIndex > 1 then
Include(fmt.UsedFormattingFields, uffFont);
@@ -780,9 +776,94 @@ begin
FCellFormatList.Add(fmt);
end;
+procedure TsSpreadBIFF5Reader.ReadFromStream(AStream: TStream);
+var
+ OLEStream: TMemoryStream;
+ OLEStorage: TOLEStorage;
+ OLEDocument: TOLEDocument;
+begin
+ OLEStream := TMemoryStream.Create;
+ try
+ OLEStorage := TOLEStorage.Create;
+ try
+ // Only one stream is necessary for any number of worksheets
+ OLEDocument.Stream := OLEStream;
+ OLEStorage.ReadOLEStream(AStream, OLEDocument, 'Book');
+ finally
+ OLEStorage.Free;
+ end;
+ InternalReadFromStream(OLEStream);
+ finally
+ OLEStream.Free;
+ end;
+end;
+
+(*
procedure TsSpreadBIFF5Reader.ReadFromStream(AStream: TStream);
var
BIFF5EOF: Boolean;
+ OLEStream: TMemoryStream;
+ OLEStorage: TOLEStorage;
+ OLEDocument: TOLEDocument;
+begin
+ OLEStream := TMemoryStream.Create;
+ try
+ OLEStorage := TOLEStorage.Create;
+ try
+ // Only one stream is necessary for any number of worksheets
+ OLEDocument.Stream := OLEStream;
+ OLEStorage.ReadOLEStream(AStream, OLEDocument);
+ finally
+ OLEStorage.Free;
+ end;
+
+ // Check if the operation succeeded
+ if OLEStream.Size = 0 then
+ raise Exception.Create('[TsSpreadBIFF5Reader.ReadFromFile] Reading of OLE document failed');
+
+ // Rewind the stream and read from it
+ OLEStream.Position := 0;
+
+ {Initializations }
+ FWorksheetNames := TStringList.Create;
+ try
+ FCurrentWirksheet := 0;
+ BIFF5EOF := false;
+
+ { Read workbook globals }
+ ReadWorkbookGlobals(OLEStream);
+
+ { Check for the end of the file }
+ if OLEStream.Position >= AStream.Size then
+ BIFF5EOF := true;
+
+ { Now read all worksheets }
+ while not BIFF5EOF do
+ begin
+ ReadWorksheet(OLEStream);
+
+ // Check for the end of the fild
+ if OLEStream.Position >= OLEStream.Size then
+ BIFF5EOF := true;
+
+ // Final preparations
+ inc(FCurrentWorksheet);
+ // It can happen in files written by Office97 that the OLE directory is
+ // at the end of the file.
+ if FCurrentWorksheet = FWorksheetNames.Count then
+ BIFF5EOF := true;
+ end;
+
+ finally
+ { Finalization }
+ FreeAndNil(FWorksheetNames);
+ end;
+ finally
+ OLEStream.Free;
+ end;
+end;
+ *)
+(*
begin
{ Initializations }
@@ -815,6 +896,7 @@ begin
{ Finalization }
FWorksheetNames.Free;
end;
+*)
procedure TsSpreadBIFF5Reader.ReadFont(const AStream: TStream);
var
@@ -1253,7 +1335,7 @@ begin
AStream.WriteWord(WordToLE(INT_FONT_WEIGHT_NORMAL));
{ Escapement type }
- AStream.WriteWord(0);
+ AStream.WriteWord(WordToLE(ord(AFont.Position)));
{ Underline type }
if fssUnderline in AFont.Style then
@@ -1369,12 +1451,16 @@ end;
procedure TsSpreadBIFF5Writer.WriteLabel(AStream: TStream; const ARow,
ACol: Cardinal; const AValue: string; ACell: PCell);
const
- MAXBYTES = 255; //limit for this format
+ MAXBYTES = 255; // Limit for this BIFF5
var
L: Word;
AnsiValue: ansistring;
rec: TBIFF5_LabelRecord;
buf: array of byte;
+ useRTF: Boolean;
+ fmt: PsCellFormat;
+ run, j: Integer;
+ rtfRuns: TBiff5_RichTextformattingRuns;
begin
if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then
exit;
@@ -1401,9 +1487,40 @@ begin
end;
L := Length(AnsiValue);
+ useRTF := (Length(ACell^.RichTextParams) > 0);
+
{ BIFF record header }
- rec.RecordID := WordToLE(INT_EXCEL_ID_LABEL);
- rec.RecordSize := WordToLE(8 + L);
+ rec.RecordID := WordToLE(IfThen(useRTF, INT_EXCEL_ID_RSTRING, INT_EXCEL_ID_LABEL));
+ rec.RecordSize := WordToLE(SizeOf(rec) - SizeOf(TsBIFFHeader) + L);
+
+ { Prepare rich-text formatting runs }
+ if useRTF then
+ begin
+ fmt := FWorkbook.GetPointerToCellFormat(ACell^.FormatIndex);
+ run := 0;
+ for j:=0 to High(ACell^.RichTextParams) do
+ begin
+ SetLength(rtfRuns, run + 1);
+ rtfRuns[run].FirstIndex := ACell^.RichTextParams[j].StartIndex;
+ rtfRuns[run].FontIndex := ACell^.RichTextParams[j].FontIndex;
+ if rtfRuns[run].FontIndex >= 4 then
+ inc(rtfRuns[run].FontIndex); // Font #4 does not exist in BIFF
+ inc(run);
+ if (ACell^.RichTextParams[j].EndIndex < L) and
+ (ACell^.RichTextParams[j].EndIndex <> ACell^.RichTextParams[j+1].StartIndex) // wp: j+1 needs to be checked!
+ then begin
+ SetLength(rtfRuns, run+1);
+ rtfRuns[run].FirstIndex := ACell^.RichTextParams[j].EndIndex;
+ rtfRuns[run].FontIndex := fmt^.FontIndex;
+ if rtfRuns[run].FontIndex >= 4 then
+ inc(rtfRuns[run].FontIndex);
+ inc(run);
+ end;
+ end;
+
+ // Adjust BIFF record size for appended formatting runs
+ inc(rec.RecordSize, SizeOf(byte) + run * SizeOf(TBiff5_RichTextFormattingRun));
+ end;
{ BIFF record data }
rec.Row := WordToLE(ARow);
@@ -1416,15 +1533,25 @@ begin
rec.TextLen := WordToLE(L);
{ Copy the text characters into a buffer immediately after rec }
- SetLength(buf, SizeOf(rec) + SizeOf(ansiChar)*L);
+ SetLength(buf, SizeOf(rec) + L);
Move(rec, buf[0], SizeOf(rec));
- Move(AnsiValue[1], buf[SizeOf(rec)], L*SizeOf(ansiChar));
+ Move(AnsiValue[1], buf[SizeOf(rec)], L);
- { Write out }
- AStream.WriteBuffer(buf[0], SizeOf(Rec) + SizeOf(ansiChar)*L);
+ { Write out buffer }
+ AStream.WriteBuffer(buf[0], SizeOf(Rec) + L);
+
+ { Write rich-text information in case of RSTRING record }
+ if useRTF then
+ begin
+ { Write number of rich-text formatting runs }
+ AStream.WriteByte(run);
+ { Write rich-text formatting runs }
+ AStream.WriteBuffer(rtfRuns[0], run * SizeOf(TBiff5_RichTextFormattingRun));
+ end;
{ Clean up }
SetLength(buf, 0);
+ SetLength(rtfRuns, 0);
end;
{@@ ----------------------------------------------------------------------------
diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas
index 1fef0cbb7..7597edf89 100755
--- a/components/fpspreadsheet/xlsbiff8.pas
+++ b/components/fpspreadsheet/xlsbiff8.pas
@@ -70,19 +70,19 @@ type
TsSpreadBIFF8Reader = class(TsSpreadBIFFReader)
private
PendingRecordSize: SizeInt;
- FWorksheetNames: TStringList;
- FCurrentWorksheet: Integer;
FSharedStringTable: TStringList;
FCommentList: TObjectList;
FCommentPending: Boolean;
FCommentID: Integer;
FCommentLen: Integer;
- function ReadWideString(const AStream: TStream; const ALength: WORD): WideString; overload;
- function ReadWideString(const AStream: TStream; const AUse8BitLength: Boolean): WideString; overload;
- procedure ReadWorkbookGlobals(AStream: TStream);
- procedure ReadWorksheet(AStream: TStream);
procedure ReadBoundsheet(AStream: TStream);
- function ReadString(const AStream: TStream; const ALength: WORD): String;
+ function ReadString(const AStream: TStream; const ALength: Word;
+ out ARichTextRuns: TsRichTextFormattingRuns): String;
+ function ReadUnformattedWideString(const AStream: TStream;
+ const ALength: Word): WideString;
+ function ReadWideString(const AStream: TStream; const ALength: Word;
+ out ARichTextRuns: TsRichTextFormattingRuns): WideString; overload;
+ function ReadWideString(const AStream: TStream; const AUse8BitLength: Boolean): WideString; overload;
protected
procedure PopulatePalette; override;
procedure ReadCONTINUE(const AStream: TStream);
@@ -96,7 +96,7 @@ type
procedure ReadMergedCells(const AStream: TStream);
procedure ReadNOTE(const AStream: TStream);
procedure ReadOBJ(const AStream: TStream);
- procedure ReadRichString(const AStream: TStream);
+// procedure ReadRichString(const AStream: TStream);
procedure ReadRPNCellAddress(AStream: TStream; out ARow, ACol: Cardinal;
out AFlags: TsRelFlags); override;
procedure ReadRPNCellAddressOffset(AStream: TStream;
@@ -106,15 +106,18 @@ type
procedure ReadRPNCellRangeOffset(AStream: TStream;
out ARow1Offset, ACol1Offset, ARow2Offset, ACol2Offset: Integer;
out AFlags: TsRelFlags); override;
+ procedure ReadRSTRING(AStream: TStream);
procedure ReadSST(const AStream: TStream);
function ReadString_8bitLen(AStream: TStream): String; override;
procedure ReadStringRecord(AStream: TStream); override;
procedure ReadTXO(const AStream: TStream);
+ procedure ReadWorkbookGlobals(AStream: TStream); override;
+ procedure ReadWorksheet(AStream: TStream); override;
procedure ReadXF(const AStream: TStream);
public
destructor Destroy; override;
{ General reading methods }
- procedure ReadFromFile(AFileName: string); override;
+// procedure ReadFromFile(AFileName: string); override;
procedure ReadFromStream(AStream: TStream); override;
end;
@@ -141,7 +144,7 @@ type
procedure WriteHyperlinkToolTip(AStream: TStream; const ARow, ACol: Cardinal;
const ATooltip: String);
procedure WriteIndex(AStream: TStream);
- procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
+ procedure WriteLABEL(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: string; ACell: PCell); override;
procedure WriteMergedCells(AStream: TStream; AWorksheet: TsWorksheet);
procedure WriteMSODrawing1(AStream: TStream; ANumShapes: Word; AComment: PsComment);
@@ -388,6 +391,13 @@ type
SSTIndex: DWord;
end;
+ TBiff8_RichTextFormattingRun = packed record
+ FirstIndex: Word;
+ FontIndex: Word;
+ end;
+
+ TBiff8_RichTextFormattingRuns = array of TBiff8_RichTextFormattingRun;
+
TBIFF8_XFRecord = packed record
RecordID: Word;
RecordSize: Word;
@@ -426,12 +436,24 @@ type
{ TsSpreadBIFF8Reader }
destructor TsSpreadBIFF8Reader.Destroy;
+var
+ j: Integer;
begin
- if Assigned(FSharedStringTable) then FSharedStringTable.Free;
- if Assigned(FCommentList) then FCommentList.Free;
+ if Assigned(FSharedStringTable) then
+ begin
+ for j := FSharedStringTable.Count-1 downto 0 do
+ if FSharedStringTable.Objects[j] <> nil then
+ FSharedStringTable.Objects[j].Free;
+ FSharedStringTable.Free;
+ end;
+
+ if Assigned(FCommentList) then
+ FCommentList.Free;
+
inherited;
end;
+
{@@ ----------------------------------------------------------------------------
Populates the reader's default palette using the BIFF8 default colors.
-------------------------------------------------------------------------------}
@@ -451,9 +473,10 @@ procedure TsSpreadBIFF8Reader.ReadCONTINUE(const AStream: TStream);
var
commentStr: String;
comment: TBIFF8Comment;
+ rtRuns: TsRichTextFormattingRuns;
begin
if FCommentPending then begin
- commentStr := ReadWideString(AStream, FCommentLen);
+ commentStr := ReadWideString(AStream, FCommentLen, rtRuns);
if commentStr <> '' then
begin
comment := TBIFF8Comment.Create;
@@ -529,8 +552,107 @@ begin
end;
end;
-function TsSpreadBIFF8Reader.ReadWideString(const AStream: TStream;
+{ Reads a unicode string which does not contain rich-text information.
+ This is needed for the RSTRING record. }
+function TsSpreadBIFF8Reader.ReadUnformattedWideString(const AStream: TStream;
const ALength: WORD): WideString;
+var
+ flags: Byte;
+ DecomprStrValue: WideString;
+ AnsiStrValue: ansistring;
+ //RunsCounter: Word;
+ //AsianPhoneticBytes: DWord;
+ i: Integer;
+ j: SizeUInt;
+ len: SizeInt;
+ recType: Word;
+ recSize: Word;
+ C: WideChar;
+begin
+ flags := AStream.ReadByte;
+ dec(PendingRecordSize);
+ {
+ if StringFlags and 4 = 4 then begin
+ //Asian phonetics
+ //Read Asian phonetics Length (not used)
+ AsianPhoneticBytes := DWordLEtoN(AStream.ReadDWord);
+ dec(PendingRecordSize,4);
+ end;
+ if StringFlags and 8 = 8 then begin
+ //Rich string
+ RunsCounter := WordLEtoN(AStream.ReadWord);
+ dec(PendingRecordSize,2);
+ end;
+ }
+ if flags and 1 = 1 Then begin
+ //String is WideStringLE
+ if (ALength * SizeOf(WideChar)) > PendingRecordSize then begin
+ SetLength(Result, PendingRecordSize div 2);
+ AStream.ReadBuffer(Result[1], PendingRecordSize);
+ Dec(PendingRecordSize, PendingRecordSize);
+ end else begin
+ SetLength(Result, ALength);
+ AStream.ReadBuffer(Result[1], ALength * SizeOf(WideChar));
+ Dec(PendingRecordSize, ALength * SizeOf(WideChar));
+ end;
+ Result := WideStringLEToN(Result);
+ end else begin
+ // String is 1 byte per char, this is UTF-16 with the high byte ommited
+ // because it is zero, so decompress and then convert
+ len := ALength;
+ SetLength(DecomprStrValue, len);
+ for i := 1 to len do
+ begin
+ C := WideChar(AStream.ReadByte); // Read 1 byte, but put it into a 2-byte char
+ DecomprStrValue[i] := C;
+ dec(PendingRecordSize);
+ if (PendingRecordSize <= 0) and (i < len) then begin
+ //A CONTINUE may have happened here
+ recType := WordLEToN(AStream.ReadWord);
+ recSize := WordLEToN(AStream.ReadWord);
+ if recType <> INT_EXCEL_ID_CONTINUE then begin
+ raise Exception.Create('[TsSpreadBIFF8Reader.ReadWideString] Expected CONTINUE record not found.');
+ end else begin
+ PendingRecordSize := RecordSize;
+ DecomprStrValue := copy(DecomprStrValue,1,i) + ReadUnformattedWideString(AStream, ALength-i);
+ break;
+ end;
+ end;
+ end;
+ Result := DecomprStrValue;
+ end;
+ {
+ if StringFlags and 8 = 8 then begin
+ // Rich string (This only occurs in BIFF8)
+ SetLength(ARichTextRuns, RunsCounter);
+ for j := 0 to 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
+ Raise Exception.Create('[TsSpreadBIFF8Reader.ReadWideString] Expected CONTINUE record not found.');
+ end else begin
+ PendingRecordSize := RecordSize;
+ end;
+ end;
+ ARichTextRuns[j].FirstIndex := WordLEToN(AStream.ReadWord);
+ ARichTextRuns[j].FontIndex := WordLEToN(AStream.ReadWord);
+ dec(PendingRecordSize, 2*2);
+ end;
+ end;
+ if StringFlags and 4 = 4 then begin
+ //Asian phonetics
+ //Read Asian phonetics, discarded as not used.
+ SetLength(AnsiStrValue, AsianPhoneticBytes);
+ AStream.ReadBuffer(AnsiStrValue[1], AsianPhoneticBytes);
+ dec(PendingRecordSize, AsianPhoneticBytes);
+ end;
+ }
+end;
+
+function TsSpreadBIFF8Reader.ReadWideString(const AStream: TStream;
+ const ALength: WORD; out ARichTextRuns: TsRichTextFormattingRuns): WideString;
var
StringFlags: BYTE;
DecomprStrValue: WideString;
@@ -544,21 +666,21 @@ var
RecordSize: WORD;
C: WideChar;
begin
- StringFlags:=AStream.ReadByte;
+ StringFlags := AStream.ReadByte;
Dec(PendingRecordSize);
if StringFlags and 4 = 4 then begin
- //Asian phonetics
- //Read Asian phonetics Length (not used)
+ // Asian phonetics
+ // Read Asian phonetics Length (not used)
AsianPhoneticBytes := DWordLEtoN(AStream.ReadDWord);
dec(PendingRecordSize,4);
end;
if StringFlags and 8 = 8 then begin
- //Rich string
+ // Rich string
RunsCounter := WordLEtoN(AStream.ReadWord);
dec(PendingRecordSize,2);
end;
if StringFlags and 1 = 1 Then begin
- //String is WideStringLE
+ // String is WideStringLE
if (ALength*SizeOf(WideChar)) > PendingRecordSize then begin
SetLength(Result, PendingRecordSize div 2);
AStream.ReadBuffer(Result[1], PendingRecordSize);
@@ -584,10 +706,10 @@ begin
RecordType := WordLEToN(AStream.ReadWord);
RecordSize := WordLEToN(AStream.ReadWord);
if RecordType <> INT_EXCEL_ID_CONTINUE then begin
- Raise Exception.Create('[TsSpreadBIFF8Reader.ReadWideString] Expected CONTINUE record not found.');
+ Raise Exception.Create('[TsSpreadBIFF8Reader.ReadWideString] CONTINUE record expected, but not found.');
end else begin
PendingRecordSize := RecordSize;
- DecomprStrValue := copy(DecomprStrValue,1,i) + ReadWideString(AStream, ALength-i);
+ DecomprStrValue := copy(DecomprStrValue,1,i) + ReadWideString(AStream, ALength-i, ARichTextRuns);
break;
end;
end;
@@ -595,26 +717,27 @@ begin
Result := DecomprStrValue;
end;
if StringFlags and 8 = 8 then begin
- //Rich string (This only happened in BIFF8)
- for j := 1 to RunsCounter do begin
+ // Rich string (This only occurs in BIFF8)
+ SetLength(ARichTextRuns, RunsCounter);
+ for j := 0 to RunsCounter - 1 do begin
if (PendingRecordSize <= 0) then begin
- //A CONTINUE may happened here
+ // A CONTINUE may happened here
RecordType := WordLEToN(AStream.ReadWord);
RecordSize := WordLEToN(AStream.ReadWord);
if RecordType <> INT_EXCEL_ID_CONTINUE then begin
- Raise Exception.Create('[TsSpreadBIFF8Reader.ReadWideString] Expected CONTINUE record not found.');
+ Raise Exception.Create('[TsSpreadBIFF8Reader.ReadWideString] CONTINUE record expected, but not found.');
end else begin
PendingRecordSize := RecordSize;
end;
end;
- AStream.ReadWord;
- AStream.ReadWord;
+ ARichTextRuns[j].FirstIndex := WordLEToN(AStream.ReadWord);
+ ARichTextRuns[j].FontIndex := WordLEToN(AStream.ReadWord);
dec(PendingRecordSize, 2*2);
end;
end;
if StringFlags and 4 = 4 then begin
- //Asian phonetics
- //Read Asian phonetics, discarded as not used.
+ // Asian phonetics
+ // Read Asian phonetics, discarded as not used.
SetLength(AnsiStrValue, AsianPhoneticBytes);
AStream.ReadBuffer(AnsiStrValue[1], AsianPhoneticBytes);
dec(PendingRecordSize, AsianPhoneticBytes);
@@ -625,13 +748,14 @@ function TsSpreadBIFF8Reader.ReadWideString(const AStream: TStream;
const AUse8BitLength: Boolean): WideString;
var
Len: Word;
+ rtRuns: TsRichTextFormattingRuns;
begin
if AUse8BitLength then
Len := AStream.ReadByte()
else
Len := WordLEtoN(AStream.ReadWord());
- Result := ReadWideString(AStream, Len);
+ Result := ReadWideString(AStream, Len, rtRuns);
end;
procedure TsSpreadBIFF8Reader.ReadWorkbookGlobals(AStream: TStream);
@@ -730,7 +854,7 @@ begin
//(RSTRING) This record stores a formatted text cell (Rich-Text).
// In BIFF8 it is usually replaced by the LABELSST record. Excel still
// uses this record, if it copies formatted text cells to the clipboard.
- INT_EXCEL_ID_RSTRING : ReadRichString(AStream);
+ INT_EXCEL_ID_RSTRING : ReadRSTRING(AStream);
// (RK) This record represents a cell that contains an RK value
// (encoded integer or floating-point value). If a floating-point
@@ -764,6 +888,7 @@ procedure TsSpreadBIFF8Reader.ReadBoundsheet(AStream: TStream);
var
Len: Byte;
WideName: WideString;
+ rtRuns: TsRichTextFormattingRuns;
begin
{ Absolute stream position of the BOF record of the sheet represented
by this record }
@@ -780,15 +905,27 @@ begin
Len := AStream.ReadByte();
{ Read string with flags }
- WideName:=ReadWideString(AStream,Len);
+ WideName:=ReadWideString(AStream, Len, rtRuns);
FWorksheetNames.Add(UTF8Encode(WideName));
end;
function TsSpreadBIFF8Reader.ReadString(const AStream: TStream;
- const ALength: WORD): String;
+ const ALength: WORD; out ARichTextRuns: TsRichTextFormattingRuns): String;
begin
- Result := UTF16ToUTF8(ReadWideString(AStream, ALength));
+ Result := UTF16ToUTF8(ReadWideString(AStream, ALength, ARichTextRuns));
+end;
+ (*
+procedure TsSpreadBIFF8Reader.ReadFromFile(AFileName: String);
+var
+ FileStream: TFileStream;
+begin
+ FileStream := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyNone);
+ try
+ ReadFromStream(FileStream);
+ finally
+ FileStream.Free;
+ end;
end;
procedure TsSpreadBIFF8Reader.ReadFromFile(AFileName: string);
@@ -819,7 +956,32 @@ begin
OLEStorage.Free;
end;
end;
+ *)
+procedure TsSpreadBIFF8Reader.ReadFromStream(AStream: TStream);
+var
+ OLEStream: TMemoryStream;
+ OLEStorage: TOLEStorage;
+ OLEDocument: TOLEDocument;
+begin
+ OLEStream := TMemoryStream.Create;
+ try
+ // Only one stream is necessary for any number of worksheets
+ OLEStorage := TOLEStorage.Create;
+ try
+ OLEDocument.Stream := OLEStream;
+ OLEStorage.ReadOLEStream(AStream, OLEDocument, 'Workbook');
+ finally
+ OLEStorage.Free;
+ end;
+ InternalReadFromStream(OLEStream);
+
+ finally
+ OLEStream.Free;
+ end;
+end;
+(*
+ const AStrea
procedure TsSpreadBIFF8Reader.ReadFromStream(AStream: TStream);
var
BIFF8EOF: Boolean;
@@ -861,14 +1023,16 @@ begin
{ Finalizations }
FWorksheetNames.Free;
end;
+ *)
procedure TsSpreadBIFF8Reader.ReadLABEL(AStream: TStream);
var
L: Word;
ARow, ACol: Cardinal;
XF: Word;
- WideStrValue: WideString;
+ wideStrValue: WideString;
cell: PCell;
+ rtfRuns: TsRichTextFormattingRuns;
begin
{ BIFF Record data: Row, Column, XF Index }
ReadRowColXF(AStream, ARow, ACol, XF);
@@ -876,8 +1040,8 @@ begin
{ Byte String with 16-bit size }
L := WordLEtoN(AStream.ReadWord());
- { Read string with flags }
- WideStrValue:=ReadWideString(AStream,L);
+ { Read wide string with flags }
+ wideStrValue := ReadWideString(AStream, L, rtfRuns);
{ Save the data }
if FIsVirtualMode then begin
@@ -886,10 +1050,11 @@ begin
end else
cell := FWorksheet.AddCell(ARow, ACol); // "real" cell
- FWorksheet.WriteUTF8Text(cell, UTF16ToUTF8(WideStrValue));
+ FWorksheet.WriteUTF8Text(cell, UTF16ToUTF8(wideStrValue));
{Add attributes}
ApplyCellFormatting(cell, XF);
+ ApplyRichTextFormattingRuns(cell, rtfRuns);
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
@@ -915,14 +1080,14 @@ begin
);
end;
end;
-
+ (*
procedure TsSpreadBIFF8Reader.ReadRichString(const AStream: TStream);
var
L: Word;
B: WORD;
ARow, ACol: Cardinal;
XF: Word;
- AStrValue: ansistring;
+ strValue: string;
cell: PCell;
rtfRuns: TsRichTextFormattingRuns;
begin
@@ -930,7 +1095,7 @@ begin
{ Byte String with 16-bit size }
L := WordLEtoN(AStream.ReadWord());
- AStrValue:=ReadString(AStream,L); // ???? shouldn't this be a unicode string ????
+ strValue := ReadString(AStream, L, rtfRuns);
{ Create cell }
if FIsVirtualMode then begin
@@ -940,8 +1105,9 @@ begin
cell := FWorksheet.AddCell(ARow, ACol);
{ Save the data }
- FWorksheet.WriteUTF8Text(cell, AStrValue);
+ FWorksheet.WriteUTF8Text(cell, strValue);
+ {
// Read rich-text formatting runs
B := WordLEtoN(AStream.ReadWord);
SetLength(rtfRuns, B);
@@ -949,7 +1115,7 @@ begin
rtfRuns[L].FirstIndex := WordLEToN(AStream.ReadWord); // Index of first formatted character
rtfRuns[L].FontIndex := WordLEToN(AStream.ReadByte); // Index of font used
end;
-
+ }
{Add attributes}
ApplyCellFormatting(cell, XF);
ApplyRichTextFormattingRuns(cell, rtfRuns);
@@ -957,7 +1123,7 @@ begin
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
-
+ *)
{ Reads the cell address used in an RPN formula element. Evaluates the corresponding
bits to distinguish between absolute and relative addresses.
Overriding the implementation in xlscommon. }
@@ -1059,7 +1225,51 @@ begin
if (c1 and MASK_EXCEL_RELATIVE_ROW <> 0) then Include(AFlags, rfRelRow);
if (c2 and MASK_EXCEL_RELATIVE_COL <> 0) then Include(AFlags, rfRelCol2);
if (c2 and MASK_EXCEL_RELATIVE_ROW <> 0) then Include(AFlags, rfRelRow2);
+end;
+procedure TsSpreadBIFF8Reader.ReadRSTRING(AStream: TStream);
+var
+ j: Integer;
+ L: Word;
+ ARow, ACol: Cardinal;
+ XF: Word;
+ wideStrValue: WideString;
+ cell: PCell;
+ rtfRuns: TsRichTextFormattingRuns;
+begin
+ { BIFF Record data: Row, Column, XF Index }
+ ReadRowColXF(AStream, ARow, ACol, XF);
+
+ { Byte String with 16-bit size }
+ L := WordLEtoN(AStream.ReadWord());
+
+ { Read wide string without flags }
+ wideStrValue := ReadUnformattedWideString(AStream, L);
+
+ { Rich-tech formatting runs }
+ L := WordLEToN(AStream.ReadWord);
+ SetLength(rtfRuns, L);
+ for j := 0 to L-1 do
+ begin
+ rtfRuns[j].FirstIndex := WordLEToN(AStream.ReadWord);
+ rtfRuns[j].FontIndex := WordLEToN(AStream.ReadWord);
+ end;
+
+ { Save the data }
+ if FIsVirtualMode then begin
+ InitCell(ARow, ACol, FVirtualCell); // "virtual" cell
+ cell := @FVirtualCell;
+ end else
+ cell := FWorksheet.AddCell(ARow, ACol); // "real" cell
+
+ FWorksheet.WriteUTF8Text(cell, UTF16ToUTF8(wideStrValue));
+
+ {Add attributes}
+ ApplyCellFormatting(cell, XF);
+ ApplyRichTextFormattingRuns(cell, rtfRuns);
+
+ if FIsVirtualMode then
+ Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
procedure TsSpreadBIFF8Reader.ReadSST(const AStream: TStream);
@@ -1068,32 +1278,38 @@ var
StringLength, CurStrLen: WORD;
LString: String;
ContinueIndicator: WORD;
+ rtfRuns: TsRichTextFormattingRuns;
+ ms: TMemoryStream;
begin
//Reads the shared string table, only compatible with BIFF8
if not Assigned(FSharedStringTable) then begin
//First time SST creation
FSharedStringTable:=TStringList.Create;
- DWordLEtoN(AStream.ReadDWord); //Apparences not used
- Items:=DWordLEtoN(AStream.ReadDWord);
- Dec(PendingRecordSize,8);
+ // Total number of strings in the workbook, not used
+ DWordLEtoN(AStream.ReadDWord);
+
+ // Number of following strings
+ Items := DWordLEtoN(AStream.ReadDWord);
+ Dec(PendingRecordSize, 8);
end else begin
//A second record must not happend. Garbage so skip.
Exit;
end;
- while Items>0 do begin
- StringLength:=0;
- StringLength:=WordLEtoN(AStream.ReadWord);
- Dec(PendingRecordSize,2);
- LString:='';
+
+ while Items > 0 do begin
+ StringLength := 0;
+ StringLength := WordLEtoN(AStream.ReadWord);
+ Dec(PendingRecordSize ,2);
+ LString := '';
// This loop takes care of the string being split between the STT and the CONTINUE, or between CONTINUE records
- while PendingRecordSize>0 do
+ while PendingRecordSize > 0 do
begin
- if StringLength>0 then
+ if StringLength > 0 then
begin
//Read a stream of zero length reads all the stream.
- LString:=LString+ReadString(AStream, StringLength);
+ LString := LString + ReadString(AStream, StringLength, rtfRuns);
end
else
begin
@@ -1104,7 +1320,7 @@ begin
end;
// Check if the record finished and we need a CONTINUE record to go on
- if (PendingRecordSize<=0) and (Items>1) then
+ if (PendingRecordSize <= 0) and (Items > 1) then
begin
//A Continue will happend, read the
//tag and continue linking...
@@ -1112,19 +1328,32 @@ begin
if ContinueIndicator<>INT_EXCEL_ID_CONTINUE then begin
Raise Exception.Create('[TsSpreadBIFF8Reader.ReadSST] Expected CONTINUE record not found.');
end;
- PendingRecordSize:=WordLEtoN(AStream.ReadWord);
+ PendingRecordSize := WordLEtoN(AStream.ReadWord);
CurStrLen := Length(UTF8ToUTF16(LString));
- if StringLength= FSharedStringTable.Count then begin
raise Exception.CreateFmt(rsIndexInSSTOutOfRange, [
- Integer(SSTIndex),FSharedStringTable.Count-1
+ Integer(SSTIndex), FSharedStringTable.Count-1
]);
end;
@@ -1161,9 +1393,18 @@ begin
FWorksheet.WriteUTF8Text(cell, FSharedStringTable[SSTIndex]);
- {Add attributes}
+ { Add attributes }
ApplyCellFormatting(cell, XF);
+ { Add rich text formatting }
+ ms := TMemoryStream(FSharedStringTable.Objects[SSTIndex]);
+ if ms <> nil then begin
+ n := ms.ReadWord;
+ SetLength(rtfRuns, n);
+ ms.ReadBuffer(rtfRuns[0], n*SizeOf(TsRichTextFormattingRun));
+ ApplyRichTextFormattingRuns(cell, rtfRuns);
+ end;
+
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
@@ -1238,12 +1479,7 @@ begin
AStream.ReadBuffer(rec.FontIndex, SizeOf(rec) - 2*SizeOf(word));
// Font index
- i := WordLEToN(rec.FontIndex);
-// if i > 4 then dec(i); // Watch out for the nasty missing font #4...
- fnt := TsFont(FFontList[i]);
- fmt.FontIndex := Workbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
- if fmt.FontIndex = -1 then
- fmt.FontIndex := Workbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
+ fmt.FontIndex := FixFontIndex(WordLEToN(rec.FontIndex));
if fmt.FontIndex > 1 then
Include(fmt.UsedFormattingFields, uffFont);
@@ -1400,9 +1636,9 @@ var
lOptions: Word;
lColor: Word;
lWeight: Word;
- lEsc: Word;
Len: Byte;
font: TsFont;
+ rtfRuns: TsRichTextFormattingRuns;
begin
font := TsFont.Create;
@@ -1438,14 +1674,8 @@ begin
lWeight := WordLEToN(AStream.ReadWord);
if lWeight = 700 then Include(font.Style, fssBold);
- { Escape type }
{ Escapement type }
- lEsc := WordLEToN(AStream.ReadWord);
- case lEsc of
- 0: ;
- 1: font.Position := fpSuperscript;
- 2: font.Position := fpSubscript;
- end;
+ font.Position := TsFontPosition(WordLEToN(AStream.ReadWord));
{ Underline type }
if AStream.ReadByte > 0 then Include(font.Style, fssUnderline);
@@ -1464,7 +1694,7 @@ begin
{ Font name: Unicodestring, char count in 1 byte }
Len := AStream.ReadByte();
- font.FontName := ReadString(AStream, Len);
+ font.FontName := ReadString(AStream, Len, rtfRuns); // rtfRuns is not used here.
{ Add font to internal font list; will be transferred to workbook later because
the font index in the internal list (= index in file) is not the same as the
@@ -1495,7 +1725,8 @@ begin
exit;
// 2 var. Number format string (Unicode string, 16-bit string length, ➜2.5.3)
- fmtString := UTF8Encode(ReadWideString(AStream, False));
+// fmtString := UTF8Encode(ReadWideString(AStream, False));
+ fmtString := UTF16ToUTF8(ReadWideString(AStream, False));
// Add to the list at the specified index. If necessary insert empty strings
while NumFormatList.Count <= fmtIndex do NumFormatList.Add('');
@@ -1511,12 +1742,13 @@ procedure TsSpreadBIFF8Reader.ReadHeaderFooter(AStream: TStream;
var
s: widestring;
len: word;
+ rtfRuns: TsRichTextFormattingRuns;
begin
if RecordSize = 0 then
exit;
len := WordLEToN(AStream.ReadWord);
- s := ReadWideString(AStream, len);
+ s := ReadWideString(AStream, len, rtfRuns);
if AIsHeader then
FWorksheet.PageLayout.Headers[1] := UTF8Encode(s)
else
@@ -1772,7 +2004,7 @@ var
begin
{ Write workbook globals }
WriteBOF(AStream, INT_BOF_WORKBOOK_GLOBALS);
- WriteCodePage(AStream, 'ucs2le'); // = utf8
+ WriteCodePage(AStream, 'ucs2le'); // = utf-16
WriteWindow1(AStream);
WriteFonts(AStream);
WriteNumFormats(AStream);
@@ -2046,7 +2278,7 @@ begin
AStream.WriteWord(WordToLE(INT_FONT_WEIGHT_NORMAL));
{ Escapement type }
- AStream.WriteWord(WordToLE(0));
+ AStream.WriteWord(WordToLE(ord(AFont.Position)));
{ Underline type }
if fssUnderline in AFont.Style then
@@ -2081,6 +2313,10 @@ begin
WriteFONT(AStream, Workbook.GetFont(i));
end;
+{@@ ----------------------------------------------------------------------------
+ Writes an Excel 8 FORMAT record
+ ("Format" is to be understood as "number format" here).
+-------------------------------------------------------------------------------}
procedure TsSpreadBiff8Writer.WriteFORMAT(AStream: TStream;
ANumFormatStr: String; ANumFormatIndex: Integer);
type
@@ -2124,6 +2360,433 @@ begin
SetLength(buf, 0);
end;
+{@@ ----------------------------------------------------------------------------
+ Writes an Excel 8 HEADER or FOOTER record, depending on AIsHeader.
+ Overridden because of wide string
+-------------------------------------------------------------------------------}
+procedure TsSpreadBIFF8Writer.WriteHeaderFooter(AStream: TStream;
+ AIsHeader: Boolean);
+var
+ wideStr: WideString;
+ len: Integer;
+ id: Word;
+begin
+ with FWorksheet.PageLayout do
+ if AIsHeader then
+ begin
+ if (Headers[HEADER_FOOTER_INDEX_ALL] = '') then
+ exit;
+ wideStr := UTF8Decode(Headers[HEADER_FOOTER_INDEX_ALL]);
+ id := INT_EXCEL_ID_HEADER;
+ end else
+ begin
+ if (Footers[HEADER_FOOTER_INDEX_ALL] = '') then
+ exit;
+ wideStr := UTF8Decode(Footers[HEADER_FOOTER_INDEX_ALL]);
+ id := INT_EXCEL_ID_FOOTER;
+ end;
+ len := Length(wideStr);
+
+ { BIFF record header }
+ WriteBiffHeader(AStream, id, 3 + len*sizeOf(wideChar));
+
+ { 16-bit string length }
+ AStream.WriteWord(WordToLE(len));
+
+ { Widestring flags, 1=regular unicode LE string }
+ AStream.WriteByte(1);
+
+ { Characters }
+ AStream.WriteBuffer(WideStringToLE(wideStr)[1], len * SizeOf(WideChar));
+end;
+
+{@@ ----------------------------------------------------------------------------
+ Writes an Excel 8 HYPERLINK record
+-------------------------------------------------------------------------------}
+procedure TsSpreadBIFF8Writer.WriteHyperlink(AStream: TStream;
+ AHyperlink: PsHyperlink; AWorksheet: TsWorksheet);
+var
+ temp: TStream;
+ guid: TGUID;
+ widestr: widestring;
+ ansistr: ansistring;
+ descr: String;
+ fn: String;
+ flags: DWord;
+ size: Integer;
+ cell: PCell;
+ target, bookmark: String;
+ u: TUri;
+ isInternal: Boolean;
+ dirUpCounter: Integer;
+begin
+ cell := AWorksheet.FindCell(AHyperlink^.Row, AHyperlink^.Col);
+ if (cell = nil) or (AHyperlink^.Target='') then
+ exit;
+
+ descr := AWorksheet.ReadAsUTF8Text(cell); // Hyperlink description
+ SplitHyperlink(AHyperlink^.Target, target, bookmark);
+ u := ParseURI(AHyperlink^.Target);
+ isInternal := (target = '') and (bookmark <> '');
+ fn := ''; // Name of local file
+ if target <> '' then
+ begin
+ if (u.Protocol='') then
+ fn := target
+ else
+ UriToFileName(target, fn);
+ ForcePathDelims(fn);
+ end;
+
+ // Since the length of the record is not known in the first place we write
+ // the data to a temporary stream at first.
+ temp := TMemoryStream.Create;
+ try
+ { Cell range using the same hyperlink - we support only single cells }
+ temp.WriteWord(WordToLE(cell^.Row)); // first row
+ temp.WriteWord(WordToLE(cell^.Row)); // last row
+ temp.WriteWord(WordToLE(cell^.Col)); // first column
+ temp.WriteWord(WordToLE(cell^.Col)); // last column
+
+ { GUID of standard link }
+ guid := StringToGuid('{79EAC9D0-BAF9-11CE-8C82-00AA004BA90B}');
+ temp.WriteBuffer(guid, SizeOf(guid));
+
+ { unknown }
+ temp.WriteDWord(DWordToLe($00000002));
+
+ { option flags }
+ flags := 0;
+ if isInternal then
+ flags := MASK_HLINK_TEXTMARK or MASK_HLINK_DESCRIPTION
+ else
+ flags := MASK_HLINK_LINK;
+ if SameText(u.Protocol, 'file') then
+ flags := flags or MASK_HLINK_ABSOLUTE;
+ if descr <> AHyperlink^.Target then
+ flags := flags or MASK_HLINK_DESCRIPTION; // has description
+ if bookmark <> '' then
+ flags := flags or MASK_HLINK_TEXTMARK; // link contains a bookmark
+ temp.WriteDWord(DWordToLE(flags));
+
+ { description }
+ if flags and MASK_HLINK_DESCRIPTION <> 0 then
+ begin
+ widestr := UTF8Decode(descr);
+ { Character count incl trailing zero }
+ temp.WriteDWord(DWordToLE(Length(wideStr) + 1));
+ { Character array (16-bit characters), plus trailing zeros }
+ temp.WriteBuffer(wideStr[1], (Length(wideStr)+1)*SizeOf(widechar));
+ end;
+
+ if target <> '' then
+ begin
+ if (fn <> '') then // URI is a local file
+ begin
+ { GUID of file moniker }
+ guid := StringToGuid('{00000303-0000-0000-C000-000000000046}');
+ temp.WriteBuffer(guid, SizeOf(guid));
+ { Convert to ansi - should be DOS 8.3, but this is not necessary }
+ ansistr := UTF8ToAnsi(fn);
+ { Directory-up level counter }
+ dirUpCounter := 0;
+ if not FileNameIsAbsolute(ansistr) then
+ while (pos ('..' + PathDelim, ansistr) = 1) do
+ begin
+ inc(dirUpCounter);
+ Delete(ansistr, 1, Length('..'+PathDelim));
+ end;
+ temp.WriteWord(WordToLE(dirUpCounter));
+ { Character count of file name incl trailing zero }
+ temp.WriteDWord(DWordToLe(Length(ansistr)+1));
+ { Character array of file name (8-bit characters), plus trailing zero }
+ temp.WriteBuffer(ansistr[1], Length(ansistr)+1);
+ { Unknown }
+ temp.WriteDWord(DWordToLE($DEADFFFF));
+ temp.WriteDWord(0);
+ temp.WriteDWord(0);
+ temp.WriteDWord(0);
+ temp.WriteDWord(0);
+ temp.WriteDWord(0);
+ { Size of following file link fields }
+ widestr := UTF8ToUTF16(fn);
+ size := 4 + 2 + Length(wideStr)*SizeOf(widechar);
+ temp.WriteDWord(DWordToLE(size));
+ if size > 0 then
+ begin
+ { Character count of extended file name }
+ temp.WriteDWord(DWordToLE(Length(widestr)*SizeOf(WideChar)));
+ { Unknown }
+ temp.WriteWord(WordToLE($0003));
+ { Character array, 16-bit characters, NOT ZERO-TERMINATED! }
+ temp.WriteBuffer(widestr[1], Length(wideStr)*SizeOf(WideChar));
+ end;
+ end
+ else begin { Hyperlink target is a URL }
+ widestr := UTF8Decode(target);
+ { GUID of URL Moniker }
+ guid := StringToGUID('{79EAC9E0-BAF9-11CE-8C82-00AA004BA90B}');
+ temp.WriteBuffer(guid, SizeOf(guid));
+ { Character count incl trailing zero }
+ temp.WriteDWord(DWordToLE(Length(wideStr)+1)*SizeOf(wideChar));
+ { Character array plus trailing zero (16-bit characters), plus trailing zeros }
+ temp.WriteBuffer(wideStr[1], (length(wideStr)+1)*SizeOf(wideChar));
+ end;
+ end; // hkURI
+
+ // Hyperlink contains a text mark (#)
+ if bookmark <> '' then
+ begin
+ // Convert to 16-bit characters
+ widestr := UTF8Decode(bookmark);
+ { Character count of text mark, incl trailing zero }
+ temp.WriteDWord(DWordToLE(Length(wideStr) + 1));
+ { Character array (16-bit characters) plus trailing zeros }
+ temp.WriteBuffer(wideStr[1], (Length(wideStr)+1) * SizeOf(WideChar));
+ end;
+
+ { BIFF record header }
+ WriteBIFFHeader(AStream, INT_EXCEL_ID_HYPERLINK, temp.Size);
+
+ { Record data }
+ temp.Position := 0;
+ AStream.CopyFrom(temp, temp.Size);
+
+ finally
+ temp.Free;
+ end;
+end;
+
+{@@ ----------------------------------------------------------------------------
+ Writes all hyperlinks
+-------------------------------------------------------------------------------}
+procedure TsSpreadBIFF8Writer.WriteHyperlinks(AStream: TStream;
+ AWorksheet: TsWorksheet);
+var
+ hyperlink: PsHyperlink;
+begin
+ for hyperlink in AWorksheet.Hyperlinks do begin
+ { Write HYPERLINK record }
+ WriteHyperlink(AStream, hyperlink, AWorksheet);
+ { Write HYPERLINK TOOLTIP record }
+ if hyperlink^.Tooltip <> '' then
+ WriteHyperlinkTooltip(AStream, hyperlink^.Row, hyperlink^.Col, hyperlink^.Tooltip);
+ end;
+end;
+
+{@@ ----------------------------------------------------------------------------
+ Writes a HYPERLINK TOOLTIP record
+-------------------------------------------------------------------------------}
+procedure TsSpreadBIFF8Writer.WriteHyperlinkTooltip(AStream: TStream;
+ const ARow, ACol: Cardinal; const ATooltip: String);
+var
+ widestr: widestring;
+begin
+ widestr := UTF8Decode(ATooltip);
+
+ { BIFF record header }
+ WriteBiffHeader(AStream, INT_EXCEL_ID_HLINKTOOLTIP,
+ 10 + (Length(wideStr)+1) * SizeOf(widechar));
+
+ { Repeated record ID }
+ AStream.WriteWord(WordToLe(INT_EXCEL_ID_HLINKTOOLTIP));
+
+ { Cell range using the same hyperlink tooltip - we support only single cells }
+ AStream.WriteWord(WordToLE(ARow)); // first row
+ AStream.WriteWord(WordToLE(ARow)); // last row
+ AStream.WriteWord(WordToLE(ACol)); // first column
+ AStream.WriteWord(WordToLE(ACol)); // last column
+
+ { Tooltop characters, no length, but trailing zero }
+ AStream.WriteBuffer(wideStr[1], (Length(widestr)+1)*SizeOf(wideChar));
+end;
+
+{@@ ----------------------------------------------------------------------------
+ Writes an Excel 8 INDEX record
+
+ nm = (rl - rf - 1) / 32 + 1 (using integer division)
+-------------------------------------------------------------------------------}
+procedure TsSpreadBIFF8Writer.WriteIndex(AStream: TStream);
+begin
+ { BIFF Record header }
+ WriteBIFFHeader(AStream, INT_EXCEL_ID_INDEX, 16);
+
+ { Not used }
+ AStream.WriteDWord(DWordToLE(0));
+
+ { Index to first used row, rf, 0 based }
+ AStream.WriteDWord(DWordToLE(0));
+
+ { Index to first row of unused tail of sheet, rl, last used row + 1, 0 based }
+ AStream.WriteDWord(DWordToLE(0));
+
+ { Absolute stream position of the DEFCOLWIDTH record of the current sheet.
+ If it doesn't exist, the offset points to where it would occur. }
+ AStream.WriteDWord(DWordToLE($00));
+
+ { Array of nm absolute stream positions of the DBCELL record of each Row Block }
+
+ { OBS: It seems to be no problem just ignoring this part of the record }
+end;
+
+{@@ ----------------------------------------------------------------------------
+ Depending on the presence of Rich-text formatting information in the cell
+ record, writes an Excel 8 LABEL record (string cell value only), or
+ RSTRING record (string cell value + rich-text formatting runs)
+
+ If the string length exceeds 32758 bytes, the string will be truncated,
+ a note will be left in the workbooks log.
+-------------------------------------------------------------------------------}
+procedure TsSpreadBIFF8Writer.WriteLABEL(AStream: TStream;
+ const ARow, ACol: Cardinal; const AValue: String; ACell: PCell);
+const
+ //limit for this format: 32767 bytes - header (see reclen below):
+ //37267-8-1=32758
+ MAXBYTES = 32758;
+var
+ L: Word;
+ WideValue: WideString;
+ rec: TBIFF8_LabelRecord;
+ rtfRuns: TBiff8_RichTextFormattingRuns;
+ buf: array of byte;
+ j, nRuns: Integer;
+ fmt: PsCellFormat;
+ useRTF: Boolean;
+ fntIndex: Word;
+begin
+ if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then
+ exit;
+
+ WideValue := UTF8Decode(AValue); //to UTF16
+ if WideValue = '' then begin
+ // Badly formatted UTF8String (maybe ANSI?)
+ if Length(AValue)<>0 then begin
+ //Quite sure it was an ANSI string written as UTF8, so raise exception.
+ raise Exception.CreateFmt(rsUTF8TextExpectedButANSIFoundInCell, [GetCellString(ARow,ACol)]);
+ end;
+ Exit;
+ end;
+
+ if Length(WideValue) > MAXBYTES then begin
+ // Rather than lose data when reading it, let the application programmer deal
+ // with the problem or purposefully ignore it.
+ SetLength(WideValue, MAXBYTES); //may corrupt the string (e.g. in surrogate pairs), but... too bad.
+ Workbook.AddErrorMsg(rsTruncateTooLongCellText, [
+ MAXBYTES, GetCellString(ARow, ACol)
+ ]);
+ end;
+ L := Length(WideValue);
+
+ useRTF := (Length(ACell^.RichTextParams) > 0);
+
+ { BIFF record header }
+ rec.RecordID := WordToLE(IfThen(useRTF, INT_EXCEL_ID_RSTRING, INT_EXCEL_ID_LABEL));
+ rec.RecordSize := WordToLE(SizeOf(rec) - SizeOf(TsBIFFHeader) + L * SizeOf(WideChar));
+
+ { Prepare rich-text formatting runs }
+ if useRTF then
+ begin
+ fmt := FWorkbook.GetPointerToCellFormat(ACell^.FormatIndex);
+ nRuns := 0;
+ for j:=0 to High(ACell^.RichTextParams) do
+ begin
+ SetLength(rtfRuns, nRuns + 1);
+ fntIndex := ACell^.RichTextParams[j].FontIndex;
+ if fntIndex >= 4 then
+ inc(fntIndex); // Font #4 does not exist in BIFF
+ rtfRuns[nRuns].FontIndex := WordLEToN(fntIndex);
+ rtfRuns[nRuns].FirstIndex := WordLEToN(ACell^.RichTextParams[j].StartIndex);
+ inc(nRuns);
+ if (ACell^.RichTextParams[j].EndIndex < L) and
+ (ACell^.RichTextParams[j].EndIndex <> ACell^.RichTextParams[j+1].StartIndex) // wp: j+1 needs to be checked!
+ then begin
+ SetLength(rtfRuns, nRuns + 1);
+ fntIndex := fmt^.FontIndex;
+ if fntIndex >= 4 then
+ inc(fntIndex);
+ rtfRuns[nRuns].FontIndex := WordLEToN(fntIndex);
+ rtfRuns[nRuns].FirstIndex := WordLEToN(ACell^.RichTextParams[j].EndIndex);
+ inc(nRuns);
+ end;
+ end;
+
+ // Adjust BIFF record size for appended formatting runs
+ inc(rec.RecordSize, SizeOf(word) + nRuns * SizeOf(TBiff8_RichTextFormattingRun));
+ end;
+
+ { BIFF record data }
+ rec.Row := WordToLE(ARow);
+ rec.Col := WordToLE(ACol);
+
+ { Index to XF record, according to formatting }
+ rec.XFIndex := WordToLE(FindXFIndex(ACell));
+
+ { Byte String with 16-bit length }
+ rec.TextLen := WordToLE(L);
+
+ { Byte flags }
+ rec.TextFlags := 1; // means regular unicode LE encoding
+
+ { Copy the text characters into a buffer immediately after rec }
+ SetLength(buf, SizeOf(rec) + L*SizeOf(WideChar));
+ Move(rec, buf[0], SizeOf(Rec));
+ Move(WideStringToLE(WideValue)[1], buf[SizeOf(Rec)], L*SizeOf(WideChar));
+
+ { Write out buffer }
+ AStream.WriteBuffer(buf[0], SizeOf(rec) + L*SizeOf(WideChar));
+
+ { Write rich-text information in case of RSTRING record }
+ if useRTF then
+ begin
+ { Write number of rich-text formatting runs }
+ AStream.WriteWord(WordToLE(nRuns));
+
+ { Write array of rich-text formatting runs }
+ AStream.WriteBuffer(rtfRuns[0], nRuns * SizeOf(TBiff8_RichTextFormattingRun));
+ end;
+
+ { Clean up }
+ SetLength(buf, 0);
+ SetLength(rtfRuns, 0);
+end;
+
+procedure TsSpreadBIFF8Writer.WriteMergedCells(AStream: TStream;
+ AWorksheet: TsWorksheet);
+const
+ MAX_PER_RECORD = 1026;
+var
+ n0, n: Integer;
+ rng: PsCellRange;
+ newRecord: Boolean;
+begin
+ n0 := AWorksheet.MergedCells.Count;
+ n := Min(n0, MAX_PER_RECORD);
+ newRecord := true;
+ for rng in AWorksheet.MergedCells do
+ begin
+ if newRecord then
+ begin
+ newRecord := false;
+ { BIFF record header }
+ WriteBIFFHeader(AStream, INT_EXCEL_ID_MERGEDCELLS, 2 + n*8);
+ { Number of cell ranges in this record }
+ AStream.WriteWord(WordToLE(n));
+ end;
+ { Write range data }
+ AStream.WriteWord(WordToLE(rng^.Row1));
+ AStream.WriteWord(WordToLE(rng^.Row2));
+ AStream.WriteWord(WordToLE(rng^.Col1));
+ AStream.WriteWord(WordToLE(rng^.Col2));
+
+ dec(n);
+ if n = 0 then begin
+ newRecord := true;
+ dec(n0, MAX_PER_RECORD);
+ n := Min(n0, MAX_PER_RECORD);
+ end;
+ end;
+end;
+
{@@ ----------------------------------------------------------------------------
Writes the first MSODRAWING record to file. It is needed for a comment
attached to a cell, but also for embedded shapes (currently not supported).
@@ -2439,390 +3102,13 @@ begin
AStream.WriteBuffer(WideStringToLE(wideStr)[1], len * SizeOf(WideChar));
end;
-{@@ ----------------------------------------------------------------------------
- Writes an Excel 8 INDEX record
-
- nm = (rl - rf - 1) / 32 + 1 (using integer division)
--------------------------------------------------------------------------------}
-procedure TsSpreadBIFF8Writer.WriteIndex(AStream: TStream);
-begin
- { BIFF Record header }
- WriteBIFFHeader(AStream, INT_EXCEL_ID_INDEX, 16);
-
- { Not used }
- AStream.WriteDWord(DWordToLE(0));
-
- { Index to first used row, rf, 0 based }
- AStream.WriteDWord(DWordToLE(0));
-
- { Index to first row of unused tail of sheet, rl, last used row + 1, 0 based }
- AStream.WriteDWord(DWordToLE(0));
-
- { Absolute stream position of the DEFCOLWIDTH record of the current sheet.
- If it doesn't exist, the offset points to where it would occur. }
- AStream.WriteDWord(DWordToLE($00));
-
- { Array of nm absolute stream positions of the DBCELL record of each Row Block }
-
- { OBS: It seems to be no problem just ignoring this part of the record }
-end;
-
-{@@ ----------------------------------------------------------------------------
- Writes an Excel 8 HEADER or FOOTER record, depending on AIsHeader.
- Overridden because of wide string
--------------------------------------------------------------------------------}
-procedure TsSpreadBIFF8Writer.WriteHeaderFooter(AStream: TStream;
- AIsHeader: Boolean);
-var
- wideStr: WideString;
- len: Integer;
- id: Word;
-begin
- with FWorksheet.PageLayout do
- if AIsHeader then
- begin
- if (Headers[HEADER_FOOTER_INDEX_ALL] = '') then
- exit;
- wideStr := UTF8Decode(Headers[HEADER_FOOTER_INDEX_ALL]);
- id := INT_EXCEL_ID_HEADER;
- end else
- begin
- if (Footers[HEADER_FOOTER_INDEX_ALL] = '') then
- exit;
- wideStr := UTF8Decode(Footers[HEADER_FOOTER_INDEX_ALL]);
- id := INT_EXCEL_ID_FOOTER;
- end;
- len := Length(wideStr);
-
- { BIFF record header }
- WriteBiffHeader(AStream, id, 3 + len*sizeOf(wideChar));
-
- { 16-bit string length }
- AStream.WriteWord(WordToLE(len));
-
- { Widestring flags, 1=regular unicode LE string }
- AStream.WriteByte(1);
-
- { Characters }
- AStream.WriteBuffer(WideStringToLE(wideStr)[1], len * SizeOf(WideChar));
-end;
-
-{@@ ----------------------------------------------------------------------------
- Writes an Excel 8 HYPERLINK record
--------------------------------------------------------------------------------}
-procedure TsSpreadBIFF8Writer.WriteHyperlink(AStream: TStream;
- AHyperlink: PsHyperlink; AWorksheet: TsWorksheet);
-var
- temp: TStream;
- guid: TGUID;
- widestr: widestring;
- ansistr: ansistring;
- descr: String;
- fn: String;
- flags: DWord;
- size: Integer;
- cell: PCell;
- target, bookmark: String;
- u: TUri;
- isInternal: Boolean;
- dirUpCounter: Integer;
-begin
- cell := AWorksheet.FindCell(AHyperlink^.Row, AHyperlink^.Col);
- if (cell = nil) or (AHyperlink^.Target='') then
- exit;
-
- descr := AWorksheet.ReadAsUTF8Text(cell); // Hyperlink description
- SplitHyperlink(AHyperlink^.Target, target, bookmark);
- u := ParseURI(AHyperlink^.Target);
- isInternal := (target = '') and (bookmark <> '');
- fn := ''; // Name of local file
- if target <> '' then
- begin
- if (u.Protocol='') then
- fn := target
- else
- UriToFileName(target, fn);
- ForcePathDelims(fn);
- end;
-
- // Since the length of the record is not known in the first place we write
- // the data to a temporary stream at first.
- temp := TMemoryStream.Create;
- try
- { Cell range using the same hyperlink - we support only single cells }
- temp.WriteWord(WordToLE(cell^.Row)); // first row
- temp.WriteWord(WordToLE(cell^.Row)); // last row
- temp.WriteWord(WordToLE(cell^.Col)); // first column
- temp.WriteWord(WordToLE(cell^.Col)); // last column
-
- { GUID of standard link }
- guid := StringToGuid('{79EAC9D0-BAF9-11CE-8C82-00AA004BA90B}');
- temp.WriteBuffer(guid, SizeOf(guid));
-
- { unknown }
- temp.WriteDWord(DWordToLe($00000002));
-
- { option flags }
- flags := 0;
- if isInternal then
- flags := MASK_HLINK_TEXTMARK or MASK_HLINK_DESCRIPTION
- else
- flags := MASK_HLINK_LINK;
- if SameText(u.Protocol, 'file') then
- flags := flags or MASK_HLINK_ABSOLUTE;
- if descr <> AHyperlink^.Target then
- flags := flags or MASK_HLINK_DESCRIPTION; // has description
- if bookmark <> '' then
- flags := flags or MASK_HLINK_TEXTMARK; // link contains a bookmark
- temp.WriteDWord(DWordToLE(flags));
-
- { description }
- if flags and MASK_HLINK_DESCRIPTION <> 0 then
- begin
- widestr := UTF8Decode(descr);
- { Character count incl trailing zero }
- temp.WriteDWord(DWordToLE(Length(wideStr) + 1));
- { Character array (16-bit characters), plus trailing zeros }
- temp.WriteBuffer(wideStr[1], (Length(wideStr)+1)*SizeOf(widechar));
- end;
-
- if target <> '' then
- begin
- if (fn <> '') then // URI is a local file
- begin
- { GUID of file moniker }
- guid := StringToGuid('{00000303-0000-0000-C000-000000000046}');
- temp.WriteBuffer(guid, SizeOf(guid));
- { Convert to ansi - should be DOS 8.3, but this is not necessary }
- ansistr := UTF8ToAnsi(fn);
- { Directory-up level counter }
- dirUpCounter := 0;
- if not FileNameIsAbsolute(ansistr) then
- while (pos ('..' + PathDelim, ansistr) = 1) do
- begin
- inc(dirUpCounter);
- Delete(ansistr, 1, Length('..'+PathDelim));
- end;
- temp.WriteWord(WordToLE(dirUpCounter));
- { Character count of file name incl trailing zero }
- temp.WriteDWord(DWordToLe(Length(ansistr)+1));
- { Character array of file name (8-bit characters), plus trailing zero }
- temp.WriteBuffer(ansistr[1], Length(ansistr)+1);
- { Unknown }
- temp.WriteDWord(DWordToLE($DEADFFFF));
- temp.WriteDWord(0);
- temp.WriteDWord(0);
- temp.WriteDWord(0);
- temp.WriteDWord(0);
- temp.WriteDWord(0);
- { Size of following file link fields }
- widestr := UTF8ToUTF16(fn);
- size := 4 + 2 + Length(wideStr)*SizeOf(widechar);
- temp.WriteDWord(DWordToLE(size));
- if size > 0 then
- begin
- { Character count of extended file name }
- temp.WriteDWord(DWordToLE(Length(widestr)*SizeOf(WideChar)));
- { Unknown }
- temp.WriteWord(WordToLE($0003));
- { Character array, 16-bit characters, NOT ZERO-TERMINATED! }
- temp.WriteBuffer(widestr[1], Length(wideStr)*SizeOf(WideChar));
- end;
- end
- else begin { Hyperlink target is a URL }
- widestr := UTF8Decode(target);
- { GUID of URL Moniker }
- guid := StringToGUID('{79EAC9E0-BAF9-11CE-8C82-00AA004BA90B}');
- temp.WriteBuffer(guid, SizeOf(guid));
- { Character count incl trailing zero }
- temp.WriteDWord(DWordToLE(Length(wideStr)+1)*SizeOf(wideChar));
- { Character array plus trailing zero (16-bit characters), plus trailing zeros }
- temp.WriteBuffer(wideStr[1], (length(wideStr)+1)*SizeOf(wideChar));
- end;
- end; // hkURI
-
- // Hyperlink contains a text mark (#)
- if bookmark <> '' then
- begin
- // Convert to 16-bit characters
- widestr := UTF8Decode(bookmark);
- { Character count of text mark, incl trailing zero }
- temp.WriteDWord(DWordToLE(Length(wideStr) + 1));
- { Character array (16-bit characters) plus trailing zeros }
- temp.WriteBuffer(wideStr[1], (Length(wideStr)+1) * SizeOf(WideChar));
- end;
-
- { BIFF record header }
- WriteBIFFHeader(AStream, INT_EXCEL_ID_HYPERLINK, temp.Size);
-
- { Record data }
- temp.Position := 0;
- AStream.CopyFrom(temp, temp.Size);
-
- finally
- temp.Free;
- end;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Writes all hyperlinks
--------------------------------------------------------------------------------}
-procedure TsSpreadBIFF8Writer.WriteHyperlinks(AStream: TStream;
- AWorksheet: TsWorksheet);
-var
- hyperlink: PsHyperlink;
-begin
- for hyperlink in AWorksheet.Hyperlinks do begin
- { Write HYPERLINK record }
- WriteHyperlink(AStream, hyperlink, AWorksheet);
- { Write HYPERLINK TOOLTIP record }
- if hyperlink^.Tooltip <> '' then
- WriteHyperlinkTooltip(AStream, hyperlink^.Row, hyperlink^.Col, hyperlink^.Tooltip);
- end;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Writes a HYPERLINK TOOLTIP record
--------------------------------------------------------------------------------}
-procedure TsSpreadBIFF8Writer.WriteHyperlinkTooltip(AStream: TStream;
- const ARow, ACol: Cardinal; const ATooltip: String);
-var
- widestr: widestring;
-begin
- widestr := UTF8Decode(ATooltip);
-
- { BIFF record header }
- WriteBiffHeader(AStream, INT_EXCEL_ID_HLINKTOOLTIP,
- 10 + (Length(wideStr)+1) * SizeOf(widechar));
-
- { Repeated record ID }
- AStream.WriteWord(WordToLe(INT_EXCEL_ID_HLINKTOOLTIP));
-
- { Cell range using the same hyperlink tooltip - we support only single cells }
- AStream.WriteWord(WordToLE(ARow)); // first row
- AStream.WriteWord(WordToLE(ARow)); // last row
- AStream.WriteWord(WordToLE(ACol)); // first column
- AStream.WriteWord(WordToLE(ACol)); // last column
-
- { Tooltop characters, no length, but trailing zero }
- AStream.WriteBuffer(wideStr[1], (Length(widestr)+1)*SizeOf(wideChar));
-end;
-
-
-{@@ ----------------------------------------------------------------------------
- Writes an Excel 8 LABEL record (string cell value)
-
- If the string length exceeds 32758 bytes, the string will be truncated,
- a note will be left in the workbooks log.
--------------------------------------------------------------------------------}
-procedure TsSpreadBIFF8Writer.WriteLabel(AStream: TStream; const ARow,
- ACol: Cardinal; const AValue: string; ACell: PCell);
-const
- //limit for this format: 32767 bytes - header (see reclen below):
- //37267-8-1=32758
- MAXBYTES = 32758;
-var
- L: Word;
- WideValue: WideString;
- rec: TBIFF8_LabelRecord;
- buf: array of byte;
-begin
- if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then
- exit;
-
- WideValue := UTF8Decode(AValue); //to UTF16
- if WideValue = '' then begin
- // Badly formatted UTF8String (maybe ANSI?)
- if Length(AValue)<>0 then begin
- //Quite sure it was an ANSI string written as UTF8, so raise exception.
- raise Exception.CreateFmt(rsUTF8TextExpectedButANSIFoundInCell, [GetCellString(ARow,ACol)]);
- end;
- Exit;
- end;
-
- if Length(WideValue) > MAXBYTES then begin
- // Rather than lose data when reading it, let the application programmer deal
- // with the problem or purposefully ignore it.
- SetLength(WideValue, MAXBYTES); //may corrupt the string (e.g. in surrogate pairs), but... too bad.
- Workbook.AddErrorMsg(rsTruncateTooLongCellText, [
- MAXBYTES, GetCellString(ARow, ACol)
- ]);
- end;
- L := Length(WideValue);
-
- { BIFF record header }
- rec.RecordID := WordToLE(INT_EXCEL_ID_LABEL);
- rec.RecordSize := 8 + 1 + L * SizeOf(WideChar);
-
- { BIFF record data }
- rec.Row := WordToLE(ARow);
- rec.Col := WordToLE(ACol);
-
- { Index to XF record, according to formatting }
- rec.XFIndex := WordToLE(FindXFIndex(ACell));
-
- { Byte String with 16-bit length }
- rec.TextLen := WordToLE(L);
-
- { Byte flags, 1 means regular unicode LE encoding }
- rec.TextFlags := 1;
-
- { Copy the text characters into a buffer immediately after rec }
- SetLength(buf, SizeOf(rec) + L*SizeOf(WideChar));
- Move(rec, buf[0], SizeOf(Rec));
- Move(WideStringToLE(WideValue)[1], buf[SizeOf(Rec)], L*SizeOf(WideChar));
-
- { Write out }
- AStream.WriteBuffer(buf[0], SizeOf(rec) + L*SizeOf(WideChar));
-
- { Clean up }
- SetLength(buf, 0);
-end;
-
-procedure TsSpreadBIFF8Writer.WriteMergedCells(AStream: TStream;
- AWorksheet: TsWorksheet);
-const
- MAX_PER_RECORD = 1026;
-var
- n0, n: Integer;
- rng: PsCellRange;
- newRecord: Boolean;
-begin
- n0 := AWorksheet.MergedCells.Count;
- n := Min(n0, MAX_PER_RECORD);
- newRecord := true;
- for rng in AWorksheet.MergedCells do
- begin
- if newRecord then
- begin
- newRecord := false;
- { BIFF record header }
- WriteBIFFHeader(AStream, INT_EXCEL_ID_MERGEDCELLS, 2 + n*8);
- { Number of cell ranges in this record }
- AStream.WriteWord(WordToLE(n));
- end;
- { Write range data }
- AStream.WriteWord(WordToLE(rng^.Row1));
- AStream.WriteWord(WordToLE(rng^.Row2));
- AStream.WriteWord(WordToLE(rng^.Col1));
- AStream.WriteWord(WordToLE(rng^.Col2));
-
- dec(n);
- if n = 0 then begin
- newRecord := true;
- dec(n0, MAX_PER_RECORD);
- n := Min(n0, MAX_PER_RECORD);
- end;
- end;
-end;
-
{@@-----------------------------------------------------------------------------
Writes an Excel 8 STYLE record
Registers the name of a user-defined style or specific options
for a built-in cell style.
-------------------------------------------------------------------------------}
-procedure TsSpreadBIFF8Writer.WriteStyle(AStream: TStream);
+procedure TsSpreadBIFF8Writer.WriteSTYLE(AStream: TStream);
begin
{ BIFF record header }
WriteBiffHeader(AStream, INT_EXCEL_ID_STYLE, 4);
diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas
index ba63a16ac..08bca310b 100644
--- a/components/fpspreadsheet/xlscommon.pas
+++ b/components/fpspreadsheet/xlscommon.pas
@@ -353,6 +353,8 @@ type
FIncompleteNoteLength: Word;
FFirstNumFormatIndexInFile: Integer;
FPalette: TsPalette;
+ FWorksheetNames: TStrings;
+ FCurrentWorksheet: Integer;
procedure AddBuiltinNumFormats; override;
procedure ApplyCellFormatting(ACell: PCell; XFIndex: Word); virtual;
@@ -437,6 +439,10 @@ type
procedure ReadVCENTER(AStream: TStream);
// Read WINDOW2 record (gridlines, sheet headers)
procedure ReadWindow2(AStream: TStream); virtual;
+ procedure ReadWorkbookGlobals(AStream: TStream); virtual;
+ procedure ReadWorksheet(AStream: TStream); virtual;
+
+ procedure InternalReadFromStream(AStream: TStream);
public
constructor Create(AWorkbook: TsWorkbook); override;
@@ -946,10 +952,6 @@ end;
everything is known.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFReader.FixColors;
-var
- i: Integer;
- fnt: TsFont;
- fmt: PsCellFormat;
procedure FixColor(var AColor: TsColor);
begin
@@ -957,7 +959,17 @@ var
AColor := FPalette[AColor and $00FFFFFF];
end;
+var
+ i: Integer;
+ fnt: TsFont;
+ fmt: PsCellFormat;
begin
+ for i:=0 to FFontList.Count-1 do
+ begin
+ fnt := TsFont(FFontList[i]);
+ if fnt <> nil then FixColor(fnt.Color);
+ end;
+
for i:=0 to FWorkbook.GetFontCount - 1 do
begin
fnt := FWorkbook.GetFont(i);
@@ -2254,6 +2266,17 @@ begin
FWorksheet.Options := FWorksheet.Options - [soHasFrozenPanes];
end;
+{ Reads the workbook globals. }
+procedure TsSpreadBIFFReader.ReadWorkbookGlobals(AStream: TStream);
+begin
+ // To be overridden by BIFF5 and BIFF8
+end;
+
+procedure TsSpreadBIFFReader.ReadWorksheet(AStream: TStream);
+begin
+ // To be overridden by BIFF5 and BIFF8
+end;
+
{@@ ----------------------------------------------------------------------------
Populates the reader's palette by default colors. Will be overwritten if the
file contains a palette on its own
@@ -2263,6 +2286,64 @@ begin
FPalette.AddBuiltinColors;
end;
+procedure TsSpreadBIFFReader.InternalReadFromStream(AStream: TStream);
+var
+ BIFFEOF: Boolean;
+begin
+{ OLEStream := TMemoryStream.Create;
+ try
+ OLEStorage := TOLEStorage.Create;
+ try
+ // Only one stream is necessary for any number of worksheets
+ OLEDocument.Stream := AStream; //OLEStream;
+ OLEStorage.ReadOLEStream(AStream, OLEDocument, AStreamName);
+ finally
+ OLEStorage.Free;
+ end;
+ }
+
+ // Check if the operation succeeded
+ if AStream.Size = 0 then
+ raise Exception.Create('[TsSpreadBIFFReader.InternalReadFromStream] Reading of OLE document failed');
+
+ // Rewind the stream and read from it
+ AStream.Position := 0;
+
+ {Initializations }
+ FWorksheetNames := TStringList.Create;
+ try
+ FCurrentWorksheet := 0;
+ BIFFEOF := false;
+
+ { Read workbook globals }
+ ReadWorkbookGlobals(AStream);
+
+ { Check for the end of the file }
+ if AStream.Position >= AStream.Size then
+ BIFFEOF := true;
+
+ { Now read all worksheets }
+ while not BIFFEOF do
+ begin
+ ReadWorksheet(AStream);
+
+ // Check for the end of the file
+ if AStream.Position >= AStream.Size then
+ BIFFEOF := true;
+
+ // Final preparations
+ inc(FCurrentWorksheet);
+ // It can happen in files written by Office97 that the OLE directory is
+ // at the end of the file.
+ if FCurrentWorksheet = FWorksheetNames.Count then
+ BIFFEOF := true;
+ end;
+ finally
+ { Finalization }
+ FreeAndNil(FWorksheetNames);
+ end;
+end;
+
{------------------------------------------------------------------------------}
{ TsSpreadBIFFWriter }
diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas
index c5d91d931..5569cb961 100755
--- a/components/fpspreadsheet/xlsxooxml.pas
+++ b/components/fpspreadsheet/xlsxooxml.pas
@@ -130,7 +130,7 @@ type
procedure WriteComments(AWorksheet: TsWorksheet);
procedure WriteDimension(AStream: TStream; AWorksheet: TsWorksheet);
procedure WriteFillList(AStream: TStream);
- procedure WriteFont(AStream: TStream; AFont: TsFont; ATag: String);
+ procedure WriteFont(AStream: TStream; AFont: TsFont; UseInStyleNode: Boolean);
procedure WriteFontList(AStream: TStream);
procedure WriteHeaderFooter(AStream: TStream; AWorksheet: TsWorksheet);
procedure WriteHyperlinks(AStream: TStream; AWorksheet: TsWorksheet);
@@ -749,9 +749,9 @@ begin
if (s1 <> '') and (s2 <> '0') then
begin
fnt := TsFont(FFontList.Items[StrToInt(s1)]);
- fmt.FontIndex := Workbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
+ fmt.FontIndex := Workbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position);
if fmt.FontIndex = -1 then
- fmt.FontIndex := Workbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
+ fmt.FontIndex := Workbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position);
if fmt.FontIndex > 0 then
Include(fmt.UsedFormattingFields, uffFont);
end;
@@ -1065,9 +1065,8 @@ begin
end;
end;
-{ Reads the font described by the specified node. If the node is already
- contained in the font list the font's index is returned; otherwise the
- new font is added to the list and its index is returned. }
+{ Reads the font described by the specified node and stores it in the reader's
+ FontList. }
function TsSpreadOOXMLReader.ReadFont(ANode: TDOMNode): Integer;
var
node: TDOMNode;
@@ -1079,6 +1078,7 @@ var
fntPos: TsFontPosition;
nodename: String;
s: String;
+ acceptDuplicates: Boolean;
begin
fnt := Workbook.GetDefaultFont;
if fnt <> nil then
@@ -1097,6 +1097,7 @@ begin
fntPos := fpNormal;
end;
+ acceptDuplicates := true;
node := ANode.FirstChild;
while node <> nil do
begin
@@ -1105,6 +1106,7 @@ begin
begin
s := GetAttrValue(node, 'val');
if s <> '' then fntName := s;
+ if nodename = 'rFont' then acceptDuplicates := false;
end
else
if nodename = 'sz' then
@@ -1115,26 +1117,26 @@ begin
else
if nodename = 'b' then
begin
- if GetAttrValue(node, 'val') <> 'false'
- then fntStyles := fntStyles + [fssBold];
+ if GetAttrValue(node, 'val') <> 'false' then
+ fntStyles := fntStyles + [fssBold];
end
else
if nodename = 'i' then
begin
- if GetAttrValue(node, 'val') <> 'false'
- then fntStyles := fntStyles + [fssItalic];
+ if GetAttrValue(node, 'val') <> 'false' then
+ fntStyles := fntStyles + [fssItalic];
end
else
if nodename = 'u' then
begin
- if GetAttrValue(node, 'val') <> 'false'
- then fntStyles := fntStyles+ [fssUnderline]
+ if GetAttrValue(node, 'val') <> 'false' then
+ fntStyles := fntStyles+ [fssUnderline]
end
else
if nodename = 'strike' then
begin
- if GetAttrValue(node, 'val') <> 'false'
- then fntStyles := fntStyles + [fssStrikeout];
+ if GetAttrValue(node, 'val') <> 'false' then
+ fntStyles := fntStyles + [fssStrikeout];
end
else
if nodename = 'vertAlign' then
@@ -1154,20 +1156,26 @@ begin
node := node.NextSibling;
end;
- // Check whether font is already contained in font list
- for Result := 0 to FFontList.Count-1 do
- begin
- fnt := TsFont(FFontList[Result]);
- if (fnt.FontName = fntName) and
- (fnt.Size = fntSize) and
- (fnt.Style = fntStyles) and
- (fnt.Color = fntColor) and
- (fnt.Position = fntPos)
- then
- exit;
+ // If this method is called when reading the sharedstrings.xml duplicate
+ // fonts should not be added to the reader's fontList.
+ // As a function result we return the index of the already existing font.
+ if not acceptDuplicates then
+ for Result := 0 to FFontList.Count-1 do
+ begin
+ fnt := TsFont(FFontList[Result]);
+ if SameText(fnt.FontName, fntName) and
+ (fnt.Size = fntSize) and
+ (fnt.Style = fntStyles) and
+ (fnt.Color = fntColor) and
+ (fnt.Position = fntPos)
+ then
+ exit;
end;
- // Font not yet stored --> create a new font and store it in list
+ // Create a font record and store it in the reader's fontlist.
+ // In case of fonts in styles.xml (nodename = "name"), do no look for
+ // duplicates because this will screw up the font index
+ // used in the xf records
fnt := TsFont.Create;
fnt.FontName := fntName;
fnt.Size := fntSize;
@@ -1812,9 +1820,13 @@ begin
FixRows(AWorksheet);
end;
-procedure TsSpreadOOXMLReader.ReadFromFile(AFileName: string);
+{ In principle, this method could be simplified by calling ReadFromStream which
+ is essentially a duplication of ReadFromFile. But ReadFromStream leads to
+ worse memory usage. --> KEEP READFROMFILE INTACT }
+procedure TsSpreadOOXMLReader.ReadFromFile(AFilename: String);
var
Doc : TXMLDocument;
+ RelsNode: TDOMNode;
FilePath : string;
UnZip : TUnZipper;
FileList : TStringList;
@@ -1822,6 +1834,7 @@ var
i: Integer;
fn: String;
fn_comments: String;
+ XMLStream: TStream;
begin
//unzip "content.xml" of "AFileName" to folder "FilePath"
FilePath := GetTempDir(false);
@@ -1927,6 +1940,7 @@ begin
else
// this sheet does not have any cell comments
continue;
+
// Extract texts from the comments file found and apply to worksheet.
if fn_comments <> '' then
begin
@@ -1939,6 +1953,7 @@ begin
FreeAndNil(Doc);
end;
end;
+ // Add hyperlinks to cells
ApplyHyperlinks(FWorksheet);
end; // for
@@ -1948,13 +1963,173 @@ begin
end;
end;
+procedure TsSpreadOOXMLReader.ReadFromStream(AStream: TStream);
+var
+ Doc : TXMLDocument;
+ RelsNode: TDOMNode;
+ SheetList: TStringList;
+ i: Integer;
+ fn: String;
+ fn_comments: String;
+ XMLStream: TStream;
+begin
+ Doc := nil;
+ SheetList := TStringList.Create;
+ try
+ // Retrieve theme colors
+ XMLStream := TMemoryStream.Create;
+ try
+ if UnzipToStream(AStream, OOXML_PATH_XL_THEME, XMLStream) then
+ begin
+ ReadXMLStream(Doc, XMLStream);
+ ReadThemeElements(Doc.DocumentElement.FindNode('a:themeElements'));
+ FreeAndNil(Doc);
+ end;
+ finally
+ XMLStream.Free;
+ end;
+
+ // process the workbook.xml file
+ XMLStream := TMemoryStream.Create;
+ try
+ if not UnzipToStream(AStream, OOXML_PATH_XL_WORKBOOK, XMLStream) then
+ raise Exception.CreateFmt(rsDefectiveInternalStructure, ['xlsx']);
+ ReadXMLStream(Doc, XMLStream);
+ ReadFileVersion(Doc.DocumentElement.FindNode('fileVersion'));
+ ReadDateMode(Doc.DocumentElement.FindNode('workbookPr'));
+ ReadSheetList(Doc.DocumentElement.FindNode('sheets'), SheetList);
+ FreeAndNil(Doc);
+ finally
+ XMLStream.Free;
+ end;
+
+ // process the styles.xml file
+ XMLStream := TMemoryStream.Create;
+ try
+ // Should always exist, just to make sure...
+ if UnzipToStream(AStream, OOXML_PATH_XL_STYLES, XMLStream) then
+ begin
+ ReadXMLStream(Doc, XMLStream);
+ ReadPalette(Doc.DocumentElement.FindNode('colors'));
+ ReadFonts(Doc.DocumentElement.FindNode('fonts'));
+ ReadFills(Doc.DocumentElement.FindNode('fills'));
+ ReadBorders(Doc.DocumentElement.FindNode('borders'));
+ ReadNumFormats(Doc.DocumentElement.FindNode('numFmts'));
+ ReadCellXfs(Doc.DocumentElement.FindNode('cellXfs'));
+ FreeAndNil(Doc);
+ end;
+ finally
+ XMLStream.Free;
+ end;
+
+ // process the sharedstrings.xml file
+ // To do: Use buffered stream instead since shared strings may be large
+ XMLStream := TMemoryStream.Create;
+ try
+ if UnzipToStream(AStream, OOXML_PATH_XL_STRINGS, XMLStream) then
+ begin
+ ReadXMLStream(Doc, XMLStream);
+ ReadSharedStrings(Doc.DocumentElement.FindNode('si'));
+ FreeAndNil(Doc);
+ end;
+ finally
+ XMLStream.Free;
+ end;
+
+ // read worksheets
+ for i:=0 to SheetList.Count-1 do begin
+ // Create worksheet
+ FWorksheet := FWorkbook.AddWorksheet(SheetList[i], true);
+
+ // unzip sheet file
+ XMLStream := TMemoryStream.Create;
+ try
+ fn := OOXML_PATH_XL_WORKSHEETS + Format('sheet%d.xml', [i+1]);
+ if not UnzipToStream(AStream, fn, XMLStream) then
+ Continue;
+ ReadXMLStream(Doc, XMLStream);
+ finally
+ XMLStream.Free;
+ end;
+
+ // Sheet data, formats, etc.
+ ReadSheetViews(Doc.DocumentElement.FindNode('sheetViews'), FWorksheet);
+ ReadSheetFormatPr(Doc.DocumentElement.FindNode('sheetFormatPr'), FWorksheet);
+ ReadCols(Doc.DocumentElement.FindNode('cols'), FWorksheet);
+ ReadWorksheet(Doc.DocumentElement.FindNode('sheetData'), FWorksheet);
+ ReadMergedCells(Doc.DocumentElement.FindNode('mergeCells'), FWorksheet);
+ ReadHyperlinks(Doc.DocumentElement.FindNode('hyperlinks'));
+ ReadPrintOptions(Doc.DocumentElement.FindNode('printOptions'), FWorksheet);
+ ReadPageMargins(Doc.DocumentElement.FindNode('pageMargins'), FWorksheet);
+ ReadPageSetup(Doc.DocumentElement.FindNode('pageSetup'), FWorksheet);
+ ReadHeaderFooter(Doc.DocumentElement.FindNode('headerFooter'), FWorksheet);
+
+ FreeAndNil(Doc);
+
+ { Comments:
+ The comments are stored in separate "comments.xml" files (n = 1, 2, ...)
+ The relationship which comment belongs to which sheet file must be
+ retrieved from the "sheet.xml.rels" file (n = 1, 2, ...).
+ The rels file contains also the second part of the hyperlink data. }
+ fn := OOXML_PATH_XL_WORKSHEETS_RELS + Format('sheet%d.xml.rels', [i+1]);
+ XMLStream := TMemoryStream.Create;
+ try
+ if UnzipToStream(AStream, fn, XMLStream) then
+ begin
+ // Find exact name of comments.xml file
+ ReadXMLStream(Doc, XMLStream);
+ RelsNode := Doc.DocumentElement.FindNode('Relationship');
+ fn_comments := FindCommentsFileName(RelsNode);
+ // Get hyperlink data
+ ReadHyperlinks(RelsNode);
+ FreeAndNil(Doc);
+ end else
+ if (SheetList.Count = 1) then
+ // If the workbook has only one sheet then the sheet.xml.rels file
+ // is missing
+ fn_comments := 'comments1.xml'
+ else
+ // This sheet does not have any cell comments at all
+ continue;
+ finally
+ XMLStream.Free;
+ end;
+
+ // Extract texts from the comments file found and apply to worksheet.
+ if fn_comments <> '' then
+ begin
+ fn := OOXML_PATH_XL + fn_comments;
+ XMLStream := TMemoryStream.Create;
+ try
+ if UnzipToStream(AStream, fn, XMLStream) then
+ begin
+ ReadXMLStream(Doc, XMLStream);
+ ReadComments(Doc.DocumentElement.FindNode('commentList'), FWorksheet);
+ FreeAndNil(Doc);
+ end;
+ finally
+ XMLStream.Free;
+ end;
+ end;
+
+ // Add hyperlinks to cells
+ ApplyHyperlinks(FWorksheet);
+ end; // for
+
+ finally
+ SheetList.Free;
+ FreeAndNil(Doc);
+ end;
+end;
+
+ (*
procedure TsSpreadOOXMLReader.ReadFromStream(AStream: TStream);
begin
Unused(AStream);
raise Exception.Create('[TsSpreadOOXMLReader.ReadFromStream] '+
'Method not implemented. Use "ReadFromFile" instead.');
end;
-
+ *)
{------------------------------------------------------------------------------}
{ TsSpreadOOXMLWriter }
@@ -2331,15 +2506,19 @@ end;
{ Writes font parameters to the stream.
ATag is "font" for the entry in "styles.xml", or "rPr" for the entry for
- richtext parameters in the shared string list. }
+ richtext parameters in the shared string list.
+ ANameTag is "name" for the entry in "styles.xml", or "rFont" for the entry}
procedure TsSpreadOOXMLWriter.WriteFont(AStream: TStream; AFont: TsFont;
- ATag: String);
+ UseInStyleNode: Boolean);
+const
+ TAG: Array[boolean] of string = ('rPr', 'font');
+ NAME_TAG: Array[boolean] of String = ('rFont', 'name');
var
s: String;
begin
s := '';
s := s + Format('', [AFont.Size], FPointSeparatorSettings);
- s := s + Format('', [AFont.FontName]);
+ s := s + Format('<%s val="%s" />', [NAME_TAG[UseInStyleNode], AFont.FontName]);
if (fssBold in AFont.Style) then
s := s + '';
if (fssItalic in AFont.Style) then
@@ -2355,7 +2534,7 @@ begin
fpSuperscript: s := s + '';
end;
AppendToStream(AStream, Format(
- '<%s>%s', [ATag, s, ATag]));
+ '<%s>%s', [TAG[UseInStyleNode], s, TAG[UseInStyleNode]]));
end;
{ Writes the fontlist of the workbook to the stream. }
@@ -2368,7 +2547,7 @@ begin
'', [Workbook.GetFontCount]));
for i:=0 to Workbook.GetFontCount-1 do begin
font := Workbook.GetFont(i);
- WriteFont(AStream, font, 'font');
+ WriteFont(AStream, font, true);
end;
AppendToStream(AStream,
'');
@@ -3601,13 +3780,19 @@ end;
procedure TsSpreadOOXMLWriter.WriteLabel(AStream: TStream; const ARow,
ACol: Cardinal; const AValue: string; ACell: PCell);
const
- MAXBYTES = 32767; //limit for this format
+ MAXBYTES = 32767; // limit for this format
var
CellPosText: string;
lStyleIndex: Cardinal;
ResultingValue: string;
+ fnt: TsFont;
+ n: Integer;
+ i: Integer;
+ L: Integer;
+ rtParam: TsRichTextParam;
+ txt: String;
begin
- // Office 2007-2010 (at least) support no more characters in a cell;
+ // Office 2007-2010 (at least) supports no more characters in a cell;
if Length(AValue) > MAXBYTES then
begin
ResultingValue := Copy(AValue, 1, MAXBYTES); //may chop off multicodepoint UTF8 characters but well...
@@ -3618,16 +3803,79 @@ begin
else
ResultingValue := AValue;
- if not ValidXMLText(ResultingValue) then
+ txt := ResultingValue;
+ if not ValidXMLText(txt) then
Workbook.AddErrorMsg(
rsInvalidCharacterInCell, [
GetCellString(ARow, ACol)
]);
- AppendToStream(FSSharedStrings,
- '' +
- '' + ResultingValue + '' +
- '');
+ { Write string to SharedString table }
+
+ if Length(ACell^.RichTextParams) = 0 then
+ // unformatted string
+ AppendToStream(FSSharedStrings,
+ '' +
+ '' + txt + '' +
+ '')
+ else
+ begin
+ // rich-text formatted string
+ L := UTF8Length(Resultingvalue);
+ AppendToStream(FSSharedStrings,
+ '');
+ rtParam := ACell^.RichTextParams[0];
+ if rtParam.StartIndex > 0 then
+ begin
+ txt := UTF8Copy(ResultingValue, 1, rtParam.StartIndex);
+ ValidXMLText(txt);
+ AppendToStream(FSSharedStrings,
+ '' +
+ '' + txt + '' +
+ ''
+ );
+ end;
+ for i := 0 to High(ACell^.RichTextParams) do
+ begin
+ rtParam := ACell^.RichTextParams[i];
+ fnt := FWorkbook.GetFont(rtParam.FontIndex);
+ n := rtParam.EndIndex - rtParam.StartIndex;
+ txt := UTF8Copy(Resultingvalue, rtParam.StartIndex+1, n);
+ ValidXMLText(txt);
+ AppendToStream(FSSharedStrings,
+ '');
+ WriteFont(FSSharedStrings, fnt, false); // ... font data ...
+ AppendToStream(FSSharedStrings,
+ '' + txt + '' +
+ ''
+ );
+ if (rtParam.EndIndex < L) and (i = High(ACell^.RichTextParams)) then
+ begin
+ txt := UTF8Copy(ResultingValue, rtParam.EndIndex+1, MaxInt);
+ ValidXMLText(txt);
+ AppendToStream(FSSharedStrings,
+ '' +
+ '' + txt + '' +
+ ''
+ )
+ end else
+ if (i < High(ACell^.RichTextParams)) and (rtParam.EndIndex < ACell^.RichTextParams[i+1].StartIndex)
+ then begin
+ n := ACell^.RichTextParams[i+1].StartIndex - rtParam.EndIndex;
+ txt := UTF8Copy(Resultingvalue, rtParam.EndIndex+1, n);
+ ValidXMLText(txt);
+ AppendToStream(FSSharedStrings,
+ '' +
+ '' + txt + '' +
+ ''
+ );
+ end;
+ end;
+ AppendToStream(FSSharedStrings,
+ '');
+ end;
+
+ { Write shared string index to cell record }
CellPosText := TsWorksheet.CellPosToText(ARow, ACol);
lStyleIndex := GetStyleIndex(ACell);