pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: A bunch of updates have run up...

Browse Source 
- Activate ReadFromStream from xls5/8, xlsx, and ods readers (issue #0028389)
- Fix ods using correct hyperlink font
- Rich text formatting runs for xls5/8, xlsx, ods (both reading and writing)
- BIFFExplorer: show details of rich-text formatting runs for SST and RSTRING records

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4211 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-07-26 12:40:51 +00:00
parent 41b65aae4f
commit a838fe2707
13 changed files with 1978 additions and 637 deletions
Download Patch File Download Diff File Expand all files Collapse all files

33
components/fpspreadsheet/fpolebasic.pas
View File

@ -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
OLEStream.Free;
end;
finally
fsOLE.Free;
end;
{
finally
RealFile.Free;
end;
}
end;
{@@

17
components/fpspreadsheet/fpsnumformatparser.pas
View File

@ -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,6 +1273,14 @@ begin
'_': // Excel: Leave width of next character empty
begin
FToken := NextToken;
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
@ -1301,6 +1312,12 @@ begin
Exit;
end;
else
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;

323
components/fpspreadsheet/fpsopendocument.pas
View File

@ -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,
'<office:automatic-styles>');
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,
'</office:automatic-styles>');
@ -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,6 +5084,41 @@ 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,
'<style:style style:name="' + stylename + '" style:family="text">' +
'<style:text-properties ' + fntStr + '/>' +
'</style:style>');
end;
end;
end;
end;
{@@ ----------------------------------------------------------------------------
Creates an XML string for inclusion of the text rotation style option into the
@ -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
'</text:p>', [target, txt]);
end else
begin
// No hyperlink, normal text only
textp := '<text:p>' + txt + '</text:p>';
if Length(ACell^.RichTextParams) = 0 then
// Standard text formatting
textp := '<text:p>' + txt + '</text:p>'
else
begin
// "Rich-text" formatting
len := UTF8Length(AValue);
textp := '<text:p>';
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 +
'<text:span text:style-name="' + FRichTextFontList[idx] + '">' +
txt +
'</text:span>';
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 + '</text:p>';
end;
end;
// Write it ...
AppendToStream(AStream, Format(

74
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -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 <b>spreadsheet documents</b> 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.
@ -3464,12 +3488,19 @@ end;
@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;
{@@ ----------------------------------------------------------------------------
@ -3480,6 +3511,11 @@ end;
@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 }

17
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -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);
{

4
components/fpspreadsheet/fpstypes.pas
View File

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

22
components/fpspreadsheet/fpsvisualutils.pas
View File

@ -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,11 +266,11 @@ 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);
end;
end;
ACanvas.Font.Size := round(fnt.Size * SUBSCRIPT_SUPERSCRIPT_FACTOR);
AFontPos := fnt.Position;
end;
end;
end;
procedure ScanLine(var P: PChar; var NumSpaces: Integer;
var PendingRtpIndex: Integer; var width, height: 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);

118
components/fpspreadsheet/fpsxmlcommon.pas
View File

@ -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,25 +75,99 @@ 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
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(stream);
src := TXMLInputSource.Create(AStream);
try
parser.Parse(src, ADoc);
finally
@ -95,9 +176,6 @@ begin
finally
parser.Free;
end;
finally
stream.Free;
end;
end;
procedure UnzipFile(AZipFileName, AZippedFile, ADestFolder: String);
@ -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.

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

@ -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);
@ -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,9 +293,14 @@ 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;
@ -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]));

183
components/fpspreadsheet/xlsbiff5.pas
View File

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

1160
components/fpspreadsheet/xlsbiff8.pas
View File

File diff suppressed because it is too large Load Diff

89
components/fpspreadsheet/xlscommon.pas
View File

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

302
components/fpspreadsheet/xlsxooxml.pas
View File

@ -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,11 +1156,14 @@ begin
node := node.NextSibling;
end;
// Check whether font is already contained in font list
// 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 (fnt.FontName = fntName) and
if SameText(fnt.FontName, fntName) and
(fnt.Size = fntSize) and
(fnt.Style = fntStyles) and
(fnt.Color = fntColor) and
@ -1167,7 +1172,10 @@ begin
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<n>.xml" files (n = 1, 2, ...)
The relationship which comment belongs to which sheet file must be
retrieved from the "sheet<n>.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<n>.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('<sz val="%g" />', [AFont.Size], FPointSeparatorSettings);
s := s + Format('<name val="%s" />', [AFont.FontName]);
s := s + Format('<%s val="%s" />', [NAME_TAG[UseInStyleNode], AFont.FontName]);
if (fssBold in AFont.Style) then
s := s + '<b />';
if (fssItalic in AFont.Style) then
@ -2355,7 +2534,7 @@ begin
fpSuperscript: s := s + '<vertAlign val="superscript" />';
end;
AppendToStream(AStream, Format(
'<%s>%s</%s>', [ATag, s, ATag]));
'<%s>%s</%s>', [TAG[UseInStyleNode], s, TAG[UseInStyleNode]]));
end;
{ Writes the fontlist of the workbook to the stream. }
@ -2368,7 +2547,7 @@ begin
'<fonts count="%d">', [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,
'</fonts>');
@ -3606,8 +3785,14 @@ 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)
]);
{ Write string to SharedString table }
if Length(ACell^.RichTextParams) = 0 then
// unformatted string
AppendToStream(FSSharedStrings,
'<si>' +
'<t>' + ResultingValue + '</t>' +
'<t>' + txt + '</t>' +
'</si>')
else
begin
// rich-text formatted string
L := UTF8Length(Resultingvalue);
AppendToStream(FSSharedStrings,
'<si>');
rtParam := ACell^.RichTextParams[0];
if rtParam.StartIndex > 0 then
begin
txt := UTF8Copy(ResultingValue, 1, rtParam.StartIndex);
ValidXMLText(txt);
AppendToStream(FSSharedStrings,
'<r>' +
'<t>' + txt + '</t>' +
'</r>'
);
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,
'<r>');
WriteFont(FSSharedStrings, fnt, false); // <rPr> ... font data ... </rPr>
AppendToStream(FSSharedStrings,
'<t>' + txt + '</t>' +
'</r>'
);
if (rtParam.EndIndex < L) and (i = High(ACell^.RichTextParams)) then
begin
txt := UTF8Copy(ResultingValue, rtParam.EndIndex+1, MaxInt);
ValidXMLText(txt);
AppendToStream(FSSharedStrings,
'<r>' +
'<t>' + txt + '</t>' +
'</r>'
)
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,
'<r>' +
'<t>' + txt + '</t>' +
'</r>'
);
end;
end;
AppendToStream(FSSharedStrings,
'</si>');
end;
{ Write shared string index to cell record }
CellPosText := TsWorksheet.CellPosToText(ARow, ACol);
lStyleIndex := GetStyleIndex(ACell);