{
fpsopendocument.pas
Writes an OpenDocument 1.0 Spreadsheet document
An OpenDocument document is a compressed ZIP file with the following files inside:
content.xml - Actual contents
meta.xml - Authoring data
settings.xml - User persistent viewing information, such as zoom, cursor position, etc.
styles.xml - Styles, which are the only way to do formatting
mimetype - application/vnd.oasis.opendocument.spreadsheet
META-INF\manifest.xml - Describes the other files in the archive
Specifications obtained from:
http://docs.oasis-open.org/office/v1.1/OS/OpenDocument-v1.1.pdf
AUTHORS: Felipe Monteiro de Carvalho / Jose Luis Jurado Rincon
}
unit fpsopendocument;
{$ifdef fpc}
{$mode objfpc}{$H+}
{$endif}
{.$define FPSPREADDEBUG} //used to be XLSDEBUG
interface
uses
Classes, SysUtils,
laz2_xmlread, laz2_DOM,
AVL_Tree, math, dateutils,
{$IF FPC_FULLVERSION >= 20701}
zipper,
{$ELSE}
fpszipper,
{$ENDIF}
fpstypes, fpspreadsheet, fpsReaderWriter,
fpsutils, fpsNumFormat, fpsNumFormatParser, fpsxmlcommon;
type
TDateMode=(
dm1899 {default for ODF; almost same as Excel 1900},
dm1900 {StarCalc legacy only},
dm1904 {e.g. Quattro Pro,Mac Excel compatibility}
);
{ TsSpreadOpenDocNumFormatList }
TsSpreadOpenDocNumFormatList = class(TsCustomNumFormatList)
protected
procedure AddBuiltinFormats; override;
public
end;
{ TsSpreadOpenDocNumFormatParser }
TsSpreadOpenDocNumFormatParser = class(TsNumFormatParser)
private
function BuildCurrencyXMLAsString(ASection: Integer): String;
function BuildDateTimeXMLAsString(ASection: Integer;
out AIsTimeOnly, AIsInterval: Boolean): String;
protected
function BuildXMLAsStringFromSection(ASection: Integer;
AFormatName: String): String;
public
function BuildXMLAsString(AFormatName: String): String;
end;
{ TsSpreadOpenDocReader }
TsSpreadOpenDocReader = class(TsSpreadXMLReader)
private
FColumnStyleList: TFPList;
FColumnList: TFPList;
FRowStyleList: TFPList;
FRowList: TFPList;
FVolatileNumFmtList: TsCustomNumFormatList;
FDateMode: TDateMode;
// Applies internally stored column widths to current worksheet
procedure ApplyColWidths;
// Applies a style to a cell
function ApplyStyleToCell(ACell: PCell; AStyleName: String): Boolean;
// Extracts a boolean value from the xml node
function ExtractBoolFromNode(ANode: TDOMNode): Boolean;
// Extracts the date/time value from the xml node
function ExtractDateTimeFromNode(ANode: TDOMNode;
ANumFormat: TsNumberFormat; const AFormatStr: String): TDateTime;
// Searches a column style by its column index or its name in the StyleList
function FindColumnByCol(AColIndex: Integer): Integer;
function FindColStyleByName(AStyleName: String): integer;
function FindRowStyleByName(AStyleName: String): Integer;
procedure ReadColumns(ATableNode: TDOMNode);
procedure ReadColumnStyle(AStyleNode: TDOMNode);
// Figures out the base year for times in this file (dates are unambiguous)
procedure ReadDateMode(SpreadSheetNode: TDOMNode);
function ReadFont(ANode: TDOMnode; IsDefaultFont: Boolean): Integer;
procedure ReadRowsAndCells(ATableNode: TDOMNode);
procedure ReadRowStyle(AStyleNode: TDOMNode);
protected
FPointSeparatorSettings: TFormatSettings;
procedure CreateNumFormatList; override;
procedure ReadNumFormats(AStylesNode: TDOMNode);
procedure ReadSettings(AOfficeSettingsNode: TDOMNode);
procedure ReadStyles(AStylesNode: TDOMNode);
{ Record writing methods }
procedure ReadBlank(ARow, ACol: Cardinal; ACellNode: TDOMNode); reintroduce;
procedure ReadBoolean(ARow, ACol: Cardinal; ACellNode: TDOMNode);
procedure ReadComment(ARow, ACol: Cardinal; ACellNode: TDOMNode);
procedure ReadDateTime(ARow, ACol: Cardinal; ACellNode: TDOMNode);
procedure ReadFormula(ARow, ACol: Cardinal; ACellNode: TDOMNode); reintroduce;
procedure ReadLabel(ARow, ACol: Cardinal; ACellNode: TDOMNode); reintroduce;
procedure ReadNumber(ARow, ACol: Cardinal; ACellNode: TDOMNode); reintroduce;
public
constructor Create(AWorkbook: TsWorkbook); override;
destructor Destroy; override;
{ General reading methods }
procedure ReadFromFile(AFileName: string); override;
procedure ReadFromStream(AStream: TStream); override;
end;
{ TsSpreadOpenDocWriter }
TsSpreadOpenDocWriter = class(TsCustomSpreadWriter)
private
FColumnStyleList: TFPList;
FRowStyleList: TFPList;
// Routines to write parts of files
procedure WriteCellStyles(AStream: TStream);
procedure WriteColStyles(AStream: TStream);
procedure WriteColumns(AStream: TStream; ASheet: TsWorksheet);
procedure WriteFontNames(AStream: TStream);
procedure WriteNumFormats(AStream: TStream);
procedure WriteRowStyles(AStream: TStream);
procedure WriteRowsAndCells(AStream: TStream; ASheet: TsWorksheet);
procedure WriteTableSettings(AStream: TStream);
procedure WriteVirtualCells(AStream: TStream; ASheet: TsWorksheet);
function WriteBackgroundColorStyleXMLAsString(const AFormat: TsCellFormat): String;
function WriteBorderStyleXMLAsString(const AFormat: TsCellFormat): String;
function WriteCommentXMLAsString(AComment: String): String;
function WriteDefaultFontXMLAsString: String;
function WriteFontStyleXMLAsString(const AFormat: TsCellFormat): String;
function WriteHorAlignmentStyleXMLAsString(const AFormat: TsCellFormat): String;
function WriteTextRotationStyleXMLAsString(const AFormat: TsCellFormat): String;
function WriteVertAlignmentStyleXMLAsString(const AFormat: TsCellFormat): String;
function WriteWordwrapStyleXMLAsString(const AFormat: TsCellFormat): String;
protected
FPointSeparatorSettings: TFormatSettings;
// Streams with the contents of files
FSMeta, FSSettings, FSStyles, FSContent, FSMimeType, FSMetaInfManifest: TStream;
{ Helpers }
procedure CreateNumFormatList; override;
procedure CreateStreams;
procedure DestroyStreams;
procedure ListAllColumnStyles;
procedure ListAllNumFormats; override;
procedure ListAllRowStyles;
procedure ResetStreams;
{ Routines to write those files }
procedure WriteContent;
procedure WriteMimetype;
procedure WriteMetaInfManifest;
procedure WriteMeta;
procedure WriteSettings;
procedure WriteStyles;
procedure WriteWorksheet(AStream: TStream; CurSheet: TsWorksheet);
{ Record writing methods }
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); override;
procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: Boolean; ACell: PCell); override;
procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: TDateTime; ACell: PCell); override;
procedure WriteError(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: TsErrorValue; ACell: PCell); override;
procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); override;
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: string; ACell: PCell); override;
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: double; ACell: PCell); override;
public
constructor Create(AWorkbook: TsWorkbook); override;
destructor Destroy; override;
{ General writing methods }
procedure WriteStringToFile(AString, AFileName: string);
procedure WriteToFile(const AFileName: string;
const AOverwriteExisting: Boolean = False); override;
procedure WriteToStream(AStream: TStream); override;
end;
implementation
uses
StrUtils, Variants, LazFileUtils, URIParser,
fpsPatches, fpsStrings, fpsStreams, fpsExprParser;
const
{ OpenDocument general XML constants }
XML_HEADER = '';
{ OpenDocument Directory structure constants }
OPENDOC_PATH_CONTENT = 'content.xml';
OPENDOC_PATH_META = 'meta.xml';
OPENDOC_PATH_SETTINGS = 'settings.xml';
OPENDOC_PATH_STYLES = 'styles.xml';
OPENDOC_PATH_MIMETYPE = 'mimetype';
{%H-}OPENDOC_PATH_METAINF = 'META-INF' + '/';
{%H-}OPENDOC_PATH_METAINF_MANIFEST = 'META-INF' + '/' + 'manifest.xml';
{ OpenDocument schemas constants }
SCHEMAS_XMLNS_OFFICE = 'urn:oasis:names:tc:opendocument:xmlns:office:1.0';
SCHEMAS_XMLNS_DCTERMS = 'http://purl.org/dc/terms/';
SCHEMAS_XMLNS_META = 'urn:oasis:names:tc:opendocument:xmlns:meta:1.0';
SCHEMAS_XMLNS = 'http://schemas.openxmlformats.org/officeDocument/2006/extended-properties';
SCHEMAS_XMLNS_CONFIG = 'urn:oasis:names:tc:opendocument:xmlns:config:1.0';
SCHEMAS_XMLNS_OOO = 'http://openoffice.org/2004/office';
SCHEMAS_XMLNS_MANIFEST = 'urn:oasis:names:tc:opendocument:xmlns:manifest:1.0';
SCHEMAS_XMLNS_FO = 'urn:oasis:names:tc:opendocument:xmlns:xsl-fo-compatible:1.0';
SCHEMAS_XMLNS_STYLE = 'urn:oasis:names:tc:opendocument:xmlns:style:1.0';
SCHEMAS_XMLNS_SVG = 'urn:oasis:names:tc:opendocument:xmlns:svg-compatible:1.0';
SCHEMAS_XMLNS_TABLE = 'urn:oasis:names:tc:opendocument:xmlns:table:1.0';
SCHEMAS_XMLNS_TEXT = 'urn:oasis:names:tc:opendocument:xmlns:text:1.0';
SCHEMAS_XMLNS_V = 'urn:schemas-microsoft-com:vml';
SCHEMAS_XMLNS_NUMBER = 'urn:oasis:names:tc:opendocument:xmlns:datastyle:1.0';
SCHEMAS_XMLNS_CHART = 'urn:oasis:names:tc:opendocument:xmlns:chart:1.0';
SCHEMAS_XMLNS_DR3D = 'urn:oasis:names:tc:opendocument:xmlns:dr3d:1.0';
SCHEMAS_XMLNS_MATH = 'http://www.w3.org/1998/Math/MathML';
SCHEMAS_XMLNS_FORM = 'urn:oasis:names:tc:opendocument:xmlns:form:1.0';
SCHEMAS_XMLNS_SCRIPT = 'urn:oasis:names:tc:opendocument:xmlns:script:1.0';
SCHEMAS_XMLNS_OOOW = 'http://openoffice.org/2004/writer';
SCHEMAS_XMLNS_OOOC = 'http://openoffice.org/2004/calc';
SCHEMAS_XMLNS_DOM = 'http://www.w3.org/2001/xml-events';
SCHEMAS_XMLNS_XFORMS = 'http://www.w3.org/2002/xforms';
SCHEMAS_XMLNS_XSD = 'http://www.w3.org/2001/XMLSchema';
SCHEMAS_XMLNS_XSI = 'http://www.w3.org/2001/XMLSchema-instance';
{ DATEMODE similar to but not the same as XLS format; used in time only values. }
DATEMODE_1899_BASE=0; //apparently 1899-12-30 for ODF in FPC DateTime;
// due to Excel's leap year bug, the date floats in the spreadsheets are the same starting
// 1900-03-01
DATEMODE_1900_BASE=2; //StarCalc compatibility, 1900-01-01 in FPC DateTime
DATEMODE_1904_BASE=1462; //1/1/1904 in FPC TDateTime
const
// lsThin, lsMedium, lsDashed, lsDotted, lsThick, lsDouble, lsHair)
BORDER_LINESTYLES: array[TsLineStyle] of string =
('solid', 'solid', 'dashed', 'fine-dashed', 'solid', 'double', 'dotted');
BORDER_LINEWIDTHS: array[TsLinestyle] of string =
('0.002cm', '2pt', '0.002cm', '0.002cm', '3pt', '0.039cm', '0.002cm');
FALSE_TRUE: Array[boolean] of String = ('false', 'true');
COLWIDTH_EPS = 1e-2; // for mm
ROWHEIGHT_EPS = 1e-2; // for lines
type
{ Column style items stored in ColStyleList of the reader }
TColumnStyleData = class
public
Name: String;
ColWidth: Double; // in mm
end;
{ Column data items stored in the ColumnList }
TColumnData = class
public
Col: Integer;
ColStyleIndex: integer; // index into FColumnStyleList of reader
DefaultCellStyleIndex: Integer; // Index of default cell style in FCellStyleList of reader
end;
{ Row style items stored in RowStyleList of the reader }
TRowStyleData = class
public
Name: String;
RowHeight: Double; // in mm
AutoRowHeight: Boolean;
end;
(* --- presently not used, but this may change... ---
{ Row data items stored in the RowList of the reader }
TRowData = class
Row: Integer;
RowStyleIndex: Integer; // index into FRowStyleList of reader
DefaultCellStyleIndex: Integer; // Index of default row style in FCellStyleList of reader
end;
*)
{ TsSpreadOpenDocNumFormatList }
procedure TsSpreadOpenDocNumFormatList.AddBuiltinFormats;
begin
AddFormat('N0', nfGeneral, '');
end;
{ TsSpreadOpenDocNumFormatParser }
function TsSpreadOpenDocNumFormatParser.BuildCurrencyXMLAsString(ASection: Integer): String;
var
el: Integer;
clr: TsColorValue;
nf: TsNumberFormat;
decs: byte;
s: String;
begin
Result := '';
el := 0;
with FSections[ASection] do
while el < Length(Elements) do
begin
case Elements[el].Token of
nftColor:
begin
clr := FWorkbook.GetPaletteColor(Elements[el].IntValue);
Result := Result +
' ';
inc(el);
end;
nftSign, nftSignBracket:
begin
Result := Result +
' ' + Elements[el].TextValue + '';
inc(el);
end;
nftSpace:
begin
Result := Result +
' ';
inc(el);
end;
nftCurrSymbol:
begin
Result := Result +
' ' + Elements[el].TextValue +
'';
inc(el);
end;
nftOptDigit:
if IsNumberAt(ASection, el, nf, decs, el) then
Result := Result +
' ';
nftDigit:
if IsNumberAt(ASection, el, nf, decs, el) then
Result := Result +
' ';
nftRepeat:
begin
if FSections[ASection].Elements[el].TextValue = ' ' then
s := '' else
s := FSections[ASection].Elements[el].TextValue;
Result := Result +
' ' + s + '';
inc(el);
end
else
inc(el);
end; // case
end; // while
end;
function TsSpreadOpenDocNumFormatParser.BuildDateTimeXMLAsString(ASection: Integer;
out AIsTimeOnly, AIsInterval: boolean): String;
var
el: Integer;
s: String;
prevTok: TsNumFormatToken;
begin
Result := '';
AIsTimeOnly := true;
AIsInterval := false;
with FSections[ASection] do
begin
el := 0;
while el < Length(Elements) do
begin
case Elements[el].Token of
nftYear:
begin
prevTok := Elements[el].Token;
AIsTimeOnly := false;
s := IfThen(Elements[el].IntValue > 2, 'number:style="long" ', '');
Result := Result +
'';
end;
nftMonth:
begin
prevTok := Elements[el].Token;
AIsTimeOnly := false;
case Elements[el].IntValue of
1: s := '';
2: s := 'number:style="long" ';
3: s := 'number:textual="true" ';
4: s := 'number:style="long" number:textual="true" ';
end;
Result := result +
'';
end;
nftDay:
begin
prevTok := Elements[el].Token;
AIsTimeOnly := false;
case Elements[el].IntValue of
1: s := 'day ';
2: s := 'day number:style="long" ';
3: s := 'day-of-week ';
4: s := 'day-of-week number:style="long" ';
end;
Result := Result +
'';
end;
nftHour, nftMinute, nftSecond:
begin
prevTok := Elements[el].Token;
case Elements[el].Token of
nftHour : s := 'hours ';
nftMinute: s := 'minutes ';
nftSecond: s := 'seconds ';
end;
s := s + IfThen(abs(Elements[el].IntValue) = 1, '', 'number:style="long" ');
if Elements[el].IntValue < 0 then
AIsInterval := true;
Result := Result +
'';
end;
nftMilliseconds:
begin
// ???
end;
nftDateTimeSep, nftText, nftEscaped, nftSpace:
begin
if Elements[el].TextValue = ' ' then
s := ''
else
begin
s := Elements[el].TextValue;
if (s = '/') then
begin
if prevTok in [nftYear, nftMonth, nftDay] then
s := FWorkbook.FormatSettings.DateSeparator
else
s := FWorkbook.FormatSettings.TimeSeparator;
end;
end;
Result := Result +
'' + s + '';
end;
nftAMPM:
Result := Result +
'';
end;
inc(el);
end;
end;
end;
function TsSpreadOpenDocNumFormatParser.BuildXMLAsString(AFormatName: String): String;
var
i: Integer;
begin
Result := '';
{ When there is only one section the next statement is the only one executed.
When there are several sections the file contains at first the
positive section (index 0), then the negative section (index 1), and
finally the zero section (index 2) which contains the style-map. }
for i:=0 to Length(FSections)-1 do
Result := Result + BuildXMLAsStringFromSection(i, AFormatName);
end;
function TsSpreadOpenDocNumFormatParser.BuildXMLAsStringFromSection(
ASection: Integer; AFormatName: String): String;
var
nf : TsNumberFormat;
decs: Byte;
expdig: Integer;
next: Integer;
sGrouping: String;
sColor: String;
sStyleMap: String;
ns: Integer;
clr: TsColorvalue;
el: Integer;
s: String;
isTimeOnly: Boolean;
isInterval: Boolean;
begin
Result := '';
sGrouping := '';
sColor := '';
sStyleMap := '';
ns := Length(FSections);
if (ns = 0) then
exit;
if (ns > 1) then
begin
// The file corresponding to the last section contains the styleMap.
if (ASection = ns - 1) then
case ns of
2: sStyleMap :=
''; // >= 0
3: sStyleMap :=
' 0
'style:condition="value()>0" />' +
'';
else
raise Exception.Create('At most 3 format sections allowed.');
end
else
AFormatName := AFormatName + 'P' + IntToStr(ASection);
end;
with FSections[ASection] do
begin
next := 0;
if IsTokenAt(nftColor, ASection, 0) then
begin
clr := FWorkbook.GetPaletteColor(Elements[0].IntValue);
sColor := '' + LineEnding;
next := 1;
end;
if IsNumberAt(ASection, next, nf, decs, next) then
begin
if nf = nfFixedTh then
sGrouping := 'number:grouping="true" ';
// nfFixed, nfFixedTh
if (next = Length(Elements)) then
begin
Result :=
'' +
sColor +
'' +
sStylemap +
'';
exit;
end;
// nfPercentage
if IsTokenAt(nftPercent, ASection, next) and (next+1 = Length(Elements)) then
begin
Result :=
'' +
sColor +
'' +
'%' +
sStyleMap +
'';
exit;
end;
// nfExp
if (nf = nfFixed) and IsTokenAt(nftExpChar, ASection, next) then
begin
if (next + 2 < Length(Elements)) and
IsTokenAt(nftExpSign, ASection, next+1) and
IsTokenAt(nftExpDigits, ASection, next+2)
then
expdig := Elements[next+2].IntValue
else
if (next + 1 < Length(Elements)) and
IsTokenAt(nftExpDigits, ASection, next+1)
then
expdig := Elements[next+1].IntValue
else
exit;
Result :=
'' +
sColor +
'' +
sStylemap +
'';
exit;
end;
end;
// If the program gets here the format can only be nfSci, nfCurrency or date/time.
el := 0;
decs := 0;
while el < Length(Elements) do
begin
case Elements[el].Token of
nftDecs:
decs := Elements[el].IntValue; // ???
nftExpChar:
// nfSci: not supported by ods, use nfExp instead.
begin
while el < Length(Elements) do
begin
if Elements[el].Token = nftExpDigits then
begin
expdig := Elements[el].IntValue;
Result :=
'' +
sColor +
'' +
sStylemap +
'';
exit;
end;
inc(el);
end;
exit;
end;
// Currency
nftCurrSymbol:
begin
Result :=
'' +
BuildCurrencyXMLAsString(ASection) +
sStyleMap +
'';
exit;
end;
// date/time
nftYear, nftMonth, nftDay, nftHour, nftMinute, nftSecond:
begin
s := BuildDateTimeXMLAsString(ASection, isTimeOnly, isInterval);
if isTimeOnly then
begin
Result := Result +
'' +
s +
'';
end else
Result := Result +
'' +
s +
'';
exit;
end;
end;
inc(el);
end;
end;
end;
{ TsSpreadOpenDocReader }
constructor TsSpreadOpenDocReader.Create(AWorkbook: TsWorkbook);
begin
inherited Create(AWorkbook);
FPointSeparatorSettings := DefaultFormatSettings;
FPointSeparatorSettings.DecimalSeparator := '.';
FPointSeparatorSettings.ListSeparator := ';'; // for formulas
FCellFormatList := TsCellFormatList.Create(true);
// Allow duplicates because style names used in cell records will not be found any more.
FColumnStyleList := TFPList.Create;
FColumnList := TFPList.Create;
FRowStyleList := TFPList.Create;
FRowList := TFPList.Create;
FVolatileNumFmtList := TsCustomNumFormatList.Create(Workbook);
// Set up the default palette in order to have the default color names correct.
Workbook.UseDefaultPalette;
// Initial base date in case it won't be read from file
FDateMode := dm1899;
end;
destructor TsSpreadOpenDocReader.Destroy;
var
j: integer;
begin
for j := FColumnList.Count-1 downto 0 do TObject(FColumnList[j]).Free;
FColumnList.Free;
for j := FColumnStyleList.Count-1 downto 0 do TObject(FColumnStyleList[j]).Free;
FColumnStyleList.Free;
for j := FRowList.Count-1 downto 0 do TObject(FRowList[j]).Free;
FRowList.Free;
for j := FRowStyleList.Count-1 downto 0 do TObject(FRowStyleList[j]).Free;
FRowStyleList.Free;
FVolatileNumFmtList.Free; // automatically destroys its items.
inherited Destroy;
end;
{ Creates for each non-default column width stored internally in FColumnList
a TCol record in the current worksheet. }
procedure TsSpreadOpenDocReader.ApplyColWidths;
var
colIndex: Integer;
colWidth: Single;
colStyleIndex: Integer;
colStyle: TColumnStyleData;
factor: Double;
col: PCol;
i: Integer;
begin
factor := FWorkbook.GetFont(0).Size/2;
for i:=0 to FColumnList.Count-1 do
begin
colIndex := TColumnData(FColumnList[i]).Col;
colStyleIndex := TColumnData(FColumnList[i]).ColStyleIndex;
colStyle := TColumnStyleData(FColumnStyleList[colStyleIndex]);
{ The column width stored in colStyle is in mm (see ReadColumnStyles).
We convert it to character count by converting it to points and then by
dividing the points by the approximate width of the '0' character which
is assumed to be 50% of the default font point size. }
colWidth := mmToPts(colStyle.ColWidth)/factor;
{ Add only column records to the worksheet if their width is different from
the default column width. }
if not SameValue(colWidth, FWorksheet.DefaultColWidth, COLWIDTH_EPS) then
begin
col := FWorksheet.GetCol(colIndex);
col^.Width := colWidth;
end;
end;
end;
{ Applies the style data referred to by the style name to the specified cell
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;
styleIndex: Integer;
i: Integer;
begin
Result := false;
if FWorksheet.HasHyperlink(ACell) then
FWorksheet.WriteFont(ACell, HYPERLINK_FONTINDEX);
// Is there a style attached to the cell?
styleIndex := -1;
if AStyleName <> '' then
styleIndex := FCellFormatList.FindIndexOfName(AStyleName);
if (styleIndex = -1) then
begin
// No - look for the style attached to the column of the cell and
// find the cell style by the DefaultCellStyleIndex stored in the column list.
i := FindColumnByCol(ACell^.Col);
if i = -1 then
exit;
styleIndex := TColumnData(FColumnList[i]).DefaultCellStyleIndex;
end;
fmt := FCellFormatList.Items[styleIndex];
ACell^.FormatIndex := FWorkbook.AddCellFormat(fmt^);
Result := true;
end;
{ Creates the correct version of the number format list
suited for ODS file formats. }
procedure TsSpreadOpenDocReader.CreateNumFormatList;
begin
FreeAndNil(FNumFormatList);
FNumFormatList := TsSpreadOpenDocNumFormatList.Create(Workbook);
end;
{ Extracts a boolean value from a "boolean" cell node.
Is called from ReadBoolean }
function TsSpreadOpenDocReader.ExtractBoolFromNode(ANode: TDOMNode): Boolean;
var
value: String;
begin
value := GetAttrValue(ANode, 'office:boolean-value');
if (lowercase(value) = 'true') then
Result := true
else
Result := false;
end;
{ Extracts a date/time value from a "date-value" or "time-value" cell node.
Requires the number format and format strings to optimize agreement with
fpc date/time values.
Is called from "ReadDateTime". }
function TsSpreadOpenDocReader.ExtractDateTimeFromNode(ANode: TDOMNode;
ANumFormat: TsNumberFormat; const AFormatStr: String): TDateTime;
var
Value: String;
Fmt : TFormatSettings;
FoundPos : integer;
Hours, Minutes, Days: integer;
Seconds: Double;
HoursPos, MinutesPos, SecondsPos: integer;
begin
Unused(AFormatStr);
// Format expects ISO 8601 type date string or
// time string
fmt := DefaultFormatSettings;
fmt.ShortDateFormat := 'yyyy-mm-dd';
fmt.DateSeparator := '-';
fmt.LongTimeFormat := 'hh:nn:ss';
fmt.TimeSeparator := ':';
Value := GetAttrValue(ANode, 'office:date-value');
if Value <> '' then
begin
// Date or date/time string
Value := StringReplace(Value,'T',' ',[rfIgnoreCase,rfReplaceAll]);
// Strip milliseconds?
FoundPos := Pos('.',Value);
if (FoundPos > 1) then
Value := Copy(Value, 1, FoundPos-1);
Result := StrToDateTime(Value, Fmt);
// If the date/time is within 1 day of the base date the value is most
// probably a time-only value (< 1).
// We need to subtract the datemode offset, otherwise the date/time value
// would not be < 1 for fpc.
case FDateMode of
dm1899: if Result - DATEMODE_1899_BASE < 1 then Result := Result - DATEMODE_1899_BASE;
dm1900: if Result - DATEMODE_1900_BASE < 1 then Result := Result - DATEMODE_1900_BASE;
dm1904: if Result - DATEMODE_1904_BASE < 1 then Result := Result - DATEMODE_1904_BASE;
end;
end else begin
// Try time only, e.g. PT23H59M59S
// 12345678901
Value := GetAttrValue(ANode, 'office:time-value');
if (Value <> '') and (Pos('PT', Value) = 1) then
begin
// Get hours
HoursPos := Pos('H', Value);
if (HoursPos > 0) then
Hours := StrToInt(Copy(Value, 3, HoursPos-3))
else
Hours := 0;
// Get minutes
MinutesPos := Pos('M', Value);
if (MinutesPos > 0) and (MinutesPos > HoursPos) then
Minutes := StrToInt(Copy(Value, HoursPos+1, MinutesPos-HoursPos-1))
else
Minutes := 0;
// Get seconds
SecondsPos := Pos('S', Value);
if (SecondsPos > 0) and (SecondsPos > MinutesPos) then
Seconds := StrToFloat(Copy(Value, MinutesPos+1, SecondsPos-MinutesPos-1), FPointSeparatorSettings)
else
Seconds := 0;
Days := Hours div 24;
Hours := Hours mod 24;
Result := Days + (Hours + (Minutes + Seconds/60)/60)/24;
{ Values < 1 day are certainly time-only formats --> no datemode correction
nfTimeInterval formats are differences --> no date mode correction
In all other case, we have a date part that needs to be corrected for
the file's datemode. }
if (ANumFormat <> nfTimeInterval) and (abs(Days) > 0) then
begin
case FDateMode of
dm1899: Result := Result + DATEMODE_1899_BASE;
dm1900: Result := Result + DATEMODE_1900_BASE;
dm1904: Result := Result + DATEMODE_1904_BASE;
end;
end;
end;
end;
end;
function TsSpreadOpenDocReader.FindColumnByCol(AColIndex: Integer): Integer;
begin
for Result := 0 to FColumnList.Count-1 do
if TColumnData(FColumnList[Result]).Col = AColIndex then
exit;
Result := -1;
end;
function TsSpreadOpenDocReader.FindColStyleByName(AStyleName: String): Integer;
begin
for Result := 0 to FColumnStyleList.Count-1 do
if TColumnStyleData(FColumnStyleList[Result]).Name = AStyleName then
exit;
Result := -1;
end;
function TsSpreadOpenDocReader.FindRowStyleByName(AStyleName: String): Integer;
begin
for Result := 0 to FRowStyleList.Count-1 do
if TRowStyleData(FRowStyleList[Result]).Name = AStyleName then
exit;
Result := -1;
end;
procedure TsSpreadOpenDocReader.ReadBlank(ARow, ACol: Cardinal;
ACellNode: TDOMNode);
var
styleName: String;
cell: PCell;
lCell: TCell;
begin
// a temporary cell record to store the formatting if there is any
lCell.Row := ARow; // to silence a compiler warning...
InitCell(ARow, ACol, lCell);
lCell.ContentType := cctEmpty;
styleName := GetAttrValue(ACellNode, 'table:style-name');
if not ApplyStyleToCell(@lCell, stylename) then
exit;
// No need to store a record for an empty, unformatted cell
if FIsVirtualMode then
begin
InitCell(ARow, ACol, FVirtualCell);
cell := @FVirtualCell;
end else
cell := FWorksheet.GetCell(ARow, ACol);
FWorkSheet.WriteBlank(cell);
FWorksheet.CopyFormat(@lCell, cell);
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
procedure TsSpreadOpenDocReader.ReadBoolean(ARow, ACol: Cardinal;
ACellNode: TDOMNode);
var
styleName: String;
cell: PCell;
boolValue: Boolean;
begin
if FIsVirtualMode then
begin
InitCell(ARow, ACol, FVirtualCell);
cell := @FVirtualCell;
end else
cell := FWorksheet.GetCell(ARow, ACol);
boolValue := ExtractBoolFromNode(ACellNode);
FWorkSheet.WriteBoolValue(cell, boolValue);
styleName := GetAttrValue(ACellNode, 'table:style-name');
ApplyStyleToCell(cell, stylename);
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
{ Collection columns used in the given table. The columns contain links to
styles that must be used when cells in that columns are without styles. }
procedure TsSpreadOpenDocReader.ReadColumns(ATableNode: TDOMNode);
var
col: Integer;
colNode: TDOMNode;
s: String;
defCellStyleIndex: Integer;
colStyleIndex: Integer;
colData: TColumnData;
colsRepeated: Integer;
j: Integer;
begin
// clear previous column list (from other sheets)
for j := FColumnList.Count-1 downto 0 do TObject(FColumnList[j]).Free;
FColumnList.Clear;
col := 0;
colNode := ATableNode.FindNode('table:table-column');
while Assigned(colNode) do
begin
if colNode.NodeName = 'table:table-column' then
begin;
s := GetAttrValue(colNode, 'table:style-name');
colStyleIndex := FindColStyleByName(s);
if colStyleIndex <> -1 then
begin
defCellStyleIndex := -1;
s := GetAttrValue(ColNode, 'table:default-cell-style-name');
if s <> '' then
begin
defCellStyleIndex := FCellFormatList.FindIndexOfName(s); //FindCellStyleByName(s);
colData := TColumnData.Create;
colData.Col := col;
colData.ColStyleIndex := colStyleIndex;
colData.DefaultCellStyleIndex := defCellStyleIndex;
FColumnList.Add(colData);
end;
s := GetAttrValue(ColNode, 'table:number-columns-repeated');
if s = '' then
inc(col)
else
begin
colsRepeated := StrToInt(s);
if defCellStyleIndex > -1 then
for j:=1 to colsRepeated-1 do
begin
colData := TColumnData.Create;
colData.Col := col + j;
colData.ColStyleIndex := colStyleIndex;
colData.DefaultCellStyleIndex := defCellStyleIndex;
FColumnList.Add(colData);
end;
inc(col, colsRepeated);
end;
end;
end;
colNode := colNode.NextSibling;
end;
end;
{ Reads the column styles and stores them in the FColumnStyleList for later use }
procedure TsSpreadOpenDocReader.ReadColumnStyle(AStyleNode: TDOMNode);
var
colStyle: TColumnStyleData;
styleName: String;
styleChildNode: TDOMNode;
colWidth: double;
s: String;
begin
styleName := GetAttrValue(AStyleNode, 'style:name');
styleChildNode := AStyleNode.FirstChild;
colWidth := -1;
while Assigned(styleChildNode) do
begin
if styleChildNode.NodeName = 'style:table-column-properties' then
begin
s := GetAttrValue(styleChildNode, 'style:column-width');
if s <> '' then
begin
colWidth := PtsToMM(HTMLLengthStrToPts(s)); // convert to mm
break;
end;
end;
styleChildNode := styleChildNode.NextSibling;
end;
colStyle := TColumnStyleData.Create;
colStyle.Name := styleName;
colStyle.ColWidth := colWidth;
FColumnStyleList.Add(colStyle);
end;
procedure TsSpreadOpenDocReader.ReadComment(ARow, ACol: Cardinal;
ACellNode: TDOMNode);
var
cellChildNode, pNode, pChildNode: TDOMNode;
comment, line: String;
nodeName: String;
s: String;
found: Boolean;
begin
if ACellNode = nil then
exit;
comment := '';
found := false;
cellChildNode := ACellNode.FirstChild;
while cellChildNode <> nil do begin
nodeName := cellChildNode.NodeName;
if nodeName = 'office:annotation' then begin
pNode := cellChildNode.FirstChild;
while pNode <> nil do begin
nodeName := pNode.NodeName;
if nodeName = 'text:p' then
begin
line := '';
pChildNode := pNode.FirstChild;
while pChildNode <> nil do
begin
nodeName := pChildNode.NodeName;
if nodeName = '#text' then
begin
s := pChildNode.NodeValue;
line := IfThen(line = '', s, line + s);
found := true;
end else
if nodeName = 'text:span' then
begin
s := GetNodeValue(pChildNode);
line := IfThen(line = '', s, line + s);
found := true;
end;
pChildNode := pChildNode.NextSibling;
end;
comment := IfThen(comment = '', line, comment + LineEnding + line);
end;
pNode := pNode.NextSibling;
end;
end;
cellChildNode := cellChildNode.NextSibling;
end;
if found then
FWorksheet.WriteComment(ARow, ACol, comment);
end;
procedure TsSpreadOpenDocReader.ReadDateTime(ARow, ACol: Cardinal;
ACellNode : TDOMNode);
var
dt: TDateTime;
styleName: String;
cell: PCell;
fmt: PsCellFormat;
begin
if FIsVirtualMode then
begin
InitCell(ARow, ACol, FVirtualCell);
cell := @FVirtualCell;
end else
cell := FWorksheet.GetCell(ARow, ACol);
styleName := GetAttrValue(ACellNode, 'table:style-name');
ApplyStyleToCell(cell, stylename);
fmt := FWorkbook.GetPointerToCellFormat(cell^.FormatIndex);;
dt := ExtractDateTimeFromNode(ACellNode, fmt^.NumberFormat, fmt^.NumberFormatStr);
FWorkSheet.WriteDateTime(cell, dt, fmt^.NumberFormat, fmt^.NumberFormatStr);
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
procedure TsSpreadOpenDocReader.ReadDateMode(SpreadSheetNode: TDOMNode);
var
CalcSettingsNode, NullDateNode: TDOMNode;
NullDateSetting: string;
begin
// Default datemode for ODF:
NullDateSetting:='1899-12-30';
CalcSettingsNode:=SpreadsheetNode.FindNode('table:calculation-settings');
if Assigned(CalcSettingsNode) then
begin
NullDateNode:=CalcSettingsNode.FindNode('table:null-date');
if Assigned(NullDateNode) then
NullDateSetting:=GetAttrValue(NullDateNode,'table:date-value');
end;
if NullDateSetting='1899-12-30' then
FDateMode := dm1899
else if NullDateSetting='1900-01-01' then
FDateMode := dm1900
else if NullDateSetting='1904-01-01' then
FDateMode := dm1904
else
raise Exception.CreateFmt('Spreadsheet file corrupt: cannot handle null-date format %s', [NullDateSetting]);
end;
{ Reads font data from an xml node, adds the font to the workbooks FontList
(if not yet contained), and returns the index in the font list.
If "IsDefaultFont" is true the first FontList entry (DefaultFont) is replaced. }
function TsSpreadOpenDocReader.ReadFont(ANode: TDOMnode;
IsDefaultFont: Boolean): Integer;
var
fntName: String;
fntSize: Single;
fntStyles: TsFontStyles;
fntColor: TsColor;
s: String;
begin
if ANode = nil then
begin
Result := 0;
exit;
end;
fntName := GetAttrValue(ANode, 'style:font-name');
if fntName = '' then
fntName := FWorkbook.GetFont(0).FontName;
s := GetAttrValue(ANode, 'fo:font-size');
if s <> '' then
fntSize := HTMLLengthStrToPts(s)
else
fntSize := FWorkbook.GetDefaultFontSize;
fntStyles := [];
if GetAttrValue(ANode, 'fo:font-style') = 'italic' then
Include(fntStyles, fssItalic);
if GetAttrValue(ANode, 'fo:font-weight') = 'bold' then
Include(fntStyles, fssBold);
s := GetAttrValue(ANode, 'style:text-underline-style');
if not ((s = '') or (s = 'none')) then
Include(fntStyles, fssUnderline);
s := GetAttrValue(ANode, 'style:text-strike-through-style');
if not ((s = '') or (s = 'none')) then
Include(fntStyles, fssStrikeout);
s := GetAttrValue(ANode, 'fo:color');
if s <> '' then
fntColor := FWorkbook.AddColorToPalette(HTMLColorStrToColor(s))
else
fntColor := FWorkbook.GetFont(0).Color;
if IsDefaultFont then
begin
FWorkbook.SetDefaultFont(fntName, fntSize);
Result := 0;
end
else
begin
Result := FWorkbook.FindFont(fntName, fntSize, fntStyles, fntColor);
if Result = -1 then
Result := FWorkbook.AddFont(fntName, fntSize, fntStyles, fntColor);
end;
end;
procedure TsSpreadOpenDocReader.ReadFormula(ARow, ACol: Cardinal;
ACellNode : TDOMNode);
var
cell: PCell;
formula: String;
stylename: String;
floatValue: Double;
boolValue: Boolean;
valueType: String;
valueStr: String;
node: TDOMNode;
parser: TsSpreadsheetParser;
p: Integer;
fmt: PsCellFormat;
begin
// Create cell and apply format
if FIsVirtualMode then
begin
InitCell(ARow, ACol, FVirtualCell);
cell := @FVirtualCell;
end else
cell := FWorksheet.GetCell(ARow, ACol);
styleName := GetAttrValue(ACellNode, 'table:style-name');
ApplyStyleToCell(cell, stylename);
fmt := Workbook.GetPointerToCellFormat(cell^.FormatIndex);
if (boReadFormulas in FWorkbook.Options) then
begin
// Read formula, trim it, ...
formula := GetAttrValue(ACellNode, 'table:formula');
if formula <> '' then
begin
// formulas written by Spread begin with 'of:=', our's with '=' --> remove that
p := pos('=', formula);
Delete(formula, 1, p);
end;
// ... convert to Excel dialect used by fps by defailt
parser := TsSpreadsheetParser.Create(FWorksheet);
try
parser.Dialect := fdOpenDocument;
parser.LocalizedExpression[FPointSeparatorSettings] := formula;
parser.Dialect := fdExcel;
formula := parser.Expression;
finally
parser.Free;
end;
// ... and store in cell's FormulaValue field.
cell^.FormulaValue := formula;
end;
// Read formula results
valueType := GetAttrValue(ACellNode, 'office:value-type');
valueStr := GetAttrValue(ACellNode, 'office:value');
// ODS wants a 0 in the NumberValue field in case of an error. If there is
// no error, this value will be corrected below.
cell^.NumberValue := 0.0;
// (a) number value
if (valueType = 'float') then
begin
if UpperCase(valueStr) = '1.#INF' then
FWorksheet.WriteNumber(cell, 1.0/0.0)
else
begin
floatValue := StrToFloat(valueStr, FPointSeparatorSettings);
FWorksheet.WriteNumber(cell, floatValue);
end;
if IsDateTimeFormat(fmt^.NumberFormat) then
begin
cell^.ContentType := cctDateTime;
// No datemode correction for intervals and for time-only values
if (fmt^.NumberFormat = nfTimeInterval) or (cell^.NumberValue < 1) then
cell^.DateTimeValue := cell^.NumberValue
else
case FDateMode of
dm1899: cell^.DateTimeValue := cell^.NumberValue + DATEMODE_1899_BASE;
dm1900: cell^.DateTimeValue := cell^.NumberValue + DATEMODE_1900_BASE;
dm1904: cell^.DateTimeValue := cell^.NumberValue + DATEMODE_1904_BASE;
end;
end;
end else
// (b) Date/time value
if (valueType = 'date') or (valueType = 'time') then
begin
floatValue := ExtractDateTimeFromNode(ACellNode, fmt^.NumberFormat, fmt^.NumberFormatStr);
FWorkSheet.WriteDateTime(cell, floatValue);
end else
// (c) text
if (valueType = 'string') then
begin
node := ACellNode.FindNode('text:p');
if (node <> nil) and (node.FirstChild <> nil) then
begin
valueStr := node.FirstChild.Nodevalue;
FWorksheet.WriteUTF8Text(cell, valueStr);
end;
end else
// (d) boolean
if (valuetype = 'boolean') then
begin
boolValue := ExtractBoolFromNode(ACellNode);
FWorksheet.WriteBoolValue(cell, boolValue);
end else
// (e) Text
FWorksheet.WriteUTF8Text(cell, valueStr);
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
procedure TsSpreadOpenDocReader.ReadFromFile(AFileName: string);
var
Doc : TXMLDocument;
FilePath : string;
UnZip : TUnZipper;
FileList : TStringList;
BodyNode, SpreadSheetNode, TableNode: TDOMNode;
StylesNode: TDOMNode;
OfficeSettingsNode: TDOMNode;
nodename: String;
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
ReadXMLFile(Doc, FilePath+'styles.xml');
DeleteFile(FilePath+'styles.xml');
StylesNode := Doc.DocumentElement.FindNode('office:styles');
ReadNumFormats(StylesNode);
ReadStyles(StylesNode);
Doc.Free;
//process the content.xml file
ReadXMLFile(Doc, FilePath+'content.xml');
DeleteFile(FilePath+'content.xml');
StylesNode := Doc.DocumentElement.FindNode('office:automatic-styles');
ReadNumFormats(StylesNode);
ReadStyles(StylesNode);
BodyNode := Doc.DocumentElement.FindNode('office:body');
if not Assigned(BodyNode) then Exit;
SpreadSheetNode := BodyNode.FindNode('office:spreadsheet');
if not Assigned(SpreadSheetNode) then Exit;
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);
// Handle columns and rows
ApplyColWidths;
FixCols(FWorksheet);
FixRows(FWorksheet);
// Continue with next table
TableNode := TableNode.NextSibling;
end; //while Assigned(TableNode)
Doc.Free;
// process the settings.xml file (Note: it does not always exist!)
if FileExists(FilePath + 'settings.xml') then
begin
ReadXMLFile(Doc, FilePath+'settings.xml');
DeleteFile(FilePath+'settings.xml');
OfficeSettingsNode := Doc.DocumentElement.FindNode('office:settings');
ReadSettings(OfficeSettingsNode);
end;
finally
if Assigned(Doc) then Doc.Free;
end;
end;
procedure TsSpreadOpenDocReader.ReadFromStream(AStream: TStream);
begin
Unused(AStream);
raise Exception.Create('[TsSpreadOpenDocReader.ReadFromStream] '+
'Method not implemented. Use "ReadFromFile" instead.');
end;
procedure TsSpreadOpenDocReader.ReadLabel(ARow, ACol: Cardinal;
ACellNode: TDOMNode);
var
cellText: String;
styleName: String;
childnode: TDOMNode;
subnode: TDOMNode;
nodeName: String;
s: String;
cell: PCell;
hyperlink: string;
procedure AddToCellText(AText: String);
begin
if cellText = ''
then cellText := AText
else cellText := cellText + AText;
end;
begin
{ We were forced to activate PreserveWhiteSpace in the DOMParser in order to
catch the spaces inserted in formatting texts. However, this adds lots of
garbage into the cellText if is is read by means of above statement. Done
like below is much better: }
cellText := '';
hyperlink := '';
childnode := ACellNode.FirstChild;
while Assigned(childnode) do
begin
nodeName := childNode.NodeName;
if nodeName = 'text:p' then begin
// Each 'text:p' node is a paragraph --> we insert a line break after the first paragraph
if cellText <> '' then
cellText := cellText + LineEnding;
subnode := childnode.FirstChild;
while Assigned(subnode) do
begin
nodename := subnode.NodeName;
case nodename of
'#text' :
AddToCellText(subnode.TextContent);
'text:a': // "hyperlink anchor"
begin
hyperlink := GetAttrValue(subnode, 'xlink:href');
AddToCellText(subnode.TextContent);
end;
'text:span':
AddToCellText(subnode.TextContent);
end;
subnode := subnode.NextSibling;
end;
end;
childnode := childnode.NextSibling;
end;
if FIsVirtualMode then
begin
InitCell(ARow, ACol, FVirtualCell);
cell := @FVirtualCell;
end else
cell := FWorksheet.GetCell(ARow, ACol);
FWorkSheet.WriteUTF8Text(cell, cellText);
if hyperlink <> '' then
begin
// ODS sees relative paths relative to the internal own file structure
// --> we must remove 1 level-up to be at the same level where fps expects
// the file.
if pos('../', hyperlink) = 1 then
Delete(hyperlink, 1, Length('../'));
FWorksheet.WriteHyperlink(cell, hyperlink);
end;
styleName := GetAttrValue(ACellNode, 'table:style-name');
ApplyStyleToCell(cell, stylename);
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
procedure TsSpreadOpenDocReader.ReadNumber(ARow, ACol: Cardinal;
ACellNode : TDOMNode);
var
Value, Str: String;
lNumber: Double;
styleName: String;
cell: PCell;
fmt: PsCellFormat;
begin
if FIsVirtualMode then
begin
InitCell(ARow, ACol, FVirtualCell);
cell := @FVirtualCell;
end else
cell := FWorksheet.GetCell(ARow, ACol);
Value := GetAttrValue(ACellNode,'office:value');
if UpperCase(Value)='1.#INF' then
FWorkSheet.WriteNumber(cell, 1.0/0.0)
else
begin
// Don't merge, or else we can't debug
Str := GetAttrValue(ACellNode,'office:value');
lNumber := StrToFloat(Str, FPointSeparatorSettings);
FWorkSheet.WriteNumber(cell, lNumber);
end;
styleName := GetAttrValue(ACellNode, 'table:style-name');
ApplyStyleToCell(cell, stylename);
fmt := Workbook.GetPointerToCellFormat(cell^.FormatIndex);
// Sometimes date/time cells are stored as "float".
// We convert them to date/time and also correct the date origin offset if
// needed.
if IsDateTimeFormat(fmt^.NumberFormat) or IsDateTimeFormat(fmt^.NumberFormatStr)
then begin
cell^.ContentType := cctDateTime;
// No datemode correction for intervals and for time-only values
if (fmt^.NumberFormat = nfTimeInterval) or (cell^.NumberValue < 1) then
cell^.DateTimeValue := cell^.NumberValue
else
case FDateMode of
dm1899: cell^.DateTimeValue := cell^.NumberValue + DATEMODE_1899_BASE;
dm1900: cell^.DateTimeValue := cell^.NumberValue + DATEMODE_1900_BASE;
dm1904: cell^.DateTimeValue := cell^.NumberValue + DATEMODE_1904_BASE;
end;
end;
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
procedure TsSpreadOpenDocReader.ReadNumFormats(AStylesNode: TDOMNode);
procedure ReadStyleMap(ANode: TDOMNode; var ANumFormat: TsNumberFormat;
var AFormatStr: String);
var
condition: String;
stylename: String;
styleindex: Integer;
fmt: String;
posfmt, negfmt, zerofmt: String;
nf: TsNumberFormat;
begin
posfmt := '';
negfmt := '';
zerofmt := '';
while ANode <> nil do
begin
condition := ANode.NodeName;
if (ANode.NodeName = '#text') or not ANode.HasAttributes then
begin
ANode := ANode.NextSibling;
Continue;
end;
condition := GetAttrValue(ANode, 'style:condition');
stylename := GetAttrValue(ANode, 'style:apply-style-name');
if (condition = '') or (stylename = '') then
begin
ANode := ANode.NextSibling;
continue;
end;
Delete(condition, 1, Length('value()'));
styleindex := -1;
styleindex := FNumFormatList.FindByName(stylename);
if (styleindex = -1) or (condition = '') then
begin
ANode := ANode.NextSibling;
continue;
end;
fmt := FNumFormatList[styleindex].FormatString;
nf := FNumFormatList[styleindex].NumFormat;
if nf in [nfCurrency, nfCurrencyRed] then ANumFormat := nf;
case condition[1] of
'>': begin
posfmt := fmt;
if (Length(condition) > 1) and (condition[2] = '=') then
zerofmt := fmt;
end;
'<': begin
negfmt := fmt;
if (Length(condition) > 1) and (condition[2] = '=') then
zerofmt := fmt;
end;
'=': begin
zerofmt := fmt;
end;
end;
ANode := ANode.NextSibling;
end;
if posfmt = '' then posfmt := AFormatStr;
if negfmt = '' then negfmt := AFormatStr;
AFormatStr := posFmt;
if negfmt <> '' then AFormatStr := AFormatStr + ';' + negfmt;
if zerofmt <> '' then AFormatStr := AFormatStr + ';' + zerofmt;
if not (ANumFormat in [nfCurrency, nfCurrencyRed]) then
ANumFormat := nfCustom;
end;
procedure ReadNumberStyle(ANumFormatNode: TDOMNode; ANumFormatName: String);
var
node, childNode: TDOMNode;
nodeName: String;
nf: TsNumberFormat;
nfs: String;
decs: Byte;
s: String;
grouping: Boolean;
nex: Integer;
cs: String;
hasColor: Boolean;
begin
nfs := '';
cs := '';
hasColor := false;
node := ANumFormatNode.FirstChild;
while Assigned(node) do
begin
nodeName := node.NodeName;
if nodeName = '#text' then
begin
node := node.NextSibling;
Continue;
end else
if nodeName = 'number:number' then
begin
{
if ANumFormatName = 'number:currency-style' then
s := GetAttrValue(node, 'decimal-places')
else
}
s := GetAttrValue(node, 'number:decimal-places');
if s = '' then s := GetAttrValue(node, 'decimal-places');
if s <> '' then decs := StrToInt(s) else decs := 0;
grouping := GetAttrValue(node, 'number:grouping') = 'true';
nf := IfThen(grouping, nfFixedTh, nfFixed);
nfs := nfs + BuildNumberFormatString(nf, Workbook.FormatSettings, decs);
end else
if nodeName = 'number:scientific-number' then
begin
nf := nfExp;
s := GetAttrValue(node, 'number:decimal-places');
if s <> '' then decs := StrToInt(s) else decs := 0;
s := GetAttrValue(node, 'number:min-exponent-digits');
if s <> '' then nex := StrToInt(s) else nex := 1;
nfs := nfs + BuildNumberFormatString(nfFixed, Workbook.FormatSettings, decs);
nfs := nfs + 'E+' + DupeString('0', nex);
end else
if nodeName = 'number:currency-symbol' then
begin
childnode := node.FirstChild;
while childnode <> nil do
begin
cs := cs + childNode.NodeValue;
nfs := nfs + childNode.NodeValue;
childNode := childNode.NextSibling;
end;
end else
if nodeName = 'number:text' then
begin
childNode := node.FirstChild;
while childNode <> nil do
begin
nfs := nfs + childNode.NodeValue;
childNode := childNode.NextSibling;
end;
end else
if nodeName = 'style:text-properties' then
begin
s := GetAttrValue(node, 'fo:color');
if s <> '' then
begin
hasColor := true;
{ // currently not needed
color := HTMLColorStrToColor(s);
idx := FWorkbook.AddColorToPalette(color);
if idx < 8 then
nfs := Format('[%s]%s', [FWorkbook.GetColorName(idx), nfs])
else
nfs := Format('[Color%d]%s', [idx, nfs]);
}
end;
end;
node := node.NextSibling;
end;
node := ANumFormatNode.FindNode('style:map');
if node <> nil then
ReadStyleMap(node, nf, nfs);
if ANumFormatNode.NodeName = 'number:percentage-style' then
nf := nfPercentage
else
if (ANumFormatNode.NodeName = 'number:currency-style') then
nf := IfThen(hasColor, nfCurrencyRed, nfCurrency);
NumFormatList.AddFormat(ANumFormatName, nf, nfs);
end;
procedure ReadDateTimeStyle(ANumFormatNode: TDOMNode; ANumFormatName: String);
var
node, childNode: TDOMNode;
nf: TsNumberFormat;
nfs: String;
nodeName: String;
s, stxt, sovr: String;
isInterval: Boolean;
begin
nfs := '';
isInterval := false;
sovr := GetAttrValue(ANumFormatNode, 'number:truncate-on-overflow');
if (sovr = 'false') then
isInterval := true;
node := ANumFormatNode.FirstChild;
while Assigned(node) do
begin
nodeName := node.NodeName;
if nodeName = '#text' then
begin
node := node.NextSibling;
Continue;
end else
if nodeName = 'number:year' then
begin
s := GetAttrValue(node, 'number:style');
nfs := nfs + IfThen(s = 'long', 'yyyy', 'yy');
end else
if nodeName = 'number:month' then
begin
s := GetAttrValue(node, 'number:style');
stxt := GetAttrValue(node, 'number:textual');
if (stxt = 'true') then // Month as text
nfs := nfs + IfThen(s = 'long', 'mmmm', 'mmm')
else // Month as number
nfs := nfs + IfThen(s = 'long', 'mm', 'm');
end else
if nodeName = 'number:day' then
begin
s := GetAttrValue(node, 'number:style');
nfs := nfs + IfThen(s = 'long', 'dd', 'd');
end else
if nodeName = 'number:day-of-week' then
begin
s := GetAttrValue(node, 'number:style');
nfs := nfs + IfThen(s = 'long', 'dddd', 'ddd');
end else
if nodeName = 'number:hours' then
begin
s := GetAttrValue(node, 'number:style');
if (sovr = 'false') then
nfs := nfs + IfThen(s = 'long', '[hh]', '[h]')
else
nfs := nfs + IfThen(s = 'long', 'hh', 'h');
sovr := '';
end else
if nodeName = 'number:minutes' then
begin
s := GetAttrValue(node, 'number:style');
if (sovr = 'false') then
nfs := nfs + IfThen(s = 'long', '[nn]', '[n]')
else
nfs := nfs + IfThen(s = 'long', 'nn', 'n');
sovr := '';
end else
if nodeName = 'number:seconds' then
begin
s := GetAttrValue(node, 'number:style');
if (sovr = 'false') then
nfs := nfs + IfThen(s = 'long', '[ss]', '[s]')
else
nfs := nfs + IfThen(s = 'long', 'ss', 's');
sovr := '';
s := GetAttrValue(node, 'number:decimal-places');
if (s <> '') and (s <> '0') then
nfs := nfs + '.' + DupeString('0', StrToInt(s));
end else
if nodeName = 'number:am-pm' then
nfs := nfs + 'AM/PM'
else
if nodeName = 'number:text' then
begin
childnode := node.FirstChild;
if childnode <> nil then
begin
s := childNode.NodeValue;
if pos(';', s) > 0 then
nfs := nfs + '"' + s + '"'
// avoid "misunderstanding" the semicolon as a section separator!
else
nfs := nfs + childnode.NodeValue;
end;
end;
node := node.NextSibling;
end;
nf := IfThen(isInterval, nfTimeInterval, nfCustom);
node := ANumFormatNode.FindNode('style:map');
if node <> nil then
ReadStyleMap(node, nf, nfs);
NumFormatList.AddFormat(ANumFormatName, nf, nfs);
end;
procedure ReadTextStyle(ANumFormatNode: TDOMNode; ANumFormatName: String);
var
node, childNode: TDOMNode;
nf: TsNumberFormat = nfGeneral;
nfs: String;
nodeName: String;
begin
nfs := '';
node := ANumFormatNode.FirstChild;
while Assigned(node) do
begin
nodeName := node.NodeName;
if nodeName = '#text' then
begin
node := node.NextSibling;
Continue;
end else
if nodeName = 'number:text-content' then
begin
// ???
end else
if nodeName = 'number:text' then
begin
childnode := node.FirstChild;
if childnode <> nil then
nfs := nfs + childnode.NodeValue;
end;
node := node.NextSibling;
end;
node := ANumFormatNode.FindNode('style:map');
if node <> nil then
ReadStyleMap(node, nf, nfs);
nf := nfCustom;
NumFormatList.AddFormat(ANumFormatName, nf, nfs);
end;
var
NumFormatNode: TDOMNode;
numfmt_nodename, numfmtname: String;
begin
if not Assigned(AStylesNode) then
exit;
NumFormatNode := AStylesNode.FirstChild;
while Assigned(NumFormatNode) do
begin
numfmt_nodename := NumFormatNode.NodeName;
if NumFormatNode.HasAttributes then
numfmtName := GetAttrValue(NumFormatNode, 'style:name') else
numfmtName := '';
// Numbers (nfFixed, nfFixedTh, nfExp, nfPercentage)
if (numfmt_nodename = 'number:number-style') or
(numfmt_nodename = 'number:percentage-style') or
(numfmt_nodename = 'number:currency-style')
then
ReadNumberStyle(NumFormatNode, numfmtName);
// Date/time values
if (numfmt_nodename = 'number:date-style') or (numfmt_nodename = 'number:time-style') then
ReadDateTimeStyle(NumFormatNode, numfmtName);
// Text values
if (numfmt_nodename = 'number:text-style') then
ReadTextStyle(NumFormatNode, numfmtName);
// Next node
NumFormatNode := NumFormatNode.NextSibling;
end;
end;
{ Reads the cells in the given table. Loops through all rows, and then finds all
cells of each row. }
procedure TsSpreadOpenDocReader.ReadRowsAndCells(ATableNode: TDOMNode);
var
row: Integer;
col: Integer;
cellNode, rowNode: TDOMNode;
nodeName: String;
paramValueType, paramFormula, tableStyleName: String;
paramColsSpanned, paramRowsSpanned: String;
paramColsRepeated, paramRowsRepeated: String;
rowsRepeated: Integer;
rowsSpanned: Integer;
colsSpanned: Integer;
rowStyleName: String;
rowStyleIndex: Integer;
rowStyle: TRowStyleData;
rowHeight: Single;
autoRowHeight: Boolean;
i, n: Integer;
cell: PCell;
begin
rowsRepeated := 0;
row := 0;
rowNode := ATableNode.FindNode('table:table-row');
while Assigned(rowNode) do
begin
nodename := rowNode.NodeName;
// Skip all non table-row nodes:
// Nodes '#text' occur due to indentation spaces which are not skipped
// automatically any more due to PreserveWhiteSpace option applied
// to ReadXMLFile
// And there are other nodes like 'table:named-expression' which we don't
// need (at the moment)
if nodeName <> 'table:table-row' then
begin
rowNode := rowNode.NextSibling;
Continue;
end;
// Read rowstyle
rowStyleName := GetAttrValue(rowNode, 'table:style-name');
rowStyleIndex := FindRowStyleByName(rowStyleName);
if rowStyleIndex > -1 then // just for safety
begin
rowStyle := TRowStyleData(FRowStyleList[rowStyleIndex]);
rowHeight := rowStyle.RowHeight; // in mm (see ReadRowStyles)
rowHeight := mmToPts(rowHeight) / Workbook.GetDefaultFontSize;
if rowHeight > ROW_HEIGHT_CORRECTION
then rowHeight := rowHeight - ROW_HEIGHT_CORRECTION // in "lines"
else rowHeight := 0;
autoRowHeight := rowStyle.AutoRowHeight;
end else
autoRowHeight := true;
col := 0;
//process each cell of the row
cellNode := rowNode.FindNode('table:table-cell');
while Assigned(cellNode) do
begin
nodeName := cellNode.NodeName;
if nodeName = 'table:table-cell' then
begin
// select this cell value's type
paramValueType := GetAttrValue(CellNode, 'office:value-type');
paramFormula := GetAttrValue(CellNode, 'table:formula');
tableStyleName := GetAttrValue(CellNode, 'table:style-name');
if paramValueType = 'string' then
ReadLabel(row, col, cellNode)
else
if (paramValueType = 'float') or (paramValueType = 'percentage') or
(paramValueType = 'currency')
then
ReadNumber(row, col, cellNode)
else if (paramValueType = 'date') or (paramValueType = 'time') then
ReadDateTime(row, col, cellNode)
else if (paramValueType = 'boolean') then
ReadBoolean(row, col, cellNode)
else if (paramValueType = '') and (tableStyleName <> '') then
ReadBlank(row, col, cellNode);
{ NOTE: Empty cells having no cell format, but a column format only,
are skipped here. --> Currently the reader does not detect the format
of empty cells correctly.
It would work if the "(tableStyleName <> '')" would be omitted, but
then the reader would create a record for all 1E9 cells prepared by
the Excel2007 export --> crash!
The column format is available in the FColumnList, but since the usage
of colsSpanned in the row it is possible to miss the correct column format.
Pretty nasty situation! }
if ParamFormula <> '' then
ReadFormula(row, col, cellNode);
// Read cell comment
ReadComment(row, col, cellNode);
paramColsSpanned := GetAttrValue(cellNode, 'table:number-columns-spanned');
if paramColsSpanned <> '' then
colsSpanned := StrToInt(paramColsSpanned) - 1
else
colsSpanned := 0;
paramRowsSpanned := GetAttrValue(cellNode, 'table:number-rows-spanned');
if paramRowsSpanned <> '' then
rowsSpanned := StrToInt(paramRowsSpanned) - 1
else
rowsSpanned := 0;
if (colsSpanned <> 0) or (rowsSpanned <> 0) then
FWorksheet.MergeCells(row, col, row+rowsSpanned, col+colsSpanned);
paramColsRepeated := GetAttrValue(cellNode, 'table:number-columns-repeated');
if paramColsRepeated = '' then paramColsRepeated := '1';
n := StrToInt(paramColsRepeated);
if n > 1 then
begin
cell := FWorksheet.FindCell(row, col);
if cell <> nil then
for i:=1 to n-1 do
FWorksheet.CopyCell(row, col, row, col+i);
end;
end
else
if nodeName = 'table:covered-table-cell' then
begin
paramColsRepeated := GetAttrValue(cellNode, 'table:number-columns-repeated');
if paramColsRepeated = '' then paramColsRepeated := '1';
end else
paramColsRepeated := '0';
col := col + StrToInt(paramColsRepeated);
cellNode := cellNode.NextSibling;
end; //while Assigned(cellNode)
paramRowsRepeated := GetAttrValue(RowNode, 'table:number-rows-repeated');
if paramRowsRepeated = '' then
rowsRepeated := 1
else
rowsRepeated := StrToInt(paramRowsRepeated);
// Transfer non-default row heights to sheet's rows
if not autoRowHeight then
for i:=1 to rowsRepeated do
FWorksheet.WriteRowHeight(row + i - 1, rowHeight);
row := row + rowsRepeated;
rowNode := rowNode.NextSibling;
end; // while Assigned(rowNode)
end;
procedure TsSpreadOpenDocReader.ReadRowStyle(AStyleNode: TDOMNode);
var
styleName: String;
styleChildNode: TDOMNode;
rowHeight: Double;
auto: Boolean;
s: String;
rowStyle: TRowStyleData;
begin
styleName := GetAttrValue(AStyleNode, 'style:name');
styleChildNode := AStyleNode.FirstChild;
rowHeight := -1;
auto := false;
while Assigned(styleChildNode) do
begin
if styleChildNode.NodeName = 'style:table-row-properties' then
begin
s := GetAttrValue(styleChildNode, 'style:row-height');
if s <> '' then
rowHeight := PtsToMm(HTMLLengthStrToPts(s)); // convert to mm
s := GetAttrValue(styleChildNode, 'style:use-optimal-row-height');
if s = 'true' then
auto := true;
end;
styleChildNode := styleChildNode.NextSibling;
end;
rowStyle := TRowStyleData.Create;
rowStyle.Name := styleName;
rowStyle.RowHeight := rowHeight;
rowStyle.AutoRowHeight := auto;
FRowStyleList.Add(rowStyle);
end;
procedure TsSpreadOpenDocReader.ReadSettings(AOfficeSettingsNode: TDOMNode);
var
cfgItemSetNode, cfgItemNode, cfgItemMapEntryNode, cfgEntryItemNode, cfgTableItemNode, node: TDOMNode;
nodeName, cfgName, cfgValue, tblName: String;
sheet: TsWorksheet;
vsm, hsm, hsp, vsp: Integer;
showGrid, showHeaders: Boolean;
i: Integer;
begin
showGrid := true;
showHeaders := true;
cfgItemSetNode := AOfficeSettingsNode.FirstChild;
while Assigned(cfgItemSetNode) do
begin
if (cfgItemSetNode.NodeName <> '#text') and
(GetAttrValue(cfgItemSetNode, 'config:name') = 'ooo:view-settings') then
begin
cfgItemNode := cfgItemSetNode.FirstChild;
while Assigned(cfgItemNode) do begin
if (cfgItemNode.NodeName <> '#text') and
(cfgItemNode.NodeName = 'config:config-item-map-indexed') and
(GetAttrValue(cfgItemNode, 'config:name') = 'Views') then
begin
cfgItemMapEntryNode := cfgItemNode.FirstChild;
while Assigned(cfgItemMapEntryNode) do
begin
cfgEntryItemNode := cfgItemMapEntryNode.FirstChild;
while Assigned(cfgEntryItemNode) do
begin
nodeName := cfgEntryItemNode.NodeName;
if (nodeName = 'config:config-item') then
begin
cfgName := lowercase(GetAttrValue(cfgEntryItemNode, 'config:name'));
if cfgName = 'showgrid' then
begin
cfgValue := GetNodeValue(cfgEntryItemNode);
if cfgValue = 'false' then showGrid := false;
end else
if cfgName = 'hascolumnrowheaders' then
begin
cfgValue := GetNodeValue(cfgEntryItemNode);
if cfgValue = 'false' then showHeaders := false;
end;
end else
if (nodeName = 'config:config-item-map-named') and
(GetAttrValue(cfgEntryItemNode, 'config:name') = 'Tables') then
begin
cfgTableItemNode := cfgEntryItemNode.FirstChild;
while Assigned(cfgTableItemNode) do
begin
nodeName := cfgTableItemNode.NodeName;
if nodeName <> '#text' then
begin
tblName := GetAttrValue(cfgTableItemNode, 'config:name');
if tblName <> '' then
begin
hsm := 0; vsm := 0;
sheet := Workbook.GetWorksheetByName(tblName);
if sheet <> nil then
begin
node := cfgTableItemNode.FirstChild;
while Assigned(node) do
begin
nodeName := node.NodeName;
if nodeName <> '#text' then
begin
cfgName := GetAttrValue(node, 'config:name');
cfgValue := GetNodeValue(node);
if cfgName = 'VerticalSplitMode' then
vsm := StrToInt(cfgValue)
else if cfgName = 'HorizontalSplitMode' then
hsm := StrToInt(cfgValue)
else if cfgName = 'VerticalSplitPosition' then
vsp := StrToInt(cfgValue)
else if cfgName = 'HorizontalSplitPosition' then
hsp := StrToInt(cfgValue);
end;
node := node.NextSibling;
end;
if (hsm = 2) or (vsm = 2) then
begin
sheet.Options := sheet.Options + [soHasFrozenPanes];
sheet.LeftPaneWidth := hsp;
sheet.TopPaneHeight := vsp;
end else
sheet.Options := sheet.Options - [soHasFrozenPanes];
end;
end;
end;
cfgTableItemNode := cfgTableItemNode.NextSibling;
end;
end;
cfgEntryItemNode := cfgEntryItemNode.NextSibling;
end;
cfgItemMapEntryNode := cfgItemMapEntryNode.NextSibling;
end;
end;
cfgItemNode := cfgItemNode.NextSibling;
end;
end;
cfgItemSetNode := cfgItemSetNode.NextSibling;
end;
{ Now let's apply the showGrid and showHeader values to all sheets - they
are document-wide settings (although there is a ShowGrid in the Tables node) }
for i:=0 to Workbook.GetWorksheetCount-1 do
begin
sheet := Workbook.GetWorksheetByIndex(i);
if not showGrid then sheet.Options := sheet.Options - [soShowGridLines];
if not showHeaders then sheet.Options := sheet.Options - [soShowHeaders];
end;
end;
procedure TsSpreadOpenDocReader.ReadStyles(AStylesNode: TDOMNode);
var
styleNode: TDOMNode;
styleChildNode: TDOMNode;
nodeName: String;
family: String;
styleName: String;
fmt: TsCellFormat;
numFmtIndexDefault: Integer;
numFmtName: String;
numFmtIndex: Integer;
numFmtData: TsNumFormatData;
clr: TsColorValue;
s: String;
procedure SetBorderStyle(ABorder: TsCellBorder; AStyleValue: String);
const
EPS = 0.1; // takes care of rounding errors for line widths
var
L: TStringList;
i: Integer;
s: String;
wid: Double;
linestyle: String;
rgb: TsColorValue;
p: Integer;
begin
L := TStringList.Create;
try
L.Delimiter := ' ';
L.StrictDelimiter := true;
L.DelimitedText := AStyleValue;
wid := 0;
rgb := TsColorValue(-1);
linestyle := '';
for i:=0 to L.Count-1 do
begin
s := L[i];
if (s = 'solid') or (s = 'dashed') or (s = 'fine-dashed') or (s = 'dotted') or (s = 'double')
then begin
linestyle := s;
continue;
end;
p := pos('pt', s);
if p = Length(s)-1 then
begin
wid := StrToFloat(copy(s, 1, p-1), FPointSeparatorSettings);
continue;
end;
p := pos('mm', s);
if p = Length(s)-1 then
begin
wid := mmToPts(StrToFloat(copy(s, 1, p-1), FPointSeparatorSettings));
Continue;
end;
p := pos('cm', s);
if p = Length(s)-1 then
begin
wid := cmToPts(StrToFloat(copy(s, 1, p-1), FPointSeparatorSettings));
Continue;
end;
rgb := HTMLColorStrToColor(s);
end;
fmt.BorderStyles[ABorder].LineStyle := lsThin;
if (linestyle = 'solid') then
begin
if (wid >= 3 - EPS) then fmt.BorderStyles[ABorder].LineStyle := lsThick
else if (wid >= 2 - EPS) then fmt.BorderStyles[ABorder].LineStyle := lsMedium
end else
if (linestyle = 'dotted') then
fmt.BorderStyles[ABorder].LineStyle := lsHair
else
if (linestyle = 'dashed') then
fmt.BorderStyles[ABorder].LineStyle := lsDashed
else
if (linestyle = 'fine-dashed') then
fmt.BorderStyles[ABorder].LineStyle := lsDotted
else
if (linestyle = 'double') then
fmt.BorderStyles[ABorder].LineStyle := lsDouble;
fmt.BorderStyles[ABorder].Color := IfThen(rgb = TsColorValue(-1),
scBlack, Workbook.AddColorToPalette(rgb));
finally
L.Free;
end;
end;
begin
if not Assigned(AStylesNode) then
exit;
numFmtIndexDefault := NumFormatList.FindByName('N0');
styleNode := AStylesNode.FirstChild;
while Assigned(styleNode) do begin
nodeName := styleNode.NodeName;
if nodeName = 'style:default-style' then
begin
ReadFont(styleNode.FindNode('style:text-properties'), true);
end else
if nodeName = 'style:style' then
begin
family := GetAttrValue(styleNode, 'style:family');
// Column styles
if family = 'table-column' then
ReadColumnStyle(styleNode);
// Row styles
if family = 'table-row' then
ReadRowStyle(styleNode);
// Cell styles
if family = 'table-cell' then
begin
styleName := GetAttrValue(styleNode, 'style:name');
InitFormatRecord(fmt);
fmt.Name := styleName;
numFmtIndex := -1;
numFmtName := GetAttrValue(styleNode, 'style:data-style-name');
if numFmtName <> '' then numFmtIndex := NumFormatList.FindByName(numFmtName);
if numFmtIndex = -1 then numFmtIndex := numFmtIndexDefault;
numFmtData := NumFormatList.Items[numFmtIndex];
fmt.NumberFormat := numFmtData.NumFormat;
fmt.NumberFormatStr := numFmtData.FormatString;
if fmt.NumberFormat <> nfGeneral then
Include(fmt.UsedFormattingFields, uffNumberFormat);
styleChildNode := styleNode.FirstChild;
while Assigned(styleChildNode) do
begin
nodeName := styleChildNode.NodeName;
if nodeName = 'style:text-properties' then
begin
fmt.FontIndex := ReadFont(styleChildNode, false);
if fmt.FontIndex = 1 then
Include(fmt.UsedFormattingFields, uffBold)
else if fmt.FontIndex > 1 then
Include(fmt.UsedFormattingFields, uffFont);
end else
if nodeName = 'style:table-cell-properties' then
begin
// Background color
s := GetAttrValue(styleChildNode, 'fo:background-color');
if (s <> '') and (s <> 'transparent') then begin
clr := HTMLColorStrToColor(s);
// ODS does not support background fill patterns!
fmt.Background.FgColor := IfThen(clr = TsColorValue(-1),
scTransparent, Workbook.AddColorToPalette(clr));
fmt.Background.BgColor := fmt.Background.FgColor;
if (fmt.Background.BgColor <> scTransparent) then
begin
fmt.Background.Style := fsSolidFill;
Include(fmt.UsedFormattingFields, uffBackground);
end;
end;
// Borders
s := GetAttrValue(styleChildNode, 'fo:border');
if (s <> '') and (s <> 'none') then
begin
fmt.Border := fmt.Border + [cbNorth, cbSouth, cbEast, cbWest];
SetBorderStyle(cbNorth, s);
SetBorderStyle(cbSouth, s);
SetBorderStyle(cbEast, s);
SetBorderStyle(cbWest, s);
Include(fmt.UsedFormattingFields, uffBorder);
end;
s := GetAttrValue(styleChildNode, 'fo:border-top');
if (s <> '') and (s <> 'none') then
begin
Include(fmt.Border, cbNorth);
SetBorderStyle(cbNorth, s);
Include(fmt.UsedFormattingFields, uffBorder);
end;
s := GetAttrValue(styleChildNode, 'fo:border-right');
if (s <> '') and (s <> 'none') then
begin
Include(fmt.Border, cbEast);
SetBorderStyle(cbEast, s);
Include(fmt.UsedFormattingFields, uffBorder);
end;
s := GetAttrValue(styleChildNode, 'fo:border-bottom');
if (s <> '') and (s <> 'none') then
begin
Include(fmt.Border, cbSouth);
SetBorderStyle(cbSouth, s);
Include(fmt.UsedFormattingFields, uffBorder);
end;
s := GetAttrValue(styleChildNode, 'fo:border-left');
if (s <> '') and (s <> 'none') then
begin
Include(fmt.Border, cbWest);
SetBorderStyle(cbWest, s);
Include(fmt.UsedFormattingFields, uffBorder);
end;
s := GetAttrValue(styleChildNode, 'style:diagonal-bl-tr');
if (s <> '') and (s <> 'none') then
begin
Include(fmt.Border, cbDiagUp);
SetBorderStyle(cbDiagUp, s);
Include(fmt.UsedFormattingFields, uffBorder);
end;
s := GetAttrValue(styleChildNode, 'style:diagonal-tl-br');
if (s <> '') and (s <>'none') then
begin
Include(fmt.Border, cbDiagDown);
SetBorderStyle(cbDiagDown, s);
Include(fmt.UsedFormattingFields, uffBorder);
end;
// Text wrap
s := GetAttrValue(styleChildNode, 'fo:wrap-option');
if (s='wrap') then
Include(fmt.UsedFormattingFields, uffWordwrap);
// Test rotation
s := GetAttrValue(styleChildNode, 'style:rotation-angle');
if s = '90' then
fmt.TextRotation := rt90DegreeCounterClockwiseRotation
else if s = '270' then
fmt.TextRotation := rt90DegreeClockwiseRotation;
s := GetAttrValue(styleChildNode, 'style:direction');
if s = 'ttb' then
fmt.TextRotation := rtStacked;
if fmt.TextRotation <> trHorizontal then
Include(fmt.UsedFormattingFields, uffTextRotation);
// Vertical text alignment
s := GetAttrValue(styleChildNode, 'style:vertical-align');
if s = 'top' then
fmt.VertAlignment := vaTop
else if s = 'middle' then
fmt.VertAlignment := vaCenter
else if s = 'bottom' then
fmt.VertAlignment := vaBottom;
if fmt.VertAlignment <> vaDefault then
Include(fmt.UsedFormattingFields, uffVertAlign);
end
else
if nodeName = 'style:paragraph-properties' then
begin
// Horizontal text alignment
s := GetAttrValue(styleChildNode, 'fo:text-align');
if s = 'start' then
fmt.HorAlignment := haLeft
else if s = 'end' then
fmt.HorAlignment := haRight
else if s = 'center' then
fmt.HorAlignment := haCenter;
if fmt.HorAlignment <> haDefault then
Include(fmt.UsedFormattingFields, uffHorAlign);
end;
styleChildNode := styleChildNode.NextSibling;
end;
FCellFormatList.Add(fmt);
end;
end;
styleNode := styleNode.NextSibling;
end;
end;
{ TsSpreadOpenDocWriter }
procedure TsSpreadOpenDocWriter.CreateNumFormatList;
begin
FreeAndNil(FNumFormatList);
FNumFormatList := TsSpreadOpenDocNumFormatList.Create(Workbook);
end;
{ Creates the streams for the individual data files. Will be zipped into a
single xlsx file. }
procedure TsSpreadOpenDocWriter.CreateStreams;
begin
if (boBufStream in Workbook.Options) then
begin
FSMeta := TBufStream.Create(GetTempFileName('', 'fpsM'));
FSSettings := TBufStream.Create(GetTempFileName('', 'fpsS'));
FSStyles := TBufStream.Create(GetTempFileName('', 'fpsSTY'));
FSContent := TBufStream.Create(GetTempFileName('', 'fpsC'));
FSMimeType := TBufStream.Create(GetTempFileName('', 'fpsMT'));
FSMetaInfManifest := TBufStream.Create(GetTempFileName('', 'fpsMIM'));
end else
begin
FSMeta := TMemoryStream.Create;
FSSettings := TMemoryStream.Create;
FSStyles := TMemoryStream.Create;
FSContent := TMemoryStream.Create;
FSMimeType := TMemoryStream.Create;
FSMetaInfManifest := TMemoryStream.Create;
end;
// FSSheets will be created when needed.
end;
{ Destroys the streams that were created by the writer }
procedure TsSpreadOpenDocWriter.DestroyStreams;
procedure DestroyStream(AStream: TStream);
var
fn: String;
begin
if AStream is TFileStream then
begin
fn := TFileStream(AStream).Filename;
DeleteFile(fn);
end;
AStream.Free;
end;
begin
DestroyStream(FSMeta);
DestroyStream(FSSettings);
DestroyStream(FSStyles);
DestroyStream(FSContent);
DestroyStream(FSMimeType);
DestroyStream(FSMetaInfManifest);
end;
procedure TsSpreadOpenDocWriter.ListAllColumnStyles;
var
i, j, c: Integer;
sheet: TsWorksheet;
found: Boolean;
colstyle: TColumnStyleData;
w: Double;
multiplier: Double;
begin
{ At first, add the default column width }
colStyle := TColumnStyleData.Create;
colStyle.Name := 'co1';
colStyle.ColWidth := 12; //Workbook.DefaultColWidth;
FColumnStyleList.Add(colStyle);
for i:=0 to Workbook.GetWorksheetCount-1 do
begin
sheet := Workbook.GetWorksheetByIndex(i);
// colStyle.ColWidth := sheet.DefaultColWidth;
for c:=0 to sheet.GetLastColIndex do
begin
w := sheet.GetColWidth(c);
// Look for this width in the current ColumnStyleList
found := false;
for j := 0 to FColumnStyleList.Count-1 do
if SameValue(TColumnStyleData(FColumnStyleList[j]).ColWidth, w, COLWIDTH_EPS)
then begin
found := true;
break;
end;
// Not found? Then add the column as new column style
if not found then
begin
colStyle := TColumnStyleData.Create;
colStyle.Name := Format('co%d', [FColumnStyleList.Count+1]);
colStyle.ColWidth := w;
FColumnStyleList.Add(colStyle);
end;
end;
end;
{ fpspreadsheet's column width is the count of '0' characters of the
default font. On average, the width of the '0' is about half of the
point size of the font. --> we can convert the fps col width to pts and
then to millimeters. }
multiplier := Workbook.GetFont(0).Size / 2;
for i:=0 to FColumnStyleList.Count-1 do
begin
w := TColumnStyleData(FColumnStyleList[i]).ColWidth * multiplier;
TColumnStyleData(FColumnStyleList[i]).ColWidth := PtsToMM(w);
end;
end;
{ Contains all number formats used in the workbook. Overrides the inherited
method to assign a unique name according to the OpenDocument syntax ("N"
to the format items. }
procedure TsSpreadOpenDocWriter.ListAllNumFormats;
const
FMT_BASE = 1000; // Format number to start with. Not clear if this is correct...
var
n, i, j: Integer;
begin
n := NumFormatList.Count;
inherited ListAllNumFormats;
j := 0;
for i:=n to NumFormatList.Count-1 do
begin
NumFormatList.Items[i].Name := Format('N%d', [FMT_BASE + j]);
inc(j);
end;
end;
procedure TsSpreadOpenDocWriter.ListAllRowStyles;
var
i, j, r: Integer;
sheet: TsWorksheet;
row: PRow;
found: Boolean;
rowstyle: TRowStyleData;
h, multiplier: Double;
begin
{ At first, add the default row height }
{ Initially, row height units will be the same as in the sheet, i.e. in "lines" }
rowStyle := TRowStyleData.Create;
rowStyle.Name := 'ro1';
rowStyle.RowHeight := 1; //Workbook.DefaultRowHeight;
rowStyle.AutoRowHeight := true;
FRowStyleList.Add(rowStyle);
for i:=0 to Workbook.GetWorksheetCount-1 do
begin
sheet := Workbook.GetWorksheetByIndex(i);
for r:=0 to sheet.GetLastRowIndex do
begin
row := sheet.FindRow(r);
if row <> nil then
begin
h := sheet.GetRowHeight(r);
// Look for this height in the current RowStyleList
found := false;
for j:=0 to FRowStyleList.Count-1 do
if SameValue(TRowStyleData(FRowStyleList[j]).RowHeight, h, ROWHEIGHT_EPS) and
(not TRowStyleData(FRowStyleList[j]).AutoRowHeight) then
begin
found := true;
break;
end;
// Not found? Then add the row as a new row style
if not found then
begin
rowStyle := TRowStyleData.Create;
rowStyle.Name := Format('ro%d', [FRowStyleList.Count+1]);
rowStyle.RowHeight := h;
rowStyle.AutoRowHeight := false;
FRowStyleList.Add(rowStyle);
end;
end;
end;
end;
{ fpspreadsheet's row heights are measured as line count of the default font.
Using the default font size (which is in points) we convert the line count
to points and then to millimeters as needed by ods. }
multiplier := Workbook.GetDefaultFontSize;;
for i:=0 to FRowStyleList.Count-1 do
begin
h := (TRowStyleData(FRowStyleList[i]).RowHeight + ROW_HEIGHT_CORRECTION) * multiplier;
TRowStyleData(FRowStyleList[i]).RowHeight := PtsToMM(h);
end;
end;
{ Is called before zipping the individual file parts. Rewinds the streams. }
procedure TsSpreadOpenDocWriter.ResetStreams;
begin
FSMeta.Position := 0;
FSSettings.Position := 0;
FSStyles.Position := 0;
FSContent.Position := 0;
FSMimeType.Position := 0;
FSMetaInfManifest.Position := 0;
end;
procedure TsSpreadOpenDocWriter.WriteMimetype;
begin
AppendToStream(FSMimeType,
'application/vnd.oasis.opendocument.spreadsheet'
);
end;
procedure TsSpreadOpenDocWriter.WriteMetaInfManifest;
begin
AppendToStream(FSMetaInfManifest,
'');
AppendToStream(FSMetaInfManifest,
'');
AppendToStream(FSMetaInfManifest,
'');
AppendToStream(FSMetaInfManifest,
'');
AppendToStream(FSMetaInfManifest,
'');
AppendToStream(FSMetaInfManifest,
'');
AppendToStream(FSMetaInfManifest,
'');
end;
procedure TsSpreadOpenDocWriter.WriteMeta;
begin
AppendToStream(FSMeta,
XML_HEADER);
AppendToStream(FSMeta,
'');
AppendToStream(FSMeta,
'',
'FPSpreadsheet Library' +
'',
'');
AppendToStream(FSMeta,
'');
end;
procedure TsSpreadOpenDocWriter.WriteSettings;
var
i: Integer;
showGrid, showHeaders: Boolean;
sheet: TsWorksheet;
begin
// Open/LibreOffice allow to change showGrid and showHeaders only globally.
// As a compromise, we check whether there is at least one page with these
// settings off. Then we assume it to be valid also for the other sheets.
showGrid := true;
showHeaders := true;
for i:=0 to Workbook.GetWorksheetCount-1 do
begin
sheet := Workbook.GetWorksheetByIndex(i);
if not (soShowGridLines in sheet.Options) then showGrid := false;
if not (soShowHeaders in sheet.Options) then showHeaders := false;
end;
AppendToStream(FSSettings,
XML_HEADER);
AppendToStream(FSSettings,
'');
AppendToStream(FSSettings,
'' +
'' +
'' +
'' +
'Tabelle1' +
'100' +
'100' +
'false' +
''+FALSE_TRUE[showGrid]+'' +
''+FALSE_TRUE[showHeaders]+'' +
'');
WriteTableSettings(FSSettings);
AppendToStream(FSSettings,
'' +
'' +
'' +
'' +
'' +
'');
end;
procedure TsSpreadOpenDocWriter.WriteStyles;
begin
AppendToStream(FSStyles,
XML_HEADER);
AppendToStream(FSStyles,
'');
AppendToStream(FSStyles,
'');
WriteFontNames(FSStyles);
AppendToStream(FSStyles,
'');
AppendToStream(FSStyles,
'');
AppendToStream(FSStyles,
'',
WriteDefaultFontXMLAsString,
'');
AppendToStream(FSStyles,
'');
AppendToStream(FSStyles,
'' +
'' +
'' +
'' +
'' +
'' +
'' +
'' +
'' +
'' +
'');
AppendToStream(FSStyles,
'' +
'' +
'' +
'' +
'' +
'' +
'' +
'' +
'');
end;
procedure TsSpreadOpenDocWriter.WriteContent;
var
i: Integer;
begin
AppendToStream(FSContent,
XML_HEADER);
AppendToStream(FSContent,
'' +
'');
// Fonts
WriteFontNames(FSContent);
// Automatic styles
AppendToStream(FSContent,
'');
WriteNumFormats(FSContent);
WriteColStyles(FSContent);
WriteRowStyles(FSContent);
AppendToStream(FSContent,
'' +
'' +
'');
// Automatically generated styles
WriteCellStyles(FSContent);
AppendToStream(FSContent,
'');
// Body
AppendToStream(FSContent,
'' +
'');
// Write all worksheets
for i := 0 to Workbook.GetWorksheetCount - 1 do
WriteWorksheet(FSContent, Workbook.GetWorksheetByIndex(i));
AppendToStream(FSContent,
'' +
'' +
''
);
end;
procedure TsSpreadOpenDocWriter.WriteWorksheet(AStream: TStream;
CurSheet: TsWorksheet);
begin
FWorksheet := CurSheet;
// Header
AppendToStream(AStream,
'');
// columns
WriteColumns(AStream, CurSheet);
// rows and cells
// The cells need to be written in order, row by row, cell by cell
if (boVirtualMode in Workbook.Options) then
begin
if Assigned(Workbook.OnWriteCellData) then
WriteVirtualCells(AStream, CurSheet)
end else
WriteRowsAndCells(AStream, CurSheet);
// Footer
AppendToStream(AStream,
'');
end;
procedure TsSpreadOpenDocWriter.WriteCellStyles(AStream: TStream);
var
i: Integer;
s: String;
nfidx: Integer;
nfs: String;
fmt: TsCellFormat;
begin
for i := 0 to FWorkbook.GetNumCellFormats - 1 do
begin
fmt := FWorkbook.GetCellFormat(i);
nfidx := NumFormatList.FindByFormatStr(fmt.NumberFormatStr);
if nfidx <> -1
then nfs := 'style:data-style-name="' + NumFormatList[nfidx].Name +'"'
else nfs := '';
// Start and name
AppendToStream(AStream,
'');
// style:text-properties
if (uffBold in fmt.UsedFormattingFields) then
AppendToStream(AStream,
'');
s := WriteFontStyleXMLAsString(fmt);
if s <> '' then
AppendToStream(AStream,
'');
s := WriteBorderStyleXMLAsString(fmt) +
WriteBackgroundColorStyleXMLAsString(fmt) +
WriteWordwrapStyleXMLAsString(fmt) +
WriteTextRotationStyleXMLAsString(fmt) +
WriteVertAlignmentStyleXMLAsString(fmt);
if s <> '' then
AppendToStream(AStream,
'');
// style:paragraph-properties
s := WriteHorAlignmentStyleXMLAsString(fmt);
if s <> '' then
AppendToStream(AStream,
'');
// End
AppendToStream(AStream,
'');
end;
end;
procedure TsSpreadOpenDocWriter.WriteColStyles(AStream: TStream);
var
i: Integer;
colstyle: TColumnStyleData;
begin
if FColumnStyleList.Count = 0 then
begin
AppendToStream(AStream,
'',
'',
'');
exit;
end;
for i := 0 to FColumnStyleList.Count-1 do
begin
colStyle := TColumnStyleData(FColumnStyleList[i]);
// Start and Name
AppendToStream(AStream, Format(
'', [colStyle.Name]));
// Column width
AppendToStream(AStream, Format(
'',
[colStyle.ColWidth], FPointSeparatorSettings));
// End
AppendToStream(AStream,
'');
end;
end;
procedure TsSpreadOpenDocWriter.WriteColumns(AStream: TStream;
ASheet: TsWorksheet);
var
lastCol: Integer;
j, k: Integer;
w, w_mm: Double;
widthMultiplier: Double;
styleName: String;
colsRepeated: Integer;
colsRepeatedStr: String;
begin
widthMultiplier := Workbook.GetFont(0).Size / 2;
lastCol := ASheet.GetLastColIndex;
j := 0;
while (j <= lastCol) do
begin
w := ASheet.GetColWidth(j);
// Convert to mm
w_mm := PtsToMM(w * widthMultiplier);
// Find width in ColumnStyleList to retrieve corresponding style name
styleName := '';
for k := 0 to FColumnStyleList.Count-1 do
if SameValue(TColumnStyleData(FColumnStyleList[k]).ColWidth, w_mm, COLWIDTH_EPS) then begin
styleName := TColumnStyleData(FColumnStyleList[k]).Name;
break;
end;
if stylename = '' then
raise Exception.Create(rsColumnStyleNotFound);
// Determine value for "number-columns-repeated"
colsRepeated := 1;
k := j+1;
while (k <= lastCol) do
begin
if ASheet.GetColWidth(k) = w then
inc(colsRepeated)
else
break;
inc(k);
end;
colsRepeatedStr := IfThen(colsRepeated = 1, '', Format(' table:number-columns-repeated="%d"', [colsRepeated]));
AppendToStream(AStream, Format(
'',
[styleName, colsRepeatedStr]));
j := j + colsRepeated;
end;
end;
function TsSpreadOpenDocWriter.WriteCommentXMLAsString(AComment: String): String;
var
L: TStringList;
s: String;
err: Boolean;
i: Integer;
begin
Result := '';
if AComment = '' then exit;
result := '';
err := false;
L := TStringList.Create;
try
L.Text := AComment;
for i:=0 to L.Count-1 do begin
s := L[i];
if not ValidXMLText(s) then begin
if not err then
Workbook.AddErrorMsg(rsInvalidCharacterInCellComment, [AComment]);
err := true;
end;
Result := Result + '' + s + '';
end;
finally
L.Free;
end;
Result := Result + '';
end;
procedure TsSpreadOpenDocWriter.WriteFontNames(AStream: TStream);
var
L: TStringList;
fnt: TsFont;
i: Integer;
begin
AppendToStream(AStream,
'');
L := TStringList.Create;
try
for i:=0 to Workbook.GetFontCount-1 do
begin
fnt := Workbook.GetFont(i);
if (fnt <> nil) and (L.IndexOf(fnt.FontName) = -1) then
L.Add(fnt.FontName);
end;
for i:=0 to L.Count-1 do
AppendToStream(AStream, Format(
'', [L[i], L[i]]));
finally
L.Free;
end;
AppendToStream(AStream,
'');
end;
procedure TsSpreadOpenDocWriter.WriteNumFormats(AStream: TStream);
var
i: Integer;
numFmtXML: String;
fmtItem: TsNumFormatData;
parser: TsSpreadOpenDocNumFormatParser;
begin
for i:=0 to FNumFormatList.Count-1 do
begin
fmtItem := FNumFormatList.Items[i];
parser := TsSpreadOpenDocNumFormatParser.Create(Workbook, fmtItem.FormatString,
fmtItem.NumFormat);
try
numFmtXML := parser.BuildXMLAsString(fmtItem.Name);
if numFmtXML <> '' then
AppendToStream(AStream, numFmtXML);
finally
parser.Free;
end;
end;
end;
procedure TsSpreadOpenDocWriter.WriteRowsAndCells(AStream: TStream; ASheet: TsWorksheet);
var
r, rr: Cardinal; // row index in sheet
c, cc: Cardinal; // column index in sheet
row: PRow; // sheet row record
cell: PCell; // current cell
styleName: String;
k: Integer;
h, h_mm: Single; // row height in "lines" and millimeters, respectively
h1: Single;
colsRepeated: Cardinal;
rowsRepeated: Cardinal;
colsRepeatedStr: String;
rowsRepeatedStr: String;
firstCol, firstRow, lastCol, lastRow: Cardinal;
rowStyleData: TRowStyleData;
defFontSize: Single;
emptyRowsAbove: Boolean;
begin
// some abbreviations...
defFontSize := Workbook.GetFont(0).Size;
GetSheetDimensions(ASheet, firstRow, lastRow, firstCol, lastCol);
emptyRowsAbove := firstRow > 0;
// Now loop through all rows
r := firstRow;
while (r <= lastRow) do
begin
rowsRepeated := 1;
// Look for the row style of the current row (r)
row := ASheet.FindRow(r);
if row = nil then
styleName := 'ro1'
else
begin
styleName := '';
h := row^.Height; // row height in "lines"
h_mm := PtsToMM((h + ROW_HEIGHT_CORRECTION) * defFontSize); // in mm
for k := 0 to FRowStyleList.Count-1 do begin
rowStyleData := TRowStyleData(FRowStyleList[k]);
// Compare row heights, but be aware of rounding errors
if SameValue(rowStyleData.RowHeight, h_mm, 1E-3) then
begin
styleName := rowStyleData.Name;
break;
end;
end;
if styleName = '' then
raise Exception.Create(rsRowStyleNotFound);
end;
// Take care of empty rows above the first row
if (r = firstRow) and emptyRowsAbove then
begin
rowsRepeated := r;
rowsRepeatedStr := IfThen(rowsRepeated = 1, '',
Format('table:number-rows-repeated="%d"', [rowsRepeated]));
colsRepeated := lastCol + 1;
colsRepeatedStr := IfThen(colsRepeated = 1, '',
Format('table:number-columns-repeated="%d"', [colsRepeated]));
AppendToStream(AStream, Format(
'' +
'' +
'',
[styleName, rowsRepeatedStr, colsRepeatedStr]));
rowsRepeated := 1;
end
else
// Look for empty rows with the same style, they need the "number-rows-repeated" element.
if (ASheet.Cells.GetFirstCellOfRow(r) = nil) then
begin
rr := r + 1;
while (rr <= lastRow) do
begin
if ASheet.Cells.GetFirstCellOfRow(rr) <> nil then
break;
h1 := ASheet.GetRowHeight(rr);
if not SameValue(h, h1, ROWHEIGHT_EPS) then
break;
inc(rr);
end;
rowsRepeated := rr - r;
rowsRepeatedStr := IfThen(rowsRepeated = 1, '',
Format('table:number-rows-repeated="%d"', [rowsRepeated]));
colsRepeated := lastCol - firstCol + 1;
colsRepeatedStr := IfThen(colsRepeated = 1, '',
Format('table:number-columns-repeated="%d"', [colsRepeated]));
AppendToStream(AStream, Format(
'' +
'' +
'',
[styleName, rowsRepeatedStr, colsRepeatedStr]));
r := rr;
continue;
end;
// Now we know that there are cells.
// Write the row XML
AppendToStream(AStream, Format(
'', [styleName]));
// Loop along the row and find the cells.
c := 0;
while c <= lastCol do
begin
// Get the cell from the sheet
cell := ASheet.FindCell(r, c);
// Belongs to merged block?
if (cell <> nil) and not FWorksheet.IsMergeBase(cell) and FWorksheet.IsMerged(cell) then
// this means: all cells of a merged block except for the merge base
begin
AppendToStream(AStream,
'');
inc(c);
continue;
end;
// Empty cell? Need to count how many to add "table:number-columns-repeated"
colsRepeated := 1;
if cell = nil then
begin
cc := c + 1;
while (cc <= lastCol) do
begin
cell := ASheet.FindCell(r, cc);
if cell <> nil then
break;
inc(cc)
end;
colsRepeated := cc - c;
colsRepeatedStr := IfThen(colsRepeated = 1, '',
Format('table:number-columns-repeated="%d"', [colsRepeated]));
AppendToStream(AStream, Format(
'', [colsRepeatedStr]));
end else
WriteCellToStream(AStream, cell);
// WriteCellCallback(cell, AStream);
inc(c, colsRepeated);
end;
AppendToStream(AStream,
'');
// Next row
inc(r, rowsRepeated);
end;
end;
procedure TsSpreadOpenDocWriter.WriteRowStyles(AStream: TStream);
var
i: Integer;
rowstyle: TRowStyleData;
begin
if FRowStyleList.Count = 0 then
begin
AppendToStream(AStream,
'' +
'' +
'');
exit;
end;
for i := 0 to FRowStyleList.Count-1 do
begin
rowStyle := TRowStyleData(FRowStyleList[i]);
// Start and Name
AppendToStream(AStream, Format(
'', [rowStyle.Name]));
// Column width
AppendToStream(AStream, Format(
'');
// End
AppendToStream(AStream,
'');
end;
end;
constructor TsSpreadOpenDocWriter.Create(AWorkbook: TsWorkbook);
begin
inherited Create(AWorkbook);
FColumnStyleList := TFPList.Create;
FRowStyleList := TFPList.Create;
FPointSeparatorSettings := SysUtils.DefaultFormatSettings;
FPointSeparatorSettings.DecimalSeparator:='.';
FPointSeparatorSettings.ListSeparator := ';'; // for formulas
// http://en.wikipedia.org/wiki/List_of_spreadsheet_software#Specifications
FLimitations.MaxColCount := 1024;
FLimitations.MaxRowCount := 1048576;
end;
destructor TsSpreadOpenDocWriter.Destroy;
var
j: Integer;
begin
for j:=FColumnStyleList.Count-1 downto 0 do TObject(FColumnStyleList[j]).Free;
FColumnStyleList.Free;
for j:=FRowStyleList.Count-1 downto 0 do TObject(FRowStyleList[j]).Free;
FRowStyleList.Free;
inherited Destroy;
end;
{@@ ----------------------------------------------------------------------------
Writes a string to a file. Helper convenience method.
-------------------------------------------------------------------------------}
procedure TsSpreadOpenDocWriter.WriteStringToFile(AString, AFileName: string);
var
TheStream : TFileStream;
S : String;
begin
TheStream := TFileStream.Create(AFileName, fmCreate);
S:=AString;
TheStream.WriteBuffer(Pointer(S)^,Length(S));
TheStream.Free;
end;
{@@ ----------------------------------------------------------------------------
Writes an OOXML document to a file.
-------------------------------------------------------------------------------}
procedure TsSpreadOpenDocWriter.WriteToFile(const AFileName: string;
const AOverwriteExisting: Boolean);
var
lStream: TStream;
lMode: word;
begin
if AOverwriteExisting
then lMode := fmCreate or fmOpenWrite
else lMode := fmCreate;
if (boBufStream in Workbook.Options) then
lStream := TBufStream.Create(AFileName, lMode)
else
lStream := TFileStream.Create(AFileName, lMode);
try
WriteToStream(lStream);
finally
FreeAndNil(lStream);
end;
end;
procedure TsSpreadOpenDocWriter.WriteToStream(AStream: TStream);
var
FZip: TZipper;
begin
{ Analyze the workbook and collect all information needed }
ListAllNumFormats;
// ListAllFormattingStyles;
ListAllColumnStyles;
ListAllRowStyles;
{ Create the streams that will hold the file contents }
CreateStreams;
{ Fill the strings with the contents of the files }
WriteMimetype();
WriteMetaInfManifest();
WriteMeta();
WriteSettings();
WriteStyles();
WriteContent;
{ Now compress the files }
FZip := TZipper.Create;
try
FZip.FileName := '__temp__.tmp';
FZip.Entries.AddFileEntry(FSMeta, OPENDOC_PATH_META);
FZip.Entries.AddFileEntry(FSSettings, OPENDOC_PATH_SETTINGS);
FZip.Entries.AddFileEntry(FSStyles, OPENDOC_PATH_STYLES);
FZip.Entries.AddFileEntry(FSContent, OPENDOC_PATH_CONTENT);
FZip.Entries.AddFileEntry(FSMimetype, OPENDOC_PATH_MIMETYPE);
FZip.Entries.AddFileEntry(FSMetaInfManifest, OPENDOC_PATH_METAINF_MANIFEST);
ResetStreams;
FZip.SaveToStream(AStream);
finally
DestroyStreams;
FZip.Free;
end;
end;
{ Writes an empty cell to the stream }
procedure TsSpreadOpenDocWriter.WriteBlank(AStream: TStream;
const ARow, ACol: Cardinal; ACell: PCell);
var
colsSpannedStr: String;
rowsSpannedStr: String;
spannedStr: String;
comment: String;
r1,c1,r2,c2: Cardinal;
fmt: TsCellFormat;
begin
Unused(ARow, ACol);
// Hyperlink
if FWorksheet.HasHyperlink(ACell) then
FWorkbook.AddErrorMsg(rsODSHyperlinksOfTextCellsOnly, [GetCellString(ARow, ACol)]);
// Comment
comment := WriteCommentXMLAsString(FWorksheet.ReadComment(ACell));
// Merged?
if FWorksheet.IsMergeBase(ACell) then
begin
FWorksheet.FindMergedRange(ACell, r1, c1, r2, c2);
rowsSpannedStr := Format('table:number-rows-spanned="%d"', [r2 - r1 + 1]);
colsSpannedStr := Format('table:number-columns-spanned="%d"', [c2 - c1 + 1]);
spannedStr := colsSpannedStr + ' ' + rowsSpannedStr;
end else
spannedStr := '';
fmt := FWorkbook.GetCellFormat(ACell^.FormatIndex);
if fmt.UsedFormattingFields <> [] then
AppendToStream(AStream, Format(
'', [ACell^.FormatIndex, spannedStr]),
comment,
'')
else
if comment <> '' then
AppendToStream(AStream,
'' + comment + '')
else
AppendToStream(AStream,
'');
end;
{@@ ----------------------------------------------------------------------------
Writes a boolean cell to the stream
-------------------------------------------------------------------------------}
procedure TsSpreadOpenDocWriter.WriteBool(AStream: TStream;
const ARow, ACol: Cardinal; const AValue: Boolean; ACell: PCell);
var
lStyle, valType: String;
r1,c1,r2,c2: Cardinal;
rowsSpannedStr, colsSpannedStr, spannedStr: String;
comment: String;
strValue: String;
displayStr: String;
fmt: TsCellFormat;
begin
Unused(ARow, ACol);
valType := 'boolean';
fmt := FWorkbook.GetCellFormat(ACell^.FormatIndex);
if fmt.UsedFormattingFields <> [] then
lStyle := ' table:style-name="ce' + IntToStr(ACell^.FormatIndex) + '" '
else
lStyle := '';
// Comment
comment := WriteCommentXMLAsString(FWorksheet.ReadComment(ACell));
// Merged?
if FWorksheet.IsMergeBase(ACell) then
begin
FWorksheet.FindMergedRange(ACell, r1, c1, r2, c2);
rowsSpannedStr := Format('table:number-rows-spanned="%d"', [r2 - r1 + 1]);
colsSpannedStr := Format('table:number-columns-spanned="%d"', [c2 - c1 + 1]);
spannedStr := colsSpannedStr + ' ' + rowsSpannedStr;
end else
spannedStr := '';
// Displayed value
if AValue then
begin
StrValue := 'true';
DisplayStr := rsTRUE;
end else
begin
strValue := 'false';
DisplayStr := rsFALSE;
end;
// Hyperlink
if FWorksheet.HasHyperlink(ACell) then
FWorkbook.AddErrorMsg(rsODSHyperlinksOfTextCellsOnly, [GetCellString(ARow, ACol)]);
AppendToStream(AStream, Format(
'' +
comment +
'%s' +
'', [
valType, StrValue, lStyle, spannedStr,
DisplayStr
]));
end;
{@@ ----------------------------------------------------------------------------
Creates an XML string for inclusion of the background color into the
written file from the backgroundcolor setting in the given format record.
Is called from WriteStyles (via WriteStylesXMLAsString).
NOTE: ODS does not support fill patterns. Fill patterns are converted to
solid fills by mixing pattern and background colors in the ratio defined
by the fill pattern. Result agrees with that what LO/OO show for an imported
xls file.
-------------------------------------------------------------------------------}
function TsSpreadOpenDocWriter.WriteBackgroundColorStyleXMLAsString(
const AFormat: TsCellFormat): String;
type
TRgb = record r,g,b,a: byte; end;
const // fraction of pattern color in fill pattern
FRACTION: array[TsFillStyle] of Double = (
0.0, 1.0, 0.75, 0.50, 0.25, 0.125, 0.0625, // fsNoFill..fsGray6
0.5, 0.5, 0.5, 0.5, // fsStripeHor..fsStripeDiagDown
0.25, 0.25, 0.25, 0.25, // fsThinStripeHor..fsThinStripeDiagDown
0.5, 6.0/16, 0.75, 7.0/16); // fsHatchDiag..fsThinHatchHor
var
fc,bc: TsColorValue;
mix: TRgb;
fraction_fc, fraction_bc: Double;
begin
Result := '';
if not (uffBackground in AFormat.UsedFormattingFields) then
exit;
// Foreground and background colors
fc := Workbook.GetPaletteColor(AFormat.Background.FgColor);
if Aformat.Background.BgColor = scTransparent then
bc := Workbook.GetPaletteColor(scWhite)
else
bc := Workbook.GetPaletteColor(AFormat.Background.BgColor);
// Mixing fraction
fraction_fc := FRACTION[AFormat.Background.Style];
fraction_bc := 1.0 - fraction_fc;
// Mixed color
mix.r := Min(round(fraction_fc*TRgb(fc).r + fraction_bc*TRgb(bc).r), 255);
mix.g := Min(round(fraction_fc*TRgb(fc).g + fraction_bc*TRgb(bc).g), 255);
mix.b := Min(round(fraction_fc*TRgb(fc).b + fraction_bc*TRgb(bc).b), 255);
Result := Format('fo:background-color="%s" ', [
ColorToHTMLColorStr(TsColorValue(mix))
]);
end;
{@@ ----------------------------------------------------------------------------
Creates an XML string for inclusion of borders and border styles into the
written file from the border settings in the given format record.
Is called from WriteStyles (via WriteStylesXMLAsString).
-------------------------------------------------------------------------------}
function TsSpreadOpenDocWriter.WriteBorderStyleXMLAsString(
const AFormat: TsCellFormat): String;
begin
Result := '';
if not (uffBorder in AFormat.UsedFormattingFields) then
exit;
if cbSouth in AFormat.Border then
begin
Result := Result + Format('fo:border-bottom="%s %s %s" ', [
BORDER_LINEWIDTHS[AFormat.BorderStyles[cbSouth].LineStyle],
BORDER_LINESTYLES[AFormat.BorderStyles[cbSouth].LineStyle],
Workbook.GetPaletteColorAsHTMLStr(AFormat.BorderStyles[cbSouth].Color)
]);
if AFormat.BorderStyles[cbSouth].LineStyle = lsDouble then
Result := Result + 'style:border-linewidth-bottom="0.002cm 0.035cm 0.002cm" ';
end
else
Result := Result + 'fo:border-bottom="none" ';
if cbWest in AFormat.Border then
begin
Result := Result + Format('fo:border-left="%s %s %s" ', [
BORDER_LINEWIDTHS[AFormat.BorderStyles[cbWest].LineStyle],
BORDER_LINESTYLES[AFormat.BorderStyles[cbWest].LineStyle],
Workbook.GetPaletteColorAsHTMLStr(AFormat.BorderStyles[cbWest].Color)
]);
if AFormat.BorderStyles[cbWest].LineStyle = lsDouble then
Result := Result + 'style:border-linewidth-left="0.002cm 0.035cm 0.002cm" ';
end
else
Result := Result + 'fo:border-left="none" ';
if cbEast in AFormat.Border then
begin
Result := Result + Format('fo:border-right="%s %s %s" ', [
BORDER_LINEWIDTHS[AFormat.BorderStyles[cbEast].LineStyle],
BORDER_LINESTYLES[AFormat.BorderStyles[cbEast].LineStyle],
Workbook.GetPaletteColorAsHTMLStr(AFormat.BorderStyles[cbEast].Color)
]);
if AFormat.BorderStyles[cbSouth].LineStyle = lsDouble then
Result := Result + 'style:border-linewidth-right="0.002cm 0.035cm 0.002cm" ';
end
else
Result := Result + 'fo:border-right="none" ';
if cbNorth in AFormat.Border then
begin
Result := Result + Format('fo:border-top="%s %s %s" ', [
BORDER_LINEWIDTHS[AFormat.BorderStyles[cbNorth].LineStyle],
BORDER_LINESTYLES[AFormat.BorderStyles[cbNorth].LineStyle],
Workbook.GetPaletteColorAsHTMLStr(AFormat.BorderStyles[cbNorth].Color)
]);
if AFormat.BorderStyles[cbSouth].LineStyle = lsDouble then
Result := Result + 'style:border-linewidth-top="0.002cm 0.035cm 0.002cm" ';
end else
Result := Result + 'fo:border-top="none" ';
if cbDiagUp in AFormat.Border then
begin
Result := Result + Format('style:diagonal-bl-tr="%s %s %s" ', [
BORDER_LINEWIDTHS[AFormat.BorderStyles[cbDiagUp].LineStyle],
BORDER_LINESTYLES[AFormat.BorderStyles[cbDiagUp].LineStyle],
Workbook.GetPaletteColorAsHTMLStr(AFormat.BorderStyles[cbDiagUp].Color)
]);
end;
if cbDiagDown in AFormat.Border then
begin
Result := Result + Format('style:diagonal-tl-br="%s %s %s" ', [
BORDER_LINEWIDTHS[AFormat.BorderStyles[cbDiagDown].LineStyle],
BORDER_LINESTYLES[AFormat.BorderStyles[cbDiagDown].LineStyle],
Workbook.GetPaletteColorAsHTMLStr(AFormat.BorderStyles[cbDiagDown].Color)
]);
end;
end;
function TsSpreadOpenDocWriter.WriteDefaultFontXMLAsString: String;
var
fnt: TsFont;
begin
fnt := Workbook.GetFont(0);
Result := Format(
'',
[fnt.FontName, fnt.Size], FPointSeparatorSettings
);
end;
procedure TsSpreadOpenDocWriter.WriteError(AStream: TStream;
const ARow, ACol: Cardinal; const AValue: TsErrorValue; ACell: PCell);
begin
Unused(AStream);
Unused(ARow, ACol);
Unused(AValue, ACell);
// ??
end;
function TsSpreadOpenDocWriter.WriteFontStyleXMLAsString(
const AFormat: TsCellFormat): String;
var
fnt: TsFont;
defFnt: TsFont;
begin
Result := '';
if not (uffFont in AFormat.UsedFormattingFields) then
exit;
fnt := Workbook.GetFont(AFormat.FontIndex);
defFnt := Workbook.GetDefaultfont;
if fnt.FontName <> defFnt.FontName then
Result := Result + Format('style:font-name="%s" ', [fnt.FontName]);
if fnt.Size <> defFnt.Size then
Result := Result + Format('fo:font-size="%.1fpt" style:font-size-asian="%.1fpt" style:font-size-complex="%.1fpt" ',
[fnt.Size, fnt.Size, fnt.Size], FPointSeparatorSettings);
if fssBold in fnt.Style then
Result := Result + 'fo:font-weight="bold" style:font-weight-asian="bold" style:font-weight-complex="bold" ';
if fssItalic in fnt.Style then
Result := Result + 'fo:font-style="italic" style:font-style-asian="italic" style:font-style-complex="italic" ';
if fssUnderline in fnt.Style then
Result := Result + 'style:text-underline-style="solid" style:text-underline-width="auto" style:text-underline-color="font-color" ';
if fssStrikeout in fnt.Style then
Result := Result + 'style:text-line-through-style="solid" ';
if fnt.Color <> defFnt.Color then
Result := Result + Format('fo:color="%s" ', [Workbook.GetPaletteColorAsHTMLStr(fnt.Color)]);
end;
{@@ ----------------------------------------------------------------------------
Creates an XML string for inclusion of the horizontal alignment into the
written file from the horizontal alignment setting in the format cell.
Is called from WriteStyles (via WriteStylesXMLAsString).
-------------------------------------------------------------------------------}
function TsSpreadOpenDocWriter.WriteHorAlignmentStyleXMLAsString(
const AFormat: TsCellFormat): String;
begin
Result := '';
if not (uffHorAlign in AFormat.UsedFormattingFields) then
exit;
case AFormat.HorAlignment of
haLeft : Result := 'fo:text-align="start" ';
haCenter : Result := 'fo:text-align="center" ';
haRight : Result := 'fo:text-align="end" ';
end;
end;
procedure TsSpreadOpenDocWriter.WriteTableSettings(AStream: TStream);
var
i: Integer;
sheet: TsWorkSheet;
hsm: Integer; // HorizontalSplitMode
vsm: Integer; // VerticalSplitMode
asr: Integer; // ActiveSplitRange
begin
for i:=0 to Workbook.GetWorksheetCount-1 do
begin
sheet := Workbook.GetWorksheetByIndex(i);
AppendToStream(AStream,
'');
hsm := 0; vsm := 0; asr := 2;
if (soHasFrozenPanes in sheet.Options) then
begin
if (sheet.LeftPaneWidth > 0) and (sheet.TopPaneHeight > 0) then
begin
hsm := 2; vsm := 2; asr := 3;
end else
if (sheet.LeftPaneWidth > 0) then
begin
hsm := 2; vsm := 0; asr := 3;
end else if (sheet.TopPaneHeight > 0) then
begin
hsm := 0; vsm := 2; asr := 2;
end;
end;
{showGrid := (soShowGridLines in sheet.Options);}
AppendToStream(AStream,
''+IntToStr(sheet.LeftPaneWidth)+'');
AppendToStream(AStream,
''+IntToStr(sheet.TopPaneHeight)+'');
AppendToStream(AStream,
''+IntToStr(hsm)+'');
AppendToStream(AStream,
''+IntToStr(vsm)+'');
AppendToStream(AStream,
''+IntToStr(sheet.LeftPaneWidth)+'');
AppendToStream(AStream,
''+IntToStr(sheet.TopPaneHeight)+'');
AppendToStream(AStream,
''+IntToStr(asr)+'');
AppendToStream(AStream,
'0');
AppendToStream(AStream,
''+IntToStr(sheet.LeftPaneWidth)+'');
AppendToStream(AStream,
'0');
AppendToStream(AStream,
''+IntToStr(sheet.TopPaneHeight)+'');
AppendToStream(AStream,
'true');
// this "ShowGrid" overrides the global setting. But Open/LibreOffice do not allow to change ShowGrid per sheet.
AppendToStream(AStream,
'');
end;
end;
{@@ ----------------------------------------------------------------------------
Creates an XML string for inclusion of the textrotation style option into the
written file from the textrotation setting in the format cell.
Is called from WriteStyles (via WriteStylesXMLAsString).
-------------------------------------------------------------------------------}
function TsSpreadOpenDocWriter.WriteTextRotationStyleXMLAsString(
const AFormat: TsCellFormat): String;
begin
Result := '';
if not (uffTextRotation in AFormat.UsedFormattingFields) then
exit;
case AFormat.TextRotation of
rt90DegreeClockwiseRotation : Result := 'style:rotation-angle="270" ';
rt90DegreeCounterClockwiseRotation : Result := 'style:rotation-angle="90" ';
rtStacked : Result := 'style:direction="ttb" ';
end;
end;
{@@ ----------------------------------------------------------------------------
Creates an XML string for inclusion of the vertical alignment into the
written file from the vertical alignment setting in the given format record.
Is called from WriteStyles (via WriteStylesXMLAsString).
-------------------------------------------------------------------------------}
function TsSpreadOpenDocWriter.WriteVertAlignmentStyleXMLAsString(
const AFormat: TsCellFormat): String;
begin
Result := '';
if not (uffVertAlign in AFormat.UsedFormattingFields) then
exit;
case AFormat.VertAlignment of
vaTop : Result := 'style:vertical-align="top" ';
vaCenter : Result := 'style:vertical-align="middle" ';
vaBottom : Result := 'style:vertical-align="bottom" ';
end;
end;
procedure TsSpreadOpenDocWriter.WriteVirtualCells(AStream: TStream;
ASheet: TsWorksheet);
var
r, c, cc: Cardinal;
lCell: TCell;
row: PRow;
value: variant;
styleCell: PCell;
styleName: String;
h, h_mm: Single; // row height in "lines" and millimeters, respectively
k: Integer;
rowStyleData: TRowStyleData;
rowsRepeated: Cardinal;
colsRepeated: Cardinal;
colsRepeatedStr: String;
defFontSize: Single;
lastCol, lastRow: Cardinal;
begin
// some abbreviations...
lastCol := Workbook.VirtualColCount - 1;
lastRow := Workbook.VirtualRowCount - 1;
defFontSize := Workbook.GetFont(0).Size;
rowsRepeated := 1;
r := 0;
while (r <= lastRow) do
begin
// Look for the row style of the current row (r)
row := ASheet.FindRow(r);
if row = nil then
styleName := 'ro1'
else
begin
styleName := '';
h := row^.Height; // row height in "lines"
h_mm := PtsToMM((h + ROW_HEIGHT_CORRECTION) * defFontSize); // in mm
for k := 0 to FRowStyleList.Count-1 do
begin
rowStyleData := TRowStyleData(FRowStyleList[k]);
// Compare row heights, but be aware of rounding errors
if SameValue(rowStyleData.RowHeight, h_mm, 1E-3) then
begin
styleName := rowStyleData.Name;
break;
end;
end;
if styleName = '' then
raise Exception.Create(rsRowStyleNotFound);
end;
// No empty rows allowed here for the moment!
// Write the row XML
AppendToStream(AStream, Format(
'', [styleName]));
// Loop along the row and write the cells.
c := 0;
while c <= lastCol do
begin
// Empty cell? Need to count how many "table:number-columns-repeated" to be added
colsRepeated := 1;
lCell.Row := r; // to silence a compiler hint...
InitCell(r, c, lCell);
value := varNull;
styleCell := nil;
Workbook.OnWriteCellData(Workbook, r, c, value, styleCell);
if VarIsNull(value) then
begin
// Local loop to count empty cells
cc := c + 1;
while (cc <= lastCol) do
begin
InitCell(r, cc, lCell);
value := varNull;
styleCell := nil;
Workbook.OnWriteCellData(Workbook, r, cc, value, styleCell);
if not VarIsNull(value) then
break;
inc(cc);
end;
colsRepeated := cc - c;
colsRepeatedStr := IfThen(colsRepeated = 1, '',
Format('table:number-columns-repeated="%d"', [colsRepeated]));
AppendToStream(AStream, Format(
'', [colsRepeatedStr]));
end else begin
if VarIsNumeric(value) then
begin
lCell.ContentType := cctNumber;
lCell.NumberValue := value;
end else
if VarType(value) = varDate then
begin
lCell.ContentType := cctDateTime;
lCell.DateTimeValue := StrToDateTime(VarToStr(value), Workbook.FormatSettings); // was: StrToDate
end else
if VarIsStr(value) then
begin
lCell.ContentType := cctUTF8String;
lCell.UTF8StringValue := VarToStrDef(value, '');
end else
if VarIsBool(value) then
begin
lCell.ContentType := cctBool;
lCell.BoolValue := value <> 0;
end else
lCell.ContentType := cctEmpty;
WriteCellToStream(AStream, @lCell);
// WriteCellCallback(@lCell, AStream);
end;
inc(c, colsRepeated);
end;
AppendToStream(AStream,
'');
// Next row
inc(r, rowsRepeated);
end;
end;
{@@ ----------------------------------------------------------------------------
Creates an XML string for inclusion of the wordwrap option into the
written file from the wordwrap setting in the format cell.
Is called from WriteStyles (via WriteStylesXMLAsString).
-------------------------------------------------------------------------------}
function TsSpreadOpenDocWriter.WriteWordwrapStyleXMLAsString(
const AFormat: TsCellFormat): String;
begin
if (uffWordWrap in AFormat.UsedFormattingFields) then
Result := 'fo:wrap-option="wrap" '
else
Result := '';
end;
{@@ ----------------------------------------------------------------------------
Writes a string formula
-------------------------------------------------------------------------------}
procedure TsSpreadOpenDocWriter.WriteFormula(AStream: TStream; const ARow,
ACol: Cardinal; ACell: PCell);
var
lStyle: String = '';
parser: TsExpressionParser;
formula: String;
valuetype: String;
value: string;
valueStr: String;
colsSpannedStr: String;
rowsSpannedStr: String;
spannedStr: String;
comment: String;
r1,c1,r2,c2: Cardinal;
fmt: TsCellFormat;
begin
Unused(ARow, ACol);
// Style
fmt := FWorkbook.GetCellFormat(ACell^.FormatIndex);
if fmt.UsedFormattingFields <> [] then
lStyle := ' table:style-name="ce' + IntToStr(ACell^.FormatIndex) + '" '
else
lStyle := '';
// Comment
comment := WriteCommentXMLAsString(FWorksheet.ReadComment(ACell));
// Merged?
if FWorksheet.IsMergeBase(ACell) then
begin
FWorksheet.FindMergedRange(ACell, r1, c1, r2, c2);
rowsSpannedStr := Format('table:number-rows-spanned="%d"', [r2 - r1 + 1]);
colsSpannedStr := Format('table:number-columns-spanned="%d"', [c2 - c1 + 1]);
spannedStr := colsSpannedStr + ' ' + rowsSpannedStr;
end else
spannedStr := '';
// Hyperlink
if FWorksheet.HasHyperlink(ACell) then
FWorkbook.AddErrorMsg(rsODSHyperlinksOfTextCellsOnly, [GetCellString(ARow, ACol)]);
// Convert string formula to the format needed by ods: semicolon list separators!
parser := TsSpreadsheetParser.Create(FWorksheet);
try
parser.Dialect := fdOpenDocument;
{
if ACell^.SharedFormulaBase <> nil then
begin
parser.ActiveCell := ACell;
parser.Expression := ACell^.SharedFormulaBase^.FormulaValue;
end else
}
parser.Expression := ACell^.FormulaValue;
formula := Parser.LocalizedExpression[FPointSeparatorSettings];
finally
parser.Free;
end;
valueStr := '';
case ACell^.ContentType of
cctNumber:
begin
valuetype := 'float';
value := 'office:value="' + Format('%g', [ACell^.NumberValue], FPointSeparatorSettings) + '"';
end;
cctDateTime:
if trunc(ACell^.DateTimeValue) = 0 then
begin
valuetype := 'time';
value := 'office:time-value="' + FormatDateTime(ISO8601FormatTimeOnly, ACell^.DateTimeValue) + '"';
end
else
begin
valuetype := 'date';
if frac(ACell^.DateTimeValue) = 0.0 then
value := 'office:date-value="' + FormatDateTime(ISO8601FormatDateOnly, ACell^.DateTimeValue) + '"'
else
value := 'office:date-value="' + FormatDateTime(ISO8601FormatExtended, ACell^.DateTimeValue) + '"';
end;
cctUTF8String:
begin
valuetype := 'string';
value := 'office:string-value="' + ACell^.UTF8StringValue +'"';
valueStr := '' + ACell^.UTF8StringValue + '';
end;
cctBool:
begin
valuetype := 'boolean';
value := 'office:boolean-value="' + BoolToStr(ACell^.BoolValue, 'true', 'false') + '"';
end;
cctError:
begin
// Strange: but in case of an error, Open/LibreOffice always writes a
// float value 0 to the cell
valuetype := 'float';
value := 'office:value="0"';
end;
end;
{ Fix special xml characters }
formula := UTF8TextToXMLText(formula);
{ We are writing a very rudimentary formula here without result and result
data type. Seems to work... }
if FWorksheet.GetCalcState(ACell) = csCalculated then
AppendToStream(AStream, Format(
'' +
comment +
valueStr +
'', [
formula, valuetype, value, lStyle, spannedStr
]))
else
begin
AppendToStream(AStream, Format(
' '' then
AppendToStream(AStream, '>' + comment + '')
else
AppendToStream(AStream, '/>');
end;
end;
{@@ ----------------------------------------------------------------------------
Writes a cell with text content
The UTF8 Text needs to be converted, because some chars are invalid in XML
See bug with patch 19422
-------------------------------------------------------------------------------}
procedure TsSpreadOpenDocWriter.WriteLabel(AStream: TStream; const ARow,
ACol: Cardinal; const AValue: string; ACell: PCell);
var
lStyle: string = '';
colsSpannedStr: String;
rowsSpannedStr: String;
spannedStr: String;
r1,c1,r2,c2: Cardinal;
txt: ansistring;
textp, target, bookmark, comment: String;
fmt: TsCellFormat;
hyperlink: PsHyperlink;
u: TUri;
begin
Unused(ARow, ACol);
// Style
fmt := FWorkbook.GetCellFormat(ACell^.FormatIndex);
if fmt.UsedFormattingFields <> [] then
lStyle := ' table:style-name="ce' + IntToStr(ACell^.FormatIndex) + '" '
else
lStyle := '';
// Comment
comment := WriteCommentXMLAsString(FWorksheet.ReadComment(ACell));
// Merged?
if FWorksheet.IsMergeBase(ACell) then
begin
FWorksheet.FindMergedRange(ACell, r1, c1, r2, c2);
rowsSpannedStr := Format('table:number-rows-spanned="%d"', [r2 - r1 + 1]);
colsSpannedStr := Format('table:number-columns-spanned="%d"', [c2 - c1 + 1]);
spannedStr := colsSpannedStr + ' ' + rowsSpannedStr;
end else
spannedStr := '';
// Check for invalid characters
txt := AValue;
if not ValidXMLText(txt) then
Workbook.AddErrorMsg(
rsInvalidCharacterInCell, [
GetCellString(ARow, ACol)
]);
if FWorksheet.HasHyperlink(ACell) then
begin
hyperlink := FWorksheet.FindHyperlink(ACell);
SplitHyperlink(hyperlink^.Target, target, bookmark);
if (target = '') and (bookmark <> '') then
target := '#' + bookmark
else
if (pos('file:', target) = 0) then
begin
u := ParseURI(target);
if u.Protocol = '' then
target := '../' + target;
end;
{
u := ParseURI(hyperlink^.Target);
if u.Protocol = '' then // relative file name, or internal link
begin
if target <> '' then target := '../' + target;
if bookmark <> '' then target := target + '#' + bookmark;
end else
target := hyperlink^.Target;
}
ValidXMLText(target);
{
target := hyperlink^.Target;
if target[1] <> '#' then
begin
u := ParseURI(target);
if u.Protocol = '' then begin
//UriToFileName(hyperlink^.Target, target);
target := 'file:///' + ExpandFileName(target);
ValidXMLText(target);
// if not IsAbsoluteURI(target) then target := '..\' + target;
end;
end;
}
textp := Format(
''+
'%s'+
'', [target, txt]);
end else
textp := '' + txt + '';
// Write it ...
AppendToStream(AStream, Format(
'' +
comment +
textp +
'', [
lStyle, spannedStr
]));
end;
procedure TsSpreadOpenDocWriter.WriteNumber(AStream: TStream; const ARow,
ACol: Cardinal; const AValue: double; ACell: PCell);
var
StrValue: string;
DisplayStr: string;
lStyle: string = '';
valType: String;
colsSpannedStr: String;
rowsSpannedStr: String;
spannedStr: String;
comment: String;
r1,c1,r2,c2: Cardinal;
fmt: TsCellFormat;
begin
Unused(ARow, ACol);
valType := 'float';
fmt := FWorkbook.GetCellFormat(ACell^.FormatIndex);
if fmt.UsedFormattingFields <> [] then
begin
lStyle := ' table:style-name="ce' + IntToStr(ACell^.FormatIndex) + '" ';
if pos('%', fmt.NumberFormatStr) <> 0 then
valType := 'percentage'
else if IsCurrencyFormat(fmt.NumberFormat) then
valType := 'currency';
end else
lStyle := '';
// Comment
comment := WriteCommentXMLAsString(FWorksheet.ReadComment(ACell));
// Merged?
if FWorksheet.IsMergeBase(ACell) then
begin
FWorksheet.FindMergedRange(ACell, r1, c1, r2, c2);
rowsSpannedStr := Format('table:number-rows-spanned="%d"', [r2 - r1 + 1]);
colsSpannedStr := Format('table:number-columns-spanned="%d"', [c2 - c1 + 1]);
spannedStr := colsSpannedStr + ' ' + rowsSpannedStr;
end else
spannedStr := '';
// Displayed value
if IsInfinite(AValue) then
begin
StrValue := '1.#INF';
DisplayStr := '1.#INF';
end else begin
StrValue := FloatToStr(AValue, FPointSeparatorSettings); // Uses '.' as decimal separator
DisplayStr := FloatToStr(AValue); // Uses locale decimal separator
end;
// Hyperlink
if FWorksheet.HasHyperlink(ACell) then
FWorkbook.AddErrorMsg(rsODSHyperlinksOfTextCellsOnly, [GetCellString(ARow, ACol)]);
AppendToStream(AStream, Format(
'' +
comment +
'%s' +
'', [
valType, StrValue, lStyle, spannedStr,
DisplayStr
]));
end;
{@@ ----------------------------------------------------------------------------
Writes a date/time value
-------------------------------------------------------------------------------}
procedure TsSpreadOpenDocWriter.WriteDateTime(AStream: TStream;
const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell);
const
DATE_FMT: array[boolean] of string = (ISO8601FormatExtended, ISO8601FormatTimeOnly);
DT: array[boolean] of string = ('date', 'time');
// Index "boolean" is to be understood as "isTimeOnly"
var
lStyle: string;
strValue: String;
displayStr: String;
isTimeOnly: Boolean;
colsSpannedStr: String;
rowsSpannedStr: String;
spannedStr: String;
comment: String;
r1,c1,r2,c2: Cardinal;
fmt: TsCellFormat;
begin
Unused(ARow, ACol);
// Merged?
if FWorksheet.IsMergeBase(ACell) then
begin
FWorksheet.FindMergedRange(ACell, r1, c1, r2, c2);
rowsSpannedStr := Format('table:number-rows-spanned="%d"', [r2 - r1 + 1]);
colsSpannedStr := Format('table:number-columns-spanned="%d"', [c2 - c1 + 1]);
spannedStr := colsSpannedStr + ' ' + rowsSpannedStr;
end else
spannedStr := '';
fmt := FWorkbook.GetCellFormat(ACell^.FormatIndex);
if fmt.UsedFormattingFields <> [] then
lStyle := ' table:style-name="ce' + IntToStr(ACell^.FormatIndex) + '" '
else
lStyle := '';
// Comment
comment := WriteCommentXMLAsString(FWorksheet.ReadComment(ACell));
// Hyperlink
if FWorksheet.HasHyperlink(ACell) then
FWorkbook.AddErrorMsg(rsODSHyperlinksOfTextCellsOnly, [GetCellString(ARow, ACol)]);
// nfTimeInterval is a special case - let's handle it first:
if (fmt.NumberFormat = nfTimeInterval) then
begin
strValue := FormatDateTime(ISO8601FormatHoursOverflow, AValue, [fdoInterval]);
displayStr := FormatDateTime(fmt.NumberFormatStr, AValue, [fdoInterval]);
AppendToStream(AStream, Format(
'' +
comment +
'%s' +
'', [
strValue, lStyle, spannedStr,
displayStr
]));
end else
begin
// We have to distinguish between time-only values and values that contain date parts.
isTimeOnly := IsTimeFormat(fmt.NumberFormat) or IsTimeFormat(fmt.NumberFormatStr);
strValue := FormatDateTime(DATE_FMT[isTimeOnly], AValue);
displayStr := FormatDateTime(fmt.NumberFormatStr, AValue);
AppendToStream(AStream, Format(
'' +
comment +
'%s ' +
'', [
DT[isTimeOnly], DT[isTimeOnly], strValue, lStyle, spannedStr,
displayStr
]));
end;
end;
initialization
{@@ ----------------------------------------------------------------------------
Registers this reader / writer on fpSpreadsheet
-------------------------------------------------------------------------------}
RegisterSpreadFormat(TsSpreadOpenDocReader, TsSpreadOpenDocWriter, sfOpenDocument);
end.