2008-02-24 13:18:34 +00:00
|
|
|
{
|
|
|
|
fpsopendocument.pas
|
|
|
|
|
|
|
|
Writes an OpenDocument 1.0 Spreadsheet document
|
|
|
|
|
|
|
|
An OpenDocument document is a compressed ZIP file with the following files inside:
|
|
|
|
|
2009-01-29 11:30:38 +00:00
|
|
|
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
|
2009-02-02 09:58:51 +00:00
|
|
|
META-INF\manifest.xml - Describes the other files in the archive
|
2008-02-24 13:18:34 +00:00
|
|
|
|
|
|
|
Specifications obtained from:
|
|
|
|
|
2009-01-28 22:36:41 +00:00
|
|
|
http://docs.oasis-open.org/office/v1.1/OS/OpenDocument-v1.1.pdf
|
2008-02-24 13:18:34 +00:00
|
|
|
|
2009-07-01 11:26:56 +00:00
|
|
|
AUTHORS: Felipe Monteiro de Carvalho / Jose Luis Jurado Rincon
|
2008-02-24 13:18:34 +00:00
|
|
|
}
|
|
|
|
unit fpsopendocument;
|
|
|
|
|
|
|
|
{$ifdef fpc}
|
|
|
|
{$mode delphi}
|
|
|
|
{$endif}
|
|
|
|
|
2014-04-08 09:53:02 +00:00
|
|
|
{.$define FPSPREADDEBUG} //used to be XLSDEBUG
|
2008-02-24 13:18:34 +00:00
|
|
|
interface
|
|
|
|
|
|
|
|
uses
|
2009-02-02 09:58:51 +00:00
|
|
|
Classes, SysUtils,
|
2013-12-07 13:42:22 +00:00
|
|
|
{$IFDEF FPC_FULLVERSION >= 20701}
|
|
|
|
zipper,
|
|
|
|
{$ELSE}
|
|
|
|
fpszipper,
|
|
|
|
{$ENDIF}
|
2009-07-01 11:26:56 +00:00
|
|
|
fpspreadsheet,
|
2011-05-29 17:42:56 +00:00
|
|
|
xmlread, DOM, AVL_Tree,
|
|
|
|
math,
|
2014-03-23 11:36:36 +00:00
|
|
|
dateutils,
|
2011-05-29 17:42:56 +00:00
|
|
|
fpsutils;
|
2008-02-24 13:18:34 +00:00
|
|
|
|
|
|
|
type
|
2014-03-26 10:26:43 +00:00
|
|
|
TDateMode=(dm1899 {default for ODF; almost same as Excel 1900},
|
|
|
|
dm1900 {StarCalc legacy only},
|
|
|
|
dm1904 {e.g. Quattro Pro,Mac Excel compatibility}
|
|
|
|
);
|
2008-02-24 13:18:34 +00:00
|
|
|
|
2009-07-01 11:26:56 +00:00
|
|
|
{ TsSpreadOpenDocReader }
|
|
|
|
|
|
|
|
TsSpreadOpenDocReader = class(TsCustomSpreadReader)
|
|
|
|
private
|
2014-03-26 10:26:43 +00:00
|
|
|
FDateMode: TDateMode;
|
2009-07-01 11:26:56 +00:00
|
|
|
FWorksheet: TsWorksheet;
|
2014-03-23 11:36:36 +00:00
|
|
|
// Gets value for the specified attribute. Returns empty string if attribute
|
|
|
|
// not found.
|
2009-07-01 11:26:56 +00:00
|
|
|
function GetAttrValue(ANode : TDOMNode; AAttrName : string) : string;
|
2014-03-26 10:26:43 +00:00
|
|
|
// Figures out what the base year for times in this file (dates are unambiguous)
|
|
|
|
procedure ReadDateMode(SpreadSheetNode: TDOMNode);
|
2014-04-21 11:30:22 +00:00
|
|
|
protected
|
2009-07-01 11:26:56 +00:00
|
|
|
{ Record writing methods }
|
|
|
|
procedure ReadFormula(ARow : Word; ACol : Word; ACellNode: TDOMNode);
|
|
|
|
procedure ReadLabel(ARow : Word; ACol : Word; ACellNode: TDOMNode);
|
|
|
|
procedure ReadNumber(ARow : Word; ACol : Word; ACellNode: TDOMNode);
|
2012-12-11 16:46:25 +00:00
|
|
|
procedure ReadDate(ARow : Word; ACol : Word; ACellNode: TDOMNode);
|
2014-04-21 11:30:22 +00:00
|
|
|
public
|
|
|
|
{ General reading methods }
|
|
|
|
procedure ReadFromFile(AFileName: string; AData: TsWorkbook); override;
|
2009-07-01 11:26:56 +00:00
|
|
|
end;
|
|
|
|
|
2008-02-24 13:18:34 +00:00
|
|
|
{ TsSpreadOpenDocWriter }
|
|
|
|
|
|
|
|
TsSpreadOpenDocWriter = class(TsCustomSpreadWriter)
|
|
|
|
protected
|
2012-04-27 08:01:15 +00:00
|
|
|
FPointSeparatorSettings: TFormatSettings;
|
2009-01-28 22:36:41 +00:00
|
|
|
// Strings with the contents of files
|
2009-02-02 09:58:51 +00:00
|
|
|
FMeta, FSettings, FStyles, FContent, FMimetype: string;
|
2009-01-28 22:36:41 +00:00
|
|
|
FMetaInfManifest: string;
|
2009-02-02 09:58:51 +00:00
|
|
|
// Streams with the contents of files
|
|
|
|
FSMeta, FSSettings, FSStyles, FSContent, FSMimetype: TStringStream;
|
|
|
|
FSMetaInfManifest: TStringStream;
|
2009-01-28 22:36:41 +00:00
|
|
|
// Routines to write those files
|
2010-12-08 10:24:15 +00:00
|
|
|
procedure WriteMimetype;
|
|
|
|
procedure WriteMetaInfManifest;
|
|
|
|
procedure WriteMeta;
|
|
|
|
procedure WriteSettings;
|
|
|
|
procedure WriteStyles;
|
2009-01-28 22:36:41 +00:00
|
|
|
procedure WriteContent(AData: TsWorkbook);
|
2009-01-29 11:30:38 +00:00
|
|
|
procedure WriteWorksheet(CurSheet: TsWorksheet);
|
2011-05-27 13:45:30 +00:00
|
|
|
// Routines to write parts of those files
|
|
|
|
function WriteStylesXMLAsString: string;
|
2014-04-21 11:30:22 +00:00
|
|
|
{ Record writing methods }
|
2014-04-21 21:43:43 +00:00
|
|
|
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal;
|
|
|
|
ACell: PCell); override;
|
|
|
|
procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal;
|
|
|
|
const AFormula: TsFormula; 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;
|
|
|
|
procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal;
|
|
|
|
const AValue: TDateTime; ACell: PCell); override;
|
2008-02-24 13:18:34 +00:00
|
|
|
public
|
2012-04-27 08:01:15 +00:00
|
|
|
constructor Create; override;
|
2008-02-24 13:18:34 +00:00
|
|
|
{ General writing methods }
|
2009-02-02 09:58:51 +00:00
|
|
|
procedure WriteStringToFile(AString, AFileName: string);
|
2009-11-08 19:21:23 +00:00
|
|
|
procedure WriteToFile(const AFileName: string; AData: TsWorkbook;
|
|
|
|
const AOverwriteExisting: Boolean = False); override;
|
2008-02-24 13:18:34 +00:00
|
|
|
procedure WriteToStream(AStream: TStream; AData: TsWorkbook); override;
|
|
|
|
end;
|
|
|
|
|
|
|
|
implementation
|
|
|
|
|
|
|
|
const
|
|
|
|
{ OpenDocument general XML constants }
|
|
|
|
XML_HEADER = '<?xml version="1.0" encoding="utf-8" ?>';
|
|
|
|
|
|
|
|
{ OpenDocument Directory structure constants }
|
2009-02-02 09:58:51 +00:00
|
|
|
OPENDOC_PATH_CONTENT = 'content.xml';
|
|
|
|
OPENDOC_PATH_META = 'meta.xml';
|
|
|
|
OPENDOC_PATH_SETTINGS = 'settings.xml';
|
|
|
|
OPENDOC_PATH_STYLES = 'styles.xml';
|
|
|
|
OPENDOC_PATH_MIMETYPE = 'mimetype';
|
2009-04-18 01:31:09 +00:00
|
|
|
OPENDOC_PATH_METAINF = 'META-INF' + '/';
|
|
|
|
OPENDOC_PATH_METAINF_MANIFEST = 'META-INF' + '/' + 'manifest.xml';
|
2008-02-24 13:18:34 +00:00
|
|
|
|
|
|
|
{ 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';
|
|
|
|
|
2014-03-26 10:26:43 +00:00
|
|
|
{ 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
|
2014-03-23 11:36:36 +00:00
|
|
|
DATEMODE_1904_BASE=1462; //1/1/1904 in FPC TDateTime
|
|
|
|
|
|
|
|
|
2009-07-01 11:26:56 +00:00
|
|
|
{ TsSpreadOpenDocReader }
|
|
|
|
|
|
|
|
function TsSpreadOpenDocReader.GetAttrValue(ANode : TDOMNode; AAttrName : string) : string;
|
|
|
|
var
|
|
|
|
i : integer;
|
|
|
|
Found : Boolean;
|
|
|
|
begin
|
|
|
|
Found:=false;
|
|
|
|
i:=0;
|
|
|
|
Result:='';
|
|
|
|
while not Found and (i<ANode.Attributes.Length) do begin
|
|
|
|
if ANode.Attributes.Item[i].NodeName=AAttrName then begin
|
|
|
|
Found:=true;
|
|
|
|
Result:=ANode.Attributes.Item[i].NodeValue;
|
|
|
|
end;
|
|
|
|
inc(i);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2014-03-26 10:26:43 +00:00
|
|
|
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;
|
|
|
|
|
2009-07-01 11:26:56 +00:00
|
|
|
procedure TsSpreadOpenDocReader.ReadFromFile(AFileName: string; AData: TsWorkbook);
|
|
|
|
var
|
|
|
|
Col, Row : integer;
|
|
|
|
FilePath : string;
|
|
|
|
UnZip : TUnZipper;
|
|
|
|
FileList : TStringList;
|
|
|
|
Doc : TXMLDocument;
|
|
|
|
BodyNode, SpreadSheetNode, TableNode, RowNode, CellNode : TDOMNode;
|
|
|
|
ParamRowsRepeated, ParamColsRepeated, ParamValueType, ParamFormula : string;
|
|
|
|
RowsCount, ColsCount : integer;
|
|
|
|
begin
|
|
|
|
//unzip content.xml into AFileName path
|
2009-11-12 20:26:02 +00:00
|
|
|
FilePath:=GetTempDir(false);
|
2009-07-01 11:26:56 +00:00
|
|
|
UnZip:=TUnZipper.Create;
|
|
|
|
UnZip.OutputPath:=FilePath;
|
|
|
|
FileList:=TStringList.Create;
|
|
|
|
FileList.Add('content.xml');
|
|
|
|
try
|
|
|
|
Unzip.UnZipFiles(AFileName,FileList);
|
2009-11-12 20:26:02 +00:00
|
|
|
finally
|
|
|
|
FreeAndNil(FileList);
|
|
|
|
FreeAndNil(UnZip);
|
2009-07-01 11:26:56 +00:00
|
|
|
end; //try
|
2009-11-12 20:26:02 +00:00
|
|
|
|
|
|
|
Doc:=nil;
|
|
|
|
try
|
|
|
|
//process the xml file
|
|
|
|
ReadXMLFile(Doc,FilePath+'content.xml');
|
|
|
|
DeleteFile(FilePath+'content.xml');
|
|
|
|
|
|
|
|
BodyNode:= Doc.DocumentElement.FindNode('office:body');
|
|
|
|
if not Assigned(BodyNode) then Exit;
|
|
|
|
|
|
|
|
SpreadSheetNode:=BodyNode.FindNode('office:spreadsheet');
|
|
|
|
if not Assigned(SpreadSheetNode) then Exit;
|
|
|
|
|
2014-03-26 10:26:43 +00:00
|
|
|
ReadDateMode(SpreadSheetNode);
|
|
|
|
|
2009-11-12 20:26:02 +00:00
|
|
|
//process each table (sheet)
|
|
|
|
TableNode:=SpreadSheetNode.FindNode('table:table');
|
|
|
|
while Assigned(TableNode) do begin
|
|
|
|
FWorkSheet:=aData.AddWorksheet(GetAttrValue(TableNode,'table:name'));
|
|
|
|
Row:=0;
|
|
|
|
|
|
|
|
//process each row inside the sheet
|
|
|
|
RowNode:=TableNode.FindNode('table:table-row');
|
|
|
|
while Assigned(RowNode) do begin
|
|
|
|
|
|
|
|
Col:=0;
|
|
|
|
|
|
|
|
ParamRowsRepeated:=GetAttrValue(RowNode,'table:number-rows-repeated');
|
|
|
|
if ParamRowsRepeated='' then ParamRowsRepeated:='1';
|
|
|
|
|
|
|
|
//process each cell of the row
|
|
|
|
CellNode:=RowNode.FindNode('table:table-cell');
|
2010-05-25 09:11:02 +00:00
|
|
|
while Assigned(CellNode) do
|
|
|
|
begin
|
2009-11-12 20:26:02 +00:00
|
|
|
ParamColsRepeated:=GetAttrValue(CellNode,'table:number-columns-repeated');
|
|
|
|
if ParamColsRepeated='' then ParamColsRepeated:='1';
|
|
|
|
|
2014-03-23 11:36:36 +00:00
|
|
|
// select this cell value's type
|
2009-11-12 20:26:02 +00:00
|
|
|
ParamValueType:=GetAttrValue(CellNode,'office:value-type');
|
|
|
|
ParamFormula:=GetAttrValue(CellNode,'table:formula');
|
2014-03-23 11:36:36 +00:00
|
|
|
// Speed optimization: only read cells that may have contents;
|
|
|
|
// leave rest empty. Update if we support more cell types
|
|
|
|
if (ParamValueType='string') or
|
|
|
|
(ParamValueType='float') or
|
|
|
|
(ParamValueType='date') or
|
|
|
|
(ParamValueType='time') or
|
|
|
|
(ParamFormula<>'') then
|
|
|
|
begin
|
|
|
|
for RowsCount:=0 to StrToInt(ParamRowsRepeated)-1 do begin
|
|
|
|
for ColsCount:=0 to StrToInt(ParamColsRepeated)-1 do begin
|
|
|
|
if ParamValueType='string' then
|
|
|
|
ReadLabel(Row+RowsCount,Col+ColsCount,CellNode)
|
|
|
|
else if ParamFormula<>'' then
|
|
|
|
ReadFormula(Row+RowsCount,Col+ColsCount,CellNode)
|
|
|
|
else if ParamValueType='float' then
|
|
|
|
ReadNumber(Row+RowsCount,Col+ColsCount,CellNode)
|
|
|
|
else if (ParamValueType='date') or (ParamValueType='time') then
|
|
|
|
ReadDate(Row+RowsCount,Col+ColsCount,CellNode);
|
|
|
|
end; //for ColsCount
|
|
|
|
end; //for RowsCount
|
|
|
|
end;
|
2009-11-12 20:26:02 +00:00
|
|
|
Inc(Col,ColsCount+1);
|
|
|
|
CellNode:=CellNode.NextSibling;
|
|
|
|
end; //while Assigned(CellNode)
|
|
|
|
|
|
|
|
Inc(Row,RowsCount+1);
|
|
|
|
RowNode:=RowNode.NextSibling;
|
|
|
|
end; // while Assigned(RowNode)
|
|
|
|
|
|
|
|
TableNode:=TableNode.NextSibling;
|
|
|
|
end; //while Assigned(TableNode)
|
|
|
|
finally
|
|
|
|
Doc.Free;
|
|
|
|
end;
|
2009-07-01 11:26:56 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TsSpreadOpenDocReader.ReadFormula(ARow: Word; ACol : Word; ACellNode : TDOMNode);
|
|
|
|
begin
|
2010-05-25 09:11:02 +00:00
|
|
|
// For now just read the number
|
|
|
|
ReadNumber(ARow, ACol, ACellNode);
|
2009-07-01 11:26:56 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TsSpreadOpenDocReader.ReadLabel(ARow: Word; ACol : Word; ACellNode : TDOMNode);
|
|
|
|
begin
|
2009-11-16 12:46:31 +00:00
|
|
|
FWorkSheet.WriteUTF8Text(ARow,ACol,UTF8Encode(ACellNode.TextContent));
|
2009-07-01 11:26:56 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TsSpreadOpenDocReader.ReadNumber(ARow: Word; ACol : Word; ACellNode : TDOMNode);
|
2009-09-02 01:22:46 +00:00
|
|
|
var
|
|
|
|
FSettings: TFormatSettings;
|
2010-05-25 09:11:02 +00:00
|
|
|
Value, Str: String;
|
|
|
|
lNumber: Double;
|
2009-07-01 11:26:56 +00:00
|
|
|
begin
|
2009-09-02 01:22:46 +00:00
|
|
|
FSettings.DecimalSeparator:='.';
|
2009-11-12 20:26:02 +00:00
|
|
|
Value:=GetAttrValue(ACellNode,'office:value');
|
2010-05-25 09:11:02 +00:00
|
|
|
if UpperCase(Value)='1.#INF' then
|
|
|
|
begin
|
2009-11-12 20:26:02 +00:00
|
|
|
FWorkSheet.WriteNumber(Arow,ACol,1.0/0.0);
|
2010-05-25 09:11:02 +00:00
|
|
|
end
|
|
|
|
else
|
|
|
|
begin
|
|
|
|
// Don't merge, or else we can't debug
|
|
|
|
Str := GetAttrValue(ACellNode,'office:value');
|
|
|
|
lNumber := StrToFloat(Str,FSettings);
|
2014-03-23 13:06:19 +00:00
|
|
|
FWorkSheet.WriteNumber(ARow,ACol,lNumber);
|
2009-11-12 20:26:02 +00:00
|
|
|
end;
|
2009-07-01 11:26:56 +00:00
|
|
|
end;
|
|
|
|
|
2012-12-11 16:46:25 +00:00
|
|
|
procedure TsSpreadOpenDocReader.ReadDate(ARow: Word; ACol : Word; ACellNode : TDOMNode);
|
|
|
|
var
|
2014-03-24 07:34:00 +00:00
|
|
|
dt: TDateTime;
|
2014-01-24 10:32:23 +00:00
|
|
|
Value: String;
|
|
|
|
Fmt : TFormatSettings;
|
2014-03-23 11:36:36 +00:00
|
|
|
FoundPos : integer;
|
|
|
|
Hours, Minutes, Seconds: integer;
|
|
|
|
HoursPos, MinutesPos, SecondsPos: integer;
|
2012-12-11 16:46:25 +00:00
|
|
|
begin
|
2014-03-23 11:36:36 +00:00
|
|
|
// Format expects ISO 8601 type date string or
|
|
|
|
// time string
|
2014-01-24 10:32:23 +00:00
|
|
|
fmt.ShortDateFormat:='yyyy-mm-dd';
|
|
|
|
fmt.DateSeparator:='-';
|
|
|
|
fmt.LongTimeFormat:='hh:nn:ss';
|
|
|
|
fmt.TimeSeparator:=':';
|
2012-12-11 16:46:25 +00:00
|
|
|
Value:=GetAttrValue(ACellNode,'office:date-value');
|
2014-03-23 11:36:36 +00:00
|
|
|
if Value<>'' then
|
2014-01-24 10:32:23 +00:00
|
|
|
begin
|
2014-04-08 09:53:02 +00:00
|
|
|
{$IFDEF FPSPREADDEBUG}
|
2014-03-26 10:26:43 +00:00
|
|
|
writeln('Row (1based): ',ARow+1,'office:date-value: '+Value);
|
|
|
|
{$ENDIF}
|
2014-03-23 11:36:36 +00:00
|
|
|
// Date or date/time string
|
|
|
|
Value:=StringReplace(Value,'T',' ',[rfIgnoreCase,rfReplaceAll]);
|
|
|
|
// Strip milliseconds?
|
|
|
|
FoundPos:=Pos('.',Value);
|
|
|
|
if (FoundPos>1) then
|
|
|
|
begin
|
|
|
|
Value:=Copy(Value,1,FoundPos-1);
|
|
|
|
end;
|
|
|
|
dt:=StrToDateTime(Value,Fmt);
|
2014-03-24 07:34:00 +00:00
|
|
|
FWorkSheet.WriteDateTime(Arow,ACol,dt);
|
2014-03-23 11:36:36 +00:00
|
|
|
end
|
|
|
|
else
|
|
|
|
begin
|
|
|
|
// Try time only, e.g. PT23H59M59S
|
|
|
|
// 12345678901
|
|
|
|
Value:=GetAttrValue(ACellNode,'office:time-value');
|
2014-04-08 09:53:02 +00:00
|
|
|
{$IFDEF FPSPREADDEBUG}
|
2014-03-26 10:26:43 +00:00
|
|
|
writeln('Row (1based): ',ARow+1,'office:time-value: '+Value);
|
|
|
|
{$ENDIF}
|
2014-03-23 11:36:36 +00:00
|
|
|
if (Value<>'') and (Pos('PT',Value)=1) then
|
|
|
|
begin
|
|
|
|
// Get hours
|
|
|
|
HoursPos:=Pos('H',Value);
|
|
|
|
if (HoursPos>0) then
|
2014-03-23 13:06:19 +00:00
|
|
|
Hours:=StrToInt(Copy(Value,3,HoursPos-3))
|
|
|
|
else
|
|
|
|
Hours:=0;
|
2014-03-23 11:36:36 +00:00
|
|
|
|
|
|
|
// Get minutes
|
|
|
|
MinutesPos:=Pos('M',Value);
|
|
|
|
if (MinutesPos>0) and (MinutesPos>HoursPos) then
|
2014-03-23 13:06:19 +00:00
|
|
|
Minutes:=StrToInt(Copy(Value,HoursPos+1,MinutesPos-HoursPos-1))
|
|
|
|
else
|
|
|
|
Minutes:=0;
|
2014-03-23 11:36:36 +00:00
|
|
|
|
|
|
|
// Get seconds
|
|
|
|
SecondsPos:=Pos('S',Value);
|
|
|
|
if (SecondsPos>0) and (SecondsPos>MinutesPos) then
|
2014-03-23 13:06:19 +00:00
|
|
|
Seconds:=StrToInt(Copy(Value,MinutesPos+1,SecondsPos-MinutesPos-1))
|
|
|
|
else
|
|
|
|
Seconds:=0;
|
|
|
|
|
2014-03-26 10:26:43 +00:00
|
|
|
// Times smaller than a day can be taken as is
|
|
|
|
// Times larger than a day depend on the file's date mode.
|
2014-03-23 13:06:19 +00:00
|
|
|
// Convert to date/time via Unix timestamp so avoiding limits for number of
|
|
|
|
// hours etc in EncodeDateTime. Perhaps there's a faster way of doing this?
|
2014-03-26 10:26:43 +00:00
|
|
|
if (Hours>-24) and (Hours<24) then
|
|
|
|
begin
|
|
|
|
dt:=UnixToDateTime(
|
|
|
|
Hours*(MinsPerHour*SecsPerMin)+
|
|
|
|
Minutes*(SecsPerMin)+
|
|
|
|
Seconds
|
|
|
|
)-UnixEpoch;
|
|
|
|
end
|
|
|
|
else
|
|
|
|
begin
|
|
|
|
// A day or longer
|
|
|
|
case FDateMode of
|
|
|
|
dm1899:
|
|
|
|
dt:=DATEMODE_1899_BASE+UnixToDateTime(
|
|
|
|
Hours*(MinsPerHour*SecsPerMin)+
|
|
|
|
Minutes*(SecsPerMin)+
|
|
|
|
Seconds
|
|
|
|
)-UnixEpoch;
|
|
|
|
dm1900:
|
|
|
|
dt:=DATEMODE_1900_BASE+UnixToDateTime(
|
|
|
|
Hours*(MinsPerHour*SecsPerMin)+
|
|
|
|
Minutes*(SecsPerMin)+
|
|
|
|
Seconds
|
|
|
|
)-UnixEpoch;
|
|
|
|
dm1904:
|
|
|
|
dt:=DATEMODE_1904_BASE+UnixToDateTime(
|
|
|
|
Hours*(MinsPerHour*SecsPerMin)+
|
|
|
|
Minutes*(SecsPerMin)+
|
|
|
|
Seconds
|
|
|
|
)-UnixEpoch;
|
|
|
|
end;
|
|
|
|
|
|
|
|
end;
|
2014-03-24 07:34:00 +00:00
|
|
|
FWorkSheet.WriteDateTime(Arow,ACol,dt);
|
2014-03-23 11:36:36 +00:00
|
|
|
end;
|
2014-01-24 10:32:23 +00:00
|
|
|
end;
|
2012-12-11 16:46:25 +00:00
|
|
|
end;
|
|
|
|
|
2008-02-24 13:18:34 +00:00
|
|
|
{ TsSpreadOpenDocWriter }
|
|
|
|
|
2010-12-08 10:24:15 +00:00
|
|
|
procedure TsSpreadOpenDocWriter.WriteMimetype;
|
2008-02-24 13:18:34 +00:00
|
|
|
begin
|
2009-01-28 22:36:41 +00:00
|
|
|
FMimetype := 'application/vnd.oasis.opendocument.spreadsheet';
|
2010-12-08 10:24:15 +00:00
|
|
|
end;
|
2008-02-24 13:18:34 +00:00
|
|
|
|
2010-12-08 10:24:15 +00:00
|
|
|
procedure TsSpreadOpenDocWriter.WriteMetaInfManifest;
|
|
|
|
begin
|
2008-02-24 13:18:34 +00:00
|
|
|
FMetaInfManifest :=
|
|
|
|
XML_HEADER + LineEnding +
|
|
|
|
'<manifest:manifest xmlns:manifest="' + SCHEMAS_XMLNS_MANIFEST + '">' + LineEnding +
|
|
|
|
' <manifest:file-entry manifest:media-type="application/vnd.oasis.opendocument.spreadsheet" manifest:full-path="/" />' + LineEnding +
|
|
|
|
' <manifest:file-entry manifest:media-type="text/xml" manifest:full-path="content.xml" />' + LineEnding +
|
|
|
|
' <manifest:file-entry manifest:media-type="text/xml" manifest:full-path="styles.xml" />' + LineEnding +
|
|
|
|
' <manifest:file-entry manifest:media-type="text/xml" manifest:full-path="meta.xml" />' + LineEnding +
|
|
|
|
' <manifest:file-entry manifest:media-type="text/xml" manifest:full-path="settings.xml" />' + LineEnding +
|
|
|
|
'</manifest:manifest>';
|
2010-12-08 10:24:15 +00:00
|
|
|
end;
|
2009-01-28 22:36:41 +00:00
|
|
|
|
2010-12-08 10:24:15 +00:00
|
|
|
procedure TsSpreadOpenDocWriter.WriteMeta;
|
|
|
|
begin
|
2008-02-24 13:18:34 +00:00
|
|
|
FMeta :=
|
|
|
|
XML_HEADER + LineEnding +
|
|
|
|
'<office:document-meta xmlns:office="' + SCHEMAS_XMLNS_OFFICE +
|
|
|
|
'" xmlns:dcterms="' + SCHEMAS_XMLNS_DCTERMS +
|
|
|
|
'" xmlns:meta="' + SCHEMAS_XMLNS_META +
|
|
|
|
'" xmlns="' + SCHEMAS_XMLNS +
|
|
|
|
'" xmlns:ex="' + SCHEMAS_XMLNS + '">' + LineEnding +
|
|
|
|
' <office:meta>' + LineEnding +
|
|
|
|
' <meta:generator>FPSpreadsheet Library</meta:generator>' + LineEnding +
|
|
|
|
' <meta:document-statistic />' + LineEnding +
|
|
|
|
' </office:meta>' + LineEnding +
|
|
|
|
'</office:document-meta>';
|
2010-12-08 10:24:15 +00:00
|
|
|
end;
|
2008-02-24 13:18:34 +00:00
|
|
|
|
2010-12-08 10:24:15 +00:00
|
|
|
procedure TsSpreadOpenDocWriter.WriteSettings;
|
|
|
|
begin
|
2008-02-24 13:18:34 +00:00
|
|
|
FSettings :=
|
|
|
|
XML_HEADER + LineEnding +
|
|
|
|
'<office:document-settings xmlns:office="' + SCHEMAS_XMLNS_OFFICE +
|
|
|
|
'" xmlns:config="' + SCHEMAS_XMLNS_CONFIG +
|
|
|
|
'" xmlns:ooo="' + SCHEMAS_XMLNS_OOO + '">' + LineEnding +
|
|
|
|
'<office:settings>' + LineEnding +
|
|
|
|
' <config:config-item-set config:name="ooo:view-settings">' + LineEnding +
|
|
|
|
' <config:config-item-map-indexed config:name="Views">' + LineEnding +
|
|
|
|
' <config:config-item-map-entry>' + LineEnding +
|
|
|
|
' <config:config-item config:name="ActiveTable" config:type="string">Tabelle1</config:config-item>' + LineEnding +
|
|
|
|
' <config:config-item config:name="ZoomValue" config:type="int">100</config:config-item>' + LineEnding +
|
|
|
|
' <config:config-item config:name="PageViewZoomValue" config:type="int">100</config:config-item>' + LineEnding +
|
|
|
|
' <config:config-item config:name="ShowPageBreakPreview" config:type="boolean">false</config:config-item>' + LineEnding +
|
|
|
|
' <config:config-item config:name="HasColumnRowHeaders" config:type="boolean">true</config:config-item>' + LineEnding +
|
|
|
|
' <config:config-item-map-named config:name="Tables">' + LineEnding +
|
|
|
|
' <config:config-item-map-entry config:name="Tabelle1">' + LineEnding +
|
|
|
|
' <config:config-item config:name="CursorPositionX" config:type="int">3</config:config-item>' + LineEnding +
|
|
|
|
' <config:config-item config:name="CursorPositionY" config:type="int">2</config:config-item>' + LineEnding +
|
|
|
|
' </config:config-item-map-entry>' + LineEnding +
|
|
|
|
' </config:config-item-map-named>' + LineEnding +
|
|
|
|
' </config:config-item-map-entry>' + LineEnding +
|
|
|
|
' </config:config-item-map-indexed>' + LineEnding +
|
|
|
|
' </config:config-item-set>' + LineEnding +
|
|
|
|
' </office:settings>' + LineEnding +
|
|
|
|
'</office:document-settings>';
|
2010-12-08 10:24:15 +00:00
|
|
|
end;
|
2009-01-28 22:36:41 +00:00
|
|
|
|
2010-12-08 10:24:15 +00:00
|
|
|
procedure TsSpreadOpenDocWriter.WriteStyles;
|
|
|
|
begin
|
2008-02-24 13:18:34 +00:00
|
|
|
FStyles :=
|
|
|
|
XML_HEADER + LineEnding +
|
|
|
|
'<office:document-styles xmlns:office="' + SCHEMAS_XMLNS_OFFICE +
|
|
|
|
'" xmlns:fo="' + SCHEMAS_XMLNS_FO +
|
|
|
|
'" xmlns:style="' + SCHEMAS_XMLNS_STYLE +
|
|
|
|
'" xmlns:svg="' + SCHEMAS_XMLNS_SVG +
|
|
|
|
'" xmlns:table="' + SCHEMAS_XMLNS_TABLE +
|
|
|
|
'" xmlns:text="' + SCHEMAS_XMLNS_TEXT +
|
|
|
|
'" xmlns:v="' + SCHEMAS_XMLNS_V + '">' + LineEnding +
|
|
|
|
'<office:font-face-decls>' + LineEnding +
|
2010-12-08 10:24:15 +00:00
|
|
|
' <style:font-face style:name="Arial" svg:font-family="Arial" />' + LineEnding +
|
2008-02-24 13:18:34 +00:00
|
|
|
'</office:font-face-decls>' + LineEnding +
|
|
|
|
'<office:styles>' + LineEnding +
|
2010-12-08 10:24:15 +00:00
|
|
|
' <style:style style:name="Default" style:family="table-cell">' + LineEnding +
|
|
|
|
' <style:text-properties fo:font-size="10" style:font-name="Arial" />' + LineEnding +
|
|
|
|
' </style:style>' + LineEnding +
|
2008-02-24 13:18:34 +00:00
|
|
|
'</office:styles>' + LineEnding +
|
|
|
|
'<office:automatic-styles>' + LineEnding +
|
2010-12-08 10:24:15 +00:00
|
|
|
' <style:page-layout style:name="pm1">' + LineEnding +
|
|
|
|
' <style:page-layout-properties fo:margin-top="1.25cm" fo:margin-bottom="1.25cm" fo:margin-left="1.905cm" fo:margin-right="1.905cm" />' + LineEnding +
|
|
|
|
' <style:header-style>' + LineEnding +
|
|
|
|
' <style:header-footer-properties fo:min-height="0.751cm" fo:margin-left="0cm" fo:margin-right="0cm" fo:margin-bottom="0.25cm" fo:margin-top="0cm" />' + LineEnding +
|
|
|
|
' </style:header-style>' + LineEnding +
|
|
|
|
' <style:footer-style>' + LineEnding +
|
|
|
|
' <style:header-footer-properties fo:min-height="0.751cm" fo:margin-left="0cm" fo:margin-right="0cm" fo:margin-top="0.25cm" fo:margin-bottom="0cm" />' + LineEnding +
|
|
|
|
' </style:footer-style>' + LineEnding +
|
|
|
|
' </style:page-layout>' + LineEnding +
|
2008-02-24 13:18:34 +00:00
|
|
|
'</office:automatic-styles>' + LineEnding +
|
|
|
|
'<office:master-styles>' + LineEnding +
|
2010-12-08 10:24:15 +00:00
|
|
|
' <style:master-page style:name="Default" style:page-layout-name="pm1">' + LineEnding +
|
|
|
|
' <style:header />' + LineEnding +
|
|
|
|
' <style:header-left style:display="false" />' + LineEnding +
|
|
|
|
' <style:footer />' + LineEnding +
|
|
|
|
' <style:footer-left style:display="false" />' + LineEnding +
|
|
|
|
' </style:master-page>' + LineEnding +
|
2008-02-24 13:18:34 +00:00
|
|
|
'</office:master-styles>' + LineEnding +
|
|
|
|
'</office:document-styles>';
|
2009-01-28 22:36:41 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TsSpreadOpenDocWriter.WriteContent(AData: TsWorkbook);
|
|
|
|
var
|
2009-01-29 11:30:38 +00:00
|
|
|
i: Integer;
|
2011-05-27 13:45:30 +00:00
|
|
|
lStylesCode: string;
|
2009-01-28 22:36:41 +00:00
|
|
|
begin
|
2011-05-27 13:45:30 +00:00
|
|
|
ListAllFormattingStyles(AData);
|
|
|
|
|
|
|
|
lStylesCode := WriteStylesXMLAsString();
|
|
|
|
|
2008-02-24 13:18:34 +00:00
|
|
|
FContent :=
|
|
|
|
XML_HEADER + LineEnding +
|
|
|
|
'<office:document-content xmlns:office="' + SCHEMAS_XMLNS_OFFICE +
|
|
|
|
'" xmlns:fo="' + SCHEMAS_XMLNS_FO +
|
|
|
|
'" xmlns:style="' + SCHEMAS_XMLNS_STYLE +
|
|
|
|
'" xmlns:text="' + SCHEMAS_XMLNS_TEXT +
|
|
|
|
'" xmlns:table="' + SCHEMAS_XMLNS_TABLE +
|
|
|
|
'" xmlns:svg="' + SCHEMAS_XMLNS_SVG +
|
|
|
|
'" xmlns:number="' + SCHEMAS_XMLNS_NUMBER +
|
|
|
|
'" xmlns:meta="' + SCHEMAS_XMLNS_META +
|
|
|
|
'" xmlns:chart="' + SCHEMAS_XMLNS_CHART +
|
|
|
|
'" xmlns:dr3d="' + SCHEMAS_XMLNS_DR3D +
|
|
|
|
'" xmlns:math="' + SCHEMAS_XMLNS_MATH +
|
|
|
|
'" xmlns:form="' + SCHEMAS_XMLNS_FORM +
|
|
|
|
'" xmlns:script="' + SCHEMAS_XMLNS_SCRIPT +
|
|
|
|
'" xmlns:ooo="' + SCHEMAS_XMLNS_OOO +
|
|
|
|
'" xmlns:ooow="' + SCHEMAS_XMLNS_OOOW +
|
|
|
|
'" xmlns:oooc="' + SCHEMAS_XMLNS_OOOC +
|
|
|
|
'" xmlns:dom="' + SCHEMAS_XMLNS_DOM +
|
|
|
|
'" xmlns:xforms="' + SCHEMAS_XMLNS_XFORMS +
|
|
|
|
'" xmlns:xsd="' + SCHEMAS_XMLNS_XSD +
|
|
|
|
'" xmlns:xsi="' + SCHEMAS_XMLNS_XSI + '">' + LineEnding +
|
2009-01-28 22:36:41 +00:00
|
|
|
' <office:scripts />' + LineEnding +
|
|
|
|
|
|
|
|
// Fonts
|
|
|
|
' <office:font-face-decls>' + LineEnding +
|
|
|
|
' <style:font-face style:name="Arial" svg:font-family="Arial" xmlns:v="urn:schemas-microsoft-com:vml" />' + LineEnding +
|
|
|
|
' </office:font-face-decls>' + LineEnding +
|
|
|
|
|
|
|
|
// Automatic styles
|
2009-01-29 11:30:38 +00:00
|
|
|
' <office:automatic-styles>' + LineEnding +
|
|
|
|
' <style:style style:name="co1" style:family="table-column">' + LineEnding +
|
|
|
|
' <style:table-column-properties fo:break-before="auto" style:column-width="2.267cm"/>' + LineEnding +
|
|
|
|
' </style:style>' + LineEnding +
|
|
|
|
' <style:style style:name="ro1" style:family="table-row">' + LineEnding +
|
|
|
|
' <style:table-row-properties style:row-height="0.416cm" fo:break-before="auto" style:use-optimal-row-height="true"/>' + LineEnding +
|
|
|
|
' </style:style>' + LineEnding +
|
|
|
|
' <style:style style:name="ta1" style:family="table" style:master-page-name="Default">' + LineEnding +
|
|
|
|
' <style:table-properties table:display="true" style:writing-mode="lr-tb"/>' + LineEnding +
|
|
|
|
' </style:style>' + LineEnding +
|
2011-05-27 13:45:30 +00:00
|
|
|
// Automatically Generated Styles
|
|
|
|
lStylesCode +
|
2009-01-29 11:30:38 +00:00
|
|
|
' </office:automatic-styles>' + LineEnding +
|
|
|
|
|
|
|
|
// Body
|
|
|
|
' <office:body>' + LineEnding +
|
|
|
|
' <office:spreadsheet>' + LineEnding;
|
|
|
|
|
2009-02-02 09:58:51 +00:00
|
|
|
// Write all worksheets
|
2009-01-29 11:30:38 +00:00
|
|
|
for i := 0 to AData.GetWorksheetCount - 1 do
|
|
|
|
begin
|
|
|
|
WriteWorksheet(Adata.GetWorksheetByIndex(i));
|
|
|
|
end;
|
2009-01-28 22:36:41 +00:00
|
|
|
|
|
|
|
FContent := FContent +
|
|
|
|
' </office:spreadsheet>' + LineEnding +
|
|
|
|
' </office:body>' + LineEnding +
|
2008-02-24 13:18:34 +00:00
|
|
|
'</office:document-content>';
|
|
|
|
end;
|
|
|
|
|
2009-01-29 11:30:38 +00:00
|
|
|
procedure TsSpreadOpenDocWriter.WriteWorksheet(CurSheet: TsWorksheet);
|
|
|
|
var
|
|
|
|
j, k: Integer;
|
|
|
|
CurCell: PCell;
|
2009-01-29 11:54:07 +00:00
|
|
|
CurRow: array of PCell;
|
|
|
|
LastColNum: Cardinal;
|
2009-09-03 12:04:04 +00:00
|
|
|
LCell: TCell;
|
2009-09-02 22:03:01 +00:00
|
|
|
AVLNode: TAVLTreeNode;
|
2009-01-29 11:30:38 +00:00
|
|
|
begin
|
2009-01-29 11:54:07 +00:00
|
|
|
LastColNum := CurSheet.GetLastColNumber;
|
|
|
|
|
2009-01-29 11:30:38 +00:00
|
|
|
// Header
|
|
|
|
FContent := FContent +
|
|
|
|
' <table:table table:name="' + CurSheet.Name + '" table:style-name="ta1">' + LineEnding +
|
|
|
|
' <table:table-column table:style-name="co1" table:number-columns-repeated="' +
|
2009-01-29 13:24:37 +00:00
|
|
|
IntToStr(LastColNum + 1) + '" table:default-cell-style-name="Default"/>' + LineEnding;
|
2009-01-29 11:30:38 +00:00
|
|
|
|
2009-01-29 11:54:07 +00:00
|
|
|
// The cells need to be written in order, row by row, cell by cell
|
2009-01-29 13:24:37 +00:00
|
|
|
for j := 0 to CurSheet.GetLastRowNumber do
|
2009-01-29 11:30:38 +00:00
|
|
|
begin
|
|
|
|
FContent := FContent +
|
|
|
|
' <table:table-row table:style-name="ro1">' + LineEnding;
|
|
|
|
|
2009-09-02 22:03:01 +00:00
|
|
|
// Write cells from this row.
|
2009-01-29 13:24:37 +00:00
|
|
|
for k := 0 to LastColNum do
|
2009-01-29 11:54:07 +00:00
|
|
|
begin
|
2009-09-03 12:04:04 +00:00
|
|
|
LCell.Row := j;
|
|
|
|
LCell.Col := k;
|
|
|
|
AVLNode := CurSheet.Cells.Find(@LCell);
|
2009-09-02 22:03:01 +00:00
|
|
|
if Assigned(AVLNode) then
|
|
|
|
WriteCellCallback(PCell(AVLNode.Data), nil)
|
|
|
|
else
|
|
|
|
FContent := FContent + '<table:table-cell/>' + LineEnding;
|
2009-01-29 11:54:07 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
FContent := FContent +
|
|
|
|
' </table:table-row>' + LineEnding;
|
2009-01-29 11:30:38 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
// Footer
|
2009-01-29 11:54:07 +00:00
|
|
|
FContent := FContent +
|
|
|
|
' </table:table>' + LineEnding;
|
2009-01-29 11:30:38 +00:00
|
|
|
end;
|
|
|
|
|
2011-05-27 13:45:30 +00:00
|
|
|
function TsSpreadOpenDocWriter.WriteStylesXMLAsString: string;
|
|
|
|
var
|
|
|
|
i: Integer;
|
|
|
|
begin
|
|
|
|
Result := '';
|
|
|
|
|
|
|
|
for i := 0 to Length(FFormattingStyles) - 1 do
|
|
|
|
begin
|
|
|
|
// Start and Name
|
|
|
|
Result := Result +
|
|
|
|
' <style:style style:name="ce' + IntToStr(i) + '" style:family="table-cell" style:parent-style-name="Default">' + LineEnding;
|
|
|
|
|
|
|
|
// Fields
|
2012-06-13 07:21:00 +00:00
|
|
|
|
|
|
|
// style:text-properties
|
2011-05-27 13:45:30 +00:00
|
|
|
if uffBold in FFormattingStyles[i].UsedFormattingFields then
|
|
|
|
Result := Result +
|
|
|
|
' <style:text-properties fo:font-weight="bold" style:font-weight-asian="bold" style:font-weight-complex="bold"/>' + LineEnding;
|
|
|
|
|
2012-06-13 07:21:00 +00:00
|
|
|
// style:table-cell-properties
|
2011-05-27 13:45:30 +00:00
|
|
|
if (uffBorder in FFormattingStyles[i].UsedFormattingFields) or
|
2012-06-13 07:21:00 +00:00
|
|
|
(uffBackgroundColor in FFormattingStyles[i].UsedFormattingFields) or
|
|
|
|
(uffWordWrap in FFormattingStyles[i].UsedFormattingFields) then
|
2011-05-27 13:45:30 +00:00
|
|
|
begin
|
|
|
|
Result := Result + ' <style:table-cell-properties ';
|
|
|
|
|
|
|
|
if (uffBorder in FFormattingStyles[i].UsedFormattingFields) then
|
|
|
|
begin
|
|
|
|
if cbSouth in FFormattingStyles[i].Border then Result := Result + 'fo:border-bottom="0.002cm solid #000000" '
|
|
|
|
else Result := Result + 'fo:border-bottom="none" ';
|
|
|
|
|
|
|
|
if cbWest in FFormattingStyles[i].Border then Result := Result + 'fo:border-left="0.002cm solid #000000" '
|
|
|
|
else Result := Result + 'fo:border-left="none" ';
|
|
|
|
|
|
|
|
if cbEast in FFormattingStyles[i].Border then Result := Result + 'fo:border-right="0.002cm solid #000000" '
|
|
|
|
else Result := Result + 'fo:border-right="none" ';
|
|
|
|
|
|
|
|
if cbNorth in FFormattingStyles[i].Border then Result := Result + 'fo:border-top="0.002cm solid #000000" '
|
|
|
|
else Result := Result + 'fo:border-top="none" ';
|
|
|
|
end;
|
|
|
|
|
|
|
|
if (uffBackgroundColor in FFormattingStyles[i].UsedFormattingFields) then
|
|
|
|
begin
|
|
|
|
Result := Result + 'fo:background-color="#'
|
2013-06-12 11:02:02 +00:00
|
|
|
+ FPSColorToHexString(FFormattingStyles[i].BackgroundColor, FFormattingStyles[i].RGBBackgroundColor) +'" ';
|
2011-05-27 13:45:30 +00:00
|
|
|
end;
|
|
|
|
|
2012-06-13 07:21:00 +00:00
|
|
|
if (uffWordWrap in FFormattingStyles[i].UsedFormattingFields) then
|
|
|
|
begin
|
|
|
|
Result := Result + 'fo:wrap-option="wrap" ';
|
|
|
|
end;
|
|
|
|
|
2011-05-27 13:45:30 +00:00
|
|
|
Result := Result + '/>' + LineEnding;
|
|
|
|
end;
|
|
|
|
|
|
|
|
// End
|
|
|
|
Result := Result +
|
|
|
|
' </style:style>' + LineEnding;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2012-04-27 08:01:15 +00:00
|
|
|
constructor TsSpreadOpenDocWriter.Create;
|
|
|
|
begin
|
|
|
|
inherited Create;
|
|
|
|
|
|
|
|
FPointSeparatorSettings := SysUtils.DefaultFormatSettings;
|
|
|
|
FPointSeparatorSettings.DecimalSeparator:='.';
|
|
|
|
end;
|
|
|
|
|
2009-02-02 09:58:51 +00:00
|
|
|
{
|
|
|
|
Writes a string to a file. Helper convenience method.
|
|
|
|
}
|
|
|
|
procedure TsSpreadOpenDocWriter.WriteStringToFile(AString, AFileName: string);
|
2009-01-28 22:36:41 +00:00
|
|
|
var
|
|
|
|
TheStream : TFileStream;
|
|
|
|
S : String;
|
|
|
|
begin
|
|
|
|
TheStream := TFileStream.Create(AFileName, fmCreate);
|
|
|
|
S:=AString;
|
|
|
|
TheStream.WriteBuffer(Pointer(S)^,Length(S));
|
|
|
|
TheStream.Free;
|
|
|
|
end;
|
|
|
|
|
2009-02-02 09:58:51 +00:00
|
|
|
{
|
|
|
|
Writes an OOXML document to the disc.
|
|
|
|
}
|
2009-11-08 19:21:23 +00:00
|
|
|
procedure TsSpreadOpenDocWriter.WriteToFile(const AFileName: string;
|
|
|
|
AData: TsWorkbook; const AOverwriteExisting: Boolean);
|
2008-02-24 13:18:34 +00:00
|
|
|
var
|
2009-02-02 09:58:51 +00:00
|
|
|
FZip: TZipper;
|
2008-02-24 13:18:34 +00:00
|
|
|
begin
|
2009-02-02 09:58:51 +00:00
|
|
|
{ Fill the strings with the contents of the files }
|
2009-01-28 22:36:41 +00:00
|
|
|
|
2010-12-08 10:24:15 +00:00
|
|
|
WriteMimetype();
|
|
|
|
WriteMetaInfManifest();
|
|
|
|
WriteMeta();
|
|
|
|
WriteSettings();
|
|
|
|
WriteStyles();
|
2009-01-28 22:36:41 +00:00
|
|
|
WriteContent(AData);
|
2008-02-24 13:18:34 +00:00
|
|
|
|
2009-02-02 09:58:51 +00:00
|
|
|
{ Write the data to streams }
|
|
|
|
|
|
|
|
FSMeta := TStringStream.Create(FMeta);
|
|
|
|
FSSettings := TStringStream.Create(FSettings);
|
|
|
|
FSStyles := TStringStream.Create(FStyles);
|
|
|
|
FSContent := TStringStream.Create(FContent);
|
|
|
|
FSMimetype := TStringStream.Create(FMimetype);
|
|
|
|
FSMetaInfManifest := TStringStream.Create(FMetaInfManifest);
|
|
|
|
|
|
|
|
{ Now compress the files }
|
|
|
|
|
|
|
|
FZip := TZipper.Create;
|
|
|
|
try
|
|
|
|
FZip.FileName := AFileName;
|
|
|
|
|
|
|
|
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);
|
|
|
|
|
|
|
|
FZip.ZipAllFiles;
|
|
|
|
finally
|
|
|
|
FZip.Free;
|
|
|
|
FSMeta.Free;
|
|
|
|
FSSettings.Free;
|
|
|
|
FSStyles.Free;
|
|
|
|
FSContent.Free;
|
|
|
|
FSMimetype.Free;
|
|
|
|
FSMetaInfManifest.Free;
|
|
|
|
end;
|
2008-02-24 13:18:34 +00:00
|
|
|
end;
|
|
|
|
|
2009-02-02 09:58:51 +00:00
|
|
|
|
2009-01-28 22:36:41 +00:00
|
|
|
procedure TsSpreadOpenDocWriter.WriteToStream(AStream: TStream; AData: TsWorkbook);
|
|
|
|
begin
|
2009-02-02 09:58:51 +00:00
|
|
|
// Not supported at the moment
|
|
|
|
raise Exception.Create('TsSpreadOpenDocWriter.WriteToStream not supported');
|
2009-01-28 22:36:41 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TsSpreadOpenDocWriter.WriteFormula(AStream: TStream; const ARow,
|
2013-12-07 13:42:22 +00:00
|
|
|
ACol: Cardinal; const AFormula: TsFormula; ACell: PCell);
|
2008-02-24 13:18:34 +00:00
|
|
|
begin
|
2009-02-02 09:58:51 +00:00
|
|
|
{ // The row should already be the correct one
|
|
|
|
FContent := FContent +
|
|
|
|
' <table:table-cell office:value-type="string">' + LineEnding +
|
|
|
|
' <text:p>' + AFormula.DoubleValue + '</text:p>' + LineEnding +
|
|
|
|
' </table:table-cell>' + LineEnding;
|
|
|
|
<table:table-cell table:formula="of:=[.A1]+[.B2]" office:value-type="float" office:value="1833">
|
|
|
|
<text:p>1833</text:p>
|
|
|
|
</table:table-cell>}
|
2009-01-28 22:36:41 +00:00
|
|
|
end;
|
2008-02-24 13:18:34 +00:00
|
|
|
|
2014-04-21 21:43:43 +00:00
|
|
|
{
|
|
|
|
Writes an empty cell
|
|
|
|
|
|
|
|
Not clear whether this is needed for ods, but the inherited procedure is abstract.
|
|
|
|
}
|
|
|
|
procedure TsSpreadOpenDocWriter.WriteBlank(AStream: TStream;
|
|
|
|
const ARow, ACol: Cardinal; ACell: PCell);
|
|
|
|
begin
|
|
|
|
// no action at the moment...
|
|
|
|
end;
|
|
|
|
|
2011-05-30 07:03:56 +00:00
|
|
|
{
|
|
|
|
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
|
|
|
|
}
|
2009-01-28 22:36:41 +00:00
|
|
|
procedure TsSpreadOpenDocWriter.WriteLabel(AStream: TStream; const ARow,
|
2013-12-07 13:42:22 +00:00
|
|
|
ACol: Cardinal; const AValue: string; ACell: PCell);
|
2010-12-08 10:24:15 +00:00
|
|
|
var
|
|
|
|
lStyle: string = '';
|
2011-05-27 13:45:30 +00:00
|
|
|
lIndex: Integer;
|
2009-01-28 22:36:41 +00:00
|
|
|
begin
|
2011-05-27 13:45:30 +00:00
|
|
|
if ACell^.UsedFormattingFields <> [] then
|
|
|
|
begin
|
|
|
|
lIndex := FindFormattingInList(ACell);
|
|
|
|
lStyle := ' table:style-name="ce' + IntToStr(lIndex) + '" ';
|
|
|
|
end;
|
2010-12-08 10:24:15 +00:00
|
|
|
|
2009-01-29 13:24:37 +00:00
|
|
|
// The row should already be the correct one
|
|
|
|
FContent := FContent +
|
2010-12-08 10:24:15 +00:00
|
|
|
' <table:table-cell office:value-type="string"' + lStyle + '>' + LineEnding +
|
2011-05-29 17:42:56 +00:00
|
|
|
' <text:p>' + UTF8TextToXMLText(AValue) + '</text:p>' + LineEnding +
|
2009-01-29 13:24:37 +00:00
|
|
|
' </table:table-cell>' + LineEnding;
|
2009-01-28 22:36:41 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TsSpreadOpenDocWriter.WriteNumber(AStream: TStream; const ARow,
|
2010-12-08 10:24:15 +00:00
|
|
|
ACol: Cardinal; const AValue: double; ACell: PCell);
|
2009-07-01 14:01:44 +00:00
|
|
|
var
|
|
|
|
StrValue: string;
|
2009-11-12 20:26:02 +00:00
|
|
|
DisplayStr: string;
|
2010-12-08 10:24:15 +00:00
|
|
|
lStyle: string = '';
|
2012-06-13 07:21:00 +00:00
|
|
|
lIndex: Integer;
|
2009-01-28 22:36:41 +00:00
|
|
|
begin
|
2012-06-13 07:21:00 +00:00
|
|
|
if ACell^.UsedFormattingFields <> [] then
|
|
|
|
begin
|
|
|
|
lIndex := FindFormattingInList(ACell);
|
|
|
|
lStyle := ' table:style-name="ce' + IntToStr(lIndex) + '" ';
|
|
|
|
end;
|
2010-12-08 10:24:15 +00:00
|
|
|
|
2009-01-28 22:36:41 +00:00
|
|
|
// The row should already be the correct one
|
2009-11-12 20:26:02 +00:00
|
|
|
if IsInfinite(AValue) then begin
|
|
|
|
StrValue:='1.#INF';
|
|
|
|
DisplayStr:='1.#INF';
|
|
|
|
end else begin
|
2012-04-27 08:01:15 +00:00
|
|
|
StrValue:=FloatToStr(AValue,FPointSeparatorSettings); //Uses '.' as decimal separator
|
2009-11-14 18:48:17 +00:00
|
|
|
DisplayStr:=FloatToStr(AValue); // Uses locale decimal separator
|
2009-11-12 20:26:02 +00:00
|
|
|
end;
|
2009-01-28 22:36:41 +00:00
|
|
|
FContent := FContent +
|
2010-12-08 10:24:15 +00:00
|
|
|
' <table:table-cell office:value-type="float" office:value="' + StrValue + '"' + lStyle + '>' + LineEnding +
|
2009-11-12 20:26:02 +00:00
|
|
|
' <text:p>' + DisplayStr + '</text:p>' + LineEnding +
|
2009-01-28 23:20:25 +00:00
|
|
|
' </table:table-cell>' + LineEnding;
|
2008-02-24 13:18:34 +00:00
|
|
|
end;
|
|
|
|
|
2013-12-23 12:11:20 +00:00
|
|
|
{*******************************************************************
|
|
|
|
* TsSpreadOpenDocWriter.WriteDateTime ()
|
|
|
|
*
|
2013-12-23 13:35:36 +00:00
|
|
|
* DESCRIPTION: Writes a date/time value
|
2013-12-23 12:11:20 +00:00
|
|
|
*
|
|
|
|
*
|
|
|
|
*******************************************************************}
|
2013-12-22 14:02:04 +00:00
|
|
|
procedure TsSpreadOpenDocWriter.WriteDateTime(AStream: TStream;
|
|
|
|
const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell);
|
2013-12-23 13:35:36 +00:00
|
|
|
var
|
|
|
|
lStyle: string = '';
|
|
|
|
lIndex: Integer;
|
2013-12-22 14:02:04 +00:00
|
|
|
begin
|
2013-12-23 13:35:36 +00:00
|
|
|
if ACell^.UsedFormattingFields <> [] then
|
|
|
|
begin
|
|
|
|
lIndex := FindFormattingInList(ACell);
|
|
|
|
lStyle := ' table:style-name="ce' + IntToStr(lIndex) + '" ';
|
|
|
|
end;
|
|
|
|
|
|
|
|
// The row should already be the correct one
|
|
|
|
FContent := FContent +
|
|
|
|
' <table:table-cell office:value-type="date" office:date-value="' + FormatDateTime(ISO8601FormatExtended, AValue) + '"' + lStyle + '>' + LineEnding +
|
|
|
|
' </table:table-cell>' + LineEnding;
|
2013-12-22 14:02:04 +00:00
|
|
|
end;
|
|
|
|
|
2009-02-02 09:58:51 +00:00
|
|
|
{
|
|
|
|
Registers this reader / writer on fpSpreadsheet
|
|
|
|
}
|
2008-02-24 13:18:34 +00:00
|
|
|
initialization
|
|
|
|
|
2009-07-01 11:26:56 +00:00
|
|
|
RegisterSpreadFormat(TsSpreadOpenDocReader, TsSpreadOpenDocWriter, sfOpenDocument);
|
2008-02-24 13:18:34 +00:00
|
|
|
|
|
|
|
end.
|
|
|
|
|