paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fpspreadsheet: Add code for detection of date/time cells which are incorrectly written as float by Open/LibreOffice. Implement conditional number formats for all number types (sometimes falsely assigned). Reactivate ignored date test cases for ods-1899, pass. 1904 date mode still faulty, not clear if this will ever pass the test.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3133 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2014-06-03 22:04:11 +00:00
parent dd3229729d
commit 73dc71627b
6 changed files with 497 additions and 166 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
components/fpspreadsheet/examples/fpsgrid/mainform.lfm
View File

@ -4,7 +4,7 @@ object Form1: TForm1
Top = 193 Top = 193
Width = 884 Width = 884
Caption = 'fpsGrid' Caption = 'fpsGrid'
ClientHeight = 624 ClientHeight = 629
ClientWidth = 884 ClientWidth = 884
Menu = MainMenu Menu = MainMenu
OnActivate = FormActivate OnActivate = FormActivate
@ -14,7 +14,7 @@ object Form1: TForm1
object Panel1: TPanel object Panel1: TPanel
Left = 0 Left = 0
Height = 85 Height = 85
Top = 539 Top = 544
Width = 884 Width = 884
Align = alBottom Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
@ -23,9 +23,9 @@ object Form1: TForm1
TabOrder = 0 TabOrder = 0
object CbShowHeaders: TCheckBox object CbShowHeaders: TCheckBox
Left = 8 Left = 8
Height = 24 Height = 19
Top = 8 Top = 8
Width = 116 Width = 93
Caption = 'Show headers' Caption = 'Show headers'
Checked = True Checked = True
OnClick = CbShowHeadersClick OnClick = CbShowHeadersClick
@ -34,9 +34,9 @@ object Form1: TForm1
end end
object CbShowGridLines: TCheckBox object CbShowGridLines: TCheckBox
Left = 8 Left = 8
Height = 24 Height = 19
Top = 32 Top = 32
Width = 125 Width = 100
Caption = 'Show grid lines' Caption = 'Show grid lines'
Checked = True Checked = True
OnClick = CbShowGridLinesClick OnClick = CbShowGridLinesClick
@ -44,54 +44,54 @@ object Form1: TForm1
TabOrder = 1 TabOrder = 1
end end
object EdFrozenCols: TSpinEdit object EdFrozenCols: TSpinEdit
Left = 550 Left = 389
Height = 28 Height = 23
Top = 8 Top = 8
Width = 52 Width = 52
OnChange = EdFrozenColsChange OnChange = EdFrozenColsChange
TabOrder = 2 TabOrder = 2
end end
object EdFrozenRows: TSpinEdit object EdFrozenRows: TSpinEdit
Left = 550 Left = 389
Height = 28 Height = 23
Top = 39 Top = 39
Width = 52 Width = 52
OnChange = EdFrozenRowsChange OnChange = EdFrozenRowsChange
TabOrder = 3 TabOrder = 3
end end
object Label1: TLabel object Label1: TLabel
Left = 464 Left = 304
Height = 20 Height = 15
Top = 13 Top = 13
Width = 77 Width = 62
Caption = 'Frozen cols:' Caption = 'Frozen cols:'
FocusControl = EdFrozenCols FocusControl = EdFrozenCols
ParentColor = False ParentColor = False
end end
object Label2: TLabel object Label2: TLabel
Left = 465 Left = 304
Height = 20 Height = 15
Top = 40 Top = 40
Width = 82 Width = 66
Caption = 'Frozen rows:' Caption = 'Frozen rows:'
FocusControl = EdFrozenRows FocusControl = EdFrozenRows
ParentColor = False ParentColor = False
end end
object CbReadFormulas: TCheckBox object CbReadFormulas: TCheckBox
Left = 8 Left = 8
Height = 24 Height = 19
Top = 56 Top = 56
Width = 120 Width = 96
Caption = 'Read formulas' Caption = 'Read formulas'
OnChange = CbReadFormulasChange OnChange = CbReadFormulasChange
TabOrder = 4 TabOrder = 4
end end
object CbHeaderStyle: TComboBox object CbHeaderStyle: TComboBox
Left = 152 Left = 152
Height = 28 Height = 23
Top = 8 Top = 8
Width = 116 Width = 116
ItemHeight = 20 ItemHeight = 15
ItemIndex = 2 ItemIndex = 2
Items.Strings = ( Items.Strings = (
'Lazarus' 'Lazarus'
@ -106,7 +106,7 @@ object Form1: TForm1
end end
object PageControl1: TPageControl object PageControl1: TPageControl
Left = 0 Left = 0
Height = 460 Height = 465
Top = 79 Top = 79
Width = 884 Width = 884
ActivePage = TabSheet1 ActivePage = TabSheet1
@ -116,11 +116,11 @@ object Form1: TForm1
OnChange = PageControl1Change OnChange = PageControl1Change
object TabSheet1: TTabSheet object TabSheet1: TTabSheet
Caption = 'Sheet1' Caption = 'Sheet1'
ClientHeight = 427 ClientHeight = 437
ClientWidth = 876 ClientWidth = 876
object WorksheetGrid: TsWorksheetGrid object WorksheetGrid: TsWorksheetGrid
Left = 0 Left = 0
Height = 427 Height = 437
Top = 0 Top = 0
Width = 876 Width = 876
FrozenCols = 0 FrozenCols = 0
@ -136,7 +136,7 @@ object Form1: TForm1
TitleStyle = tsNative TitleStyle = tsNative
OnSelection = WorksheetGridSelection OnSelection = WorksheetGridSelection
ColWidths = ( ColWidths = (
56 42
64 64
64 64
64 64
@ -244,19 +244,19 @@ object Form1: TForm1
end end
object FontComboBox: TComboBox object FontComboBox: TComboBox
Left = 52 Left = 52
Height = 28 Height = 23
Top = 2 Top = 2
Width = 127 Width = 127
ItemHeight = 20 ItemHeight = 15
OnSelect = FontComboBoxSelect OnSelect = FontComboBoxSelect
TabOrder = 0 TabOrder = 0
end end
object FontSizeComboBox: TComboBox object FontSizeComboBox: TComboBox
Left = 179 Left = 179
Height = 28 Height = 23
Top = 2 Top = 2
Width = 48 Width = 48
ItemHeight = 20 ItemHeight = 15
Items.Strings = ( Items.Strings = (
'8' '8'
'9' '9'

460
components/fpspreadsheet/fpsopendocument.pas
View File

@ -65,6 +65,7 @@ type
FColumnList: TFPList; FColumnList: TFPList;
FRowStyleList: TFPList; FRowStyleList: TFPList;
FRowList: TFPList; FRowList: TFPList;
FVolatileNumFmtList: TsCustomNumFormatList;
FDateMode: TDateMode; FDateMode: TDateMode;
// Applies internally stored column widths to current worksheet // Applies internally stored column widths to current worksheet
procedure ApplyColWidths; procedure ApplyColWidths;
@ -293,6 +294,7 @@ begin
FColumnList := TFPList.Create; FColumnList := TFPList.Create;
FRowStyleList := TFPList.Create; FRowStyleList := TFPList.Create;
FRowList := TFPList.Create; FRowList := TFPList.Create;
FVolatileNumFmtList := TsCustomNumFormatList.Create(Workbook);
// Set up the default palette in order to have the default color names correct. // Set up the default palette in order to have the default color names correct.
Workbook.UseDefaultPalette; Workbook.UseDefaultPalette;
// Initial base date in case it won't be read from file // Initial base date in case it won't be read from file
@ -318,6 +320,8 @@ begin
for j := FCellStyleList.Count-1 downto 0 do TObject(FCellStyleList[j]).Free; for j := FCellStyleList.Count-1 downto 0 do TObject(FCellStyleList[j]).Free;
FCellStyleList.Free; FCellStyleList.Free;
FVolatileNumFmtList.Free; // automatically destroys its items.
inherited Destroy; inherited Destroy;
end; end;
@ -828,14 +832,14 @@ var
Value, Str: String; Value, Str: String;
lNumber: Double; lNumber: Double;
styleName: String; styleName: String;
lCell: PCell;
begin begin
FSettings := DefaultFormatSettings; FSettings := DefaultFormatSettings;
FSettings.DecimalSeparator:='.'; FSettings.DecimalSeparator:='.';
Value := GetAttrValue(ACellNode,'office:value'); Value := GetAttrValue(ACellNode,'office:value');
if UpperCase(Value)='1.#INF' then if UpperCase(Value)='1.#INF' then
begin FWorkSheet.WriteNumber(Arow,ACol,1.0/0.0)
FWorkSheet.WriteNumber(Arow,ACol,1.0/0.0);
end
else else
begin begin
// Don't merge, or else we can't debug // Don't merge, or else we can't debug
@ -846,6 +850,13 @@ begin
styleName := GetAttrValue(ACellNode, 'table:style-name'); styleName := GetAttrValue(ACellNode, 'table:style-name');
ApplyStyleToCell(ARow, ACol, stylename); ApplyStyleToCell(ARow, ACol, stylename);
// Sometimes date/time cells are marked as "float"...
lCell := FWorksheet.FindCell(ARow, ACol);
if IsDateTimeFormat(lCell^.NumberFormat) then begin
lCell^.ContentType := cctDateTime;
lCell^.DateTimeValue := lCell^.NumberValue;
end;
end; end;
procedure TsSpreadOpenDocReader.ReadDateTime(ARow: Word; ACol : Word; procedure TsSpreadOpenDocReader.ReadDateTime(ARow: Word; ACol : Word;
@ -862,16 +873,318 @@ begin
end; end;
procedure TsSpreadOpenDocReader.ReadNumFormats(AStylesNode: TDOMNode); 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;
isPos, isNeg, isZero: Boolean;
begin
posfmt := '';
negfmt := '';
zerofmt := '';
// These are indicators which part of the format is currently being read.
// Needed to assign text elements correctly.
isPos := false;
isNeg := false;
isZero := false;
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;
case condition[1] of
'<': begin
negfmt := fmt;
isneg := true;
ispos := false;
if (Length(condition) > 1) and (condition[2] = '=') then begin
zerofmt := fmt;
iszero := true;
end;
end;
'>': begin
posfmt := fmt;
ispos := true;
isneg := false;
if (Length(condition) > 1) and (condition[2] = '=') then begin
zerofmt := fmt;
iszero := true;
end;
end;
'=': begin
zerofmt := fmt;
ispos := false;
isneg := false;
iszero := true;
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 ANumFormat <> nfFmtDateTime then
ANumFormat := nfCustom;
end;
procedure ReadNumberStyle(ANumFormatNode: TDOMNode; ANumFormatName: String);
var
node, childNode: TDOMNode;
fmtName, nodeName: String;
fmt: String;
nf: TsNumberFormat;
decs: Byte;
s: String;
grouping: Boolean;
nex: Integer;
begin
fmt := '';
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
s := GetAttrValue(node, 'number:decimal-places');
if s <> '' then decs := StrToInt(s) else decs := 0;
grouping := GetAttrValue(node, 'number:grouping') = 'true';
nf := IfThen(grouping, nfFixedTh, nfFixed);
fmt := fmt + 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;
fmt := fmt + BuildNumberFormatString(nfFixed, Workbook.FormatSettings, decs);
fmt := fmt + 'E+' + DupeString('0', nex);
end else
if nodeName = 'number:text' then begin
childNode := node.FirstChild;
while childNode <> nil do begin
fmt := fmt + childNode.NodeValue;
childNode := childNode.NextSibling;
end;
end;
node := node.NextSibling;
end;
node := ANumFormatNode.FindNode('style:map');
if node <> nil then
ReadStyleMap(node, nf, fmt);
NumFormatList.AddFormat(ANumFormatName, fmt, nf, decs);
end;
procedure ReadPercentageStyle(ANumFormatNode: TDOMNode; ANumFormatName: String);
var
node, childNode: TDOMNode;
fmtName, nodeName: String;
nf: TsNumberFormat;
decs: Byte;
fmt: String;
s: String;
begin
fmt := '';
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
nf := nfPercentage;
s := GetAttrValue(node, 'number:decimal-places');
if s <> '' then decs := StrToInt(s) else decs := 0;
fmt := fmt + BuildNumberFormatString(nfFixed, Workbook.FormatSettings, decs);
// The percent sign has already been added --> nFixed instead of nfPercentage
end else
if nodeName = 'number:text' then begin
childNode := node.FirstChild;
while childNode <> nil do begin
fmt := fmt + childNode.NodeValue;
childNode := childNode.NextSibling;
end;
end;
node := node.NextSibling;
end;
node := ANumFormatNode.FindNode('style:map');
if node <> nil then
ReadStyleMap(node, nf, fmt);
NumFormatList.AddFormat(ANumFormatName, fmt, nf, decs);
end;
procedure ReadDateTimeStyle(ANumFormatNode: TDOMNode; ANumFormatName: String);
var
node, childNode: TDOMNode;
nf: TsNumberFormat;
fmt: String;
nodeName: String;
s, stxt, sovr: String;
begin
fmt := '';
sovr := GetAttrValue(ANumFormatNode, 'number:truncate-on-overflow');
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');
if s = 'long' then fmt := fmt + 'yyyy'
else if s = '' then fmt := fmt + 'yy';
end else
if nodeName = 'number:month' then begin
s := GetAttrValue(node, 'number:style');
stxt := GetAttrValue(node, 'number:textual');
if (stxt = 'true') then begin // Month as text
if (s = 'long') then fmt := fmt + 'mmmm' else fmt := fmt + 'mmm';
end else begin // Month as number
if (s = 'long') then fmt := fmt + 'mm' else fmt := fmt + 'm';
end;
end else
if nodeName = 'number:day' then begin
s := GetAttrValue(node, 'number:style');
stxt := GetAttrValue(node, 'number:textual');
if (stxt = 'true') then begin // day as text
if (s = 'long') then fmt := fmt + 'dddd' else fmt := fmt + 'ddd';
end else begin // day as number
if (s = 'long') then fmt := fmt + 'dd' else fmt := fmt + 'd';
end;
end;
if nodeName = 'number:day-of-week' then begin
s := GetAttrValue(node, 'number:stye');
if (s = 'long') then fmt := fmt + 'dddddd' else fmt := fmt + 'ddddd';
end else
if nodeName = 'number:hours' then begin
s := GetAttrValue(node, 'number:style');
if (sovr = 'false') then begin
if (s = 'long') then fmt := fmt + '[hh]' else fmt := fmt + '[h]';
end else begin
if (s = 'long') then fmt := fmt + 'hh' else fmt := fmt + 'h';
end;
sovr := '';
end else
if nodeName = 'number:minutes' then begin
s := GetAttrValue(node, 'number:style');
if (sovr = 'false') then begin
if (s = 'long') then fmt := fmt + '[nn]' else fmt := fmt + '[n]';
end else begin
if (s = 'long') then fmt := fmt + 'nn' else fmt := fmt + 'n';
end;
sovr := '';
end else
if nodeName = 'number:seconds' then begin
s := GetAttrValue(node, 'number:style');
if (sovr = 'false') then begin
if (s = 'long') then fmt := fmt + '[ss]' else fmt := fmt + '[s]';
end else begin
if (s = 'long') then fmt := fmt + 'ss' else fmt := fmt + 's';
sovr := '';
end;
s := GetAttrValue(node, 'number:decimal-places');
if (s <> '') and (s <> '0') then
fmt := fmt + '.' + DupeString('0', StrToInt(s));
end else
if nodeName = 'number:am-pm' then
fmt := fmt + 'AM/PM'
else
if nodeName = 'number:text' then begin
childnode := node.FirstChild;
if childnode <> nil then
fmt := fmt + childnode.NodeValue;
end;
node := node.NextSibling;
end;
nf := nfFmtDateTime;
node := ANumFormatNode.FindNode('style:map');
if node <> nil then
ReadStyleMap(node, nf, fmt);
NumFormatList.AddFormat(ANumFormatName, fmt, nf);
end;
procedure ReadTextStyle(ANumFormatNode: TDOMNode; ANumFormatName: String);
var
node, childNode: TDOMNode;
nf: TsNumberFormat;
fmt: String;
nodeName: String;
s: String;
begin
fmt := '';
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
fmt := fmt + childnode.NodeValue;
end;
node := node.NextSibling;
end;
node := ANumFormatNode.FindNode('style:map');
if node <> nil then
ReadStyleMap(node, nf, fmt);
if IsDateTimeFormat(fmt) then
nf := nfFmtDateTime
else
nf := nfCustom;
NumFormatList.AddFormat(ANumFormatName, fmt, nf);
end;
var var
NumFormatNode, node, childnode: TDOMNode; NumFormatNode: TDOMNode;
decs: Integer; numfmt_nodename, numfmtname: String;
fmtName: String;
grouping: boolean;
fmt: String;
numfmt_nodename, nodename: String;
nf: TsNumberFormat;
nex: Integer;
s, s1, s2: String;
begin begin
if not Assigned(AStylesNode) then if not Assigned(AStylesNode) then
exit; exit;
@ -880,112 +1193,27 @@ begin
while Assigned(NumFormatNode) do begin while Assigned(NumFormatNode) do begin
numfmt_nodename := NumFormatNode.NodeName; numfmt_nodename := NumFormatNode.NodeName;
if NumFormatNode.HasAttributes then
numfmtName := GetAttrValue(NumFormatNode, 'style:name') else
numfmtName := '';
// Numbers (nfFixed, nfFixedTh, nfExp) // Numbers (nfFixed, nfFixedTh, nfExp)
if numfmt_nodename = 'number:number-style' then begin if numfmt_nodename = 'number:number-style' then
fmtName := GetAttrValue(NumFormatNode, 'style:name'); ReadNumberStyle(NumFormatNode, numfmtName);
node := NumFormatNode.FindNode('number:number');
if node <> nil then begin
s := GetAttrValue(node, 'number:decimal-places');
if s = '' then
nf := nfGeneral
else begin
decs := StrToInt(s);
grouping := GetAttrValue(node, 'number:grouping') = 'true';
nf := IfThen(grouping, nfFixedTh, nfFixed);
end;
fmt := BuildNumberFormatString(nf, Workbook.FormatSettings, decs);
NumFormatList.AddFormat(fmtName, fmt, nf, decs);
end;
node := NumFormatNode.FindNode('number:scientific-number');
if node <> nil then begin
nf := nfExp;
decs := StrToInt(GetAttrValue(node, 'number:decimal-places'));
nex := StrToInt(GetAttrValue(node, 'number:min-exponent-digits'));
fmt := BuildNumberFormatString(nfFixed, Workbook.FormatSettings, decs);
fmt := fmt + 'E+' + DupeString('0', nex);
NumFormatList.AddFormat(fmtName, fmt, nf, decs);
end;
end else
// Percentage // Percentage
if numfmt_nodename = 'number:percentage-style' then begin if numfmt_nodename = 'number:percentage-style' then
fmtName := GetAttrValue(NumFormatNode, 'style:name'); ReadPercentageStyle(NumFormatNode, numfmtName);
node := NumFormatNode.FindNode('number:number');
if node <> nil then begin // Date/time values
nf := nfPercentage; if (numfmt_nodename = 'number:date-style') or (numfmt_nodename = 'number:time-style') then
decs := StrToInt(GetAttrValue(node, 'number:decimal-places')); ReadDateTimeStyle(NumFormatNode, numfmtName);
fmt := BuildNumberFormatString(nf, Workbook.FormatSettings, decs);
NumFormatList.AddFormat(fmtName, fmt, nf, decs); // Text values
end; if (numfmt_nodename = 'number:text-style') then
end else ReadTextStyle(NumFormatNode, numfmtName);
// Date/Time
if (numfmt_nodename = 'number:date-style') or (numfmt_nodename = 'number:time-style') // Next node
then begin
fmtName := GetAttrValue(NumFormatNode, 'style:name');
fmt := '';
node := NumFormatNode.FirstChild;
while Assigned(node) do begin
if node.NodeName = 'number:year' then begin
s := GetAttrValue(node, 'number:style');
if s = 'long' then fmt := fmt + 'yyyy'
else if s = '' then fmt := fmt + 'yy';
end else
if node.NodeName = 'number:month' then begin
s := GetAttrValue(node, 'number:style');
s1 := GetAttrValue(node, 'number:textual');
if (s = 'long') and (s1 = 'text') then fmt := fmt + 'mmmm'
else if (s = '') and (s1 = 'text') then fmt := fmt + 'mmm'
else if (s = 'long') and (s1 = '') then fmt := fmt + 'mm'
else if (s = '') and (s1 = '') then fmt := fmt + 'm';
end else
if node.NodeName = 'number:day' then begin
s := GetAttrValue(node, 'number:style');
s1 := GetAttrValue(node, 'number:textual');
if (s='long') and (s1 = 'text') then fmt := fmt + 'dddd'
else if (s='') and (s1 = 'text') then fmt := fmt + 'ddd'
else if (s='long') and (s1 = '') then fmt := fmt + 'dd'
else if (s='') and (s1='') then fmt := Fmt + 'd';
end else
if node.NodeName = 'number:day-of-week' then
fmt := fmt + 'ddddd'
else
if node.NodeName = 'number:hours' then begin
s := GetAttrValue(node, 'number:style');
s1 := GetAttrValue(node, 'number:truncate-on-overflow');
if (s='long') and (s1='false') then fmt := fmt + '[hh]'
else if (s='long') and (s1='') then fmt := fmt + 'hh'
else if (s='') and (s1='false') then fmt := fmt + '[h]'
else if (s='') and (s1='') then fmt := fmt + 'h';
end else
if node.NodeName = 'number:minutes' then begin
s := GetAttrValue(node, 'number:style');
s1 := GetAttrValue(node, 'number:truncate-on-overflow');
if (s='long') and (s1='false') then fmt := fmt + '[nn]'
else if (s='long') and (s1='') then fmt := fmt + 'nn'
else if (s='') and (s1='false') then fmt := fmt + '[n]'
else if (s='') and (s1='') then fmt := fmt + 'n';
end else
if node.NodeName = 'number:seconds' then begin
s := GetAttrValue(node, 'number:style');
s1 := GetAttrValue(node, 'number:truncate-on-overflow');
s2 := GetAttrValue(node, 'number:decimal-places');
if (s='long') and (s1='false') then fmt := fmt + '[ss]'
else if (s='long') and (s1='') then fmt := fmt + 'ss'
else if (s='') and (s1='false') then fmt := fmt + '[s]'
else if (s='') and (s1='') then fmt := fmt + 's';
if (s2 <> '') and (s2 <> '0') then fmt := fmt + '.' + DupeString('0', StrToInt(s2));
end else
if node.NodeName = 'number:am-pm' then
fmt := fmt + 'AM/PM'
else
if node.NodeName = 'number:text' then begin
childnode := node.FirstChild;
if childnode <> nil then
fmt := fmt + childnode.NodeValue;
end;
node := node.NextSibling;
end;
NumFormatList.AddFormat(fmtName, fmt, nfFmtDateTime);
end;
NumFormatNode := NumFormatNode.NextSibling; NumFormatNode := NumFormatNode.NextSibling;
end; end;
end; end;

14
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -1526,13 +1526,25 @@ function TsWorksheet.ReadAsUTF8Text(ACell: PCell): ansistring;
function DateTimeToStrNoNaN(const Value: Double; function DateTimeToStrNoNaN(const Value: Double;
ANumberFormat: TsNumberFormat; ANumberFormatStr: String; ADecimals: Word): ansistring; ANumberFormat: TsNumberFormat; ANumberFormatStr: String; ADecimals: Word): ansistring;
var
fmtp, fmtn, fmt0: String;
begin begin
Result := ''; Result := '';
if not IsNaN(Value) then begin if not IsNaN(Value) then begin
if ANumberFormatStr = '' then if ANumberFormatStr = '' then
ANumberFormatStr := BuildDateTimeFormatString(ANumberFormat, ANumberFormatStr := BuildDateTimeFormatString(ANumberFormat,
Workbook.FormatSettings, ANumberFormatStr); Workbook.FormatSettings, ANumberFormatStr);
Result := FormatDateTime(ANumberFormatStr, Value, [fdoInterval]); // Saw strange cases in ods where date/time formats contained pos/neg/zero parts.
// Split to be on the safe side.
SplitFormatString(ANumberFormatStr, fmtp, fmtn, fmt0);
if (Value > 0) or ((Value = 0) and (fmt0 = '')) or ((Value < 0) and (fmtn = '')) then
Result := FormatDateTime(fmtp, Value, [fdoInterval])
else
if (Value < 0) then
Result := FormatDateTime(fmtn, Value, [fdoInterval])
else
if (Value = 0) then
Result := FormatDateTime(fmt0, Value, [fdoInterval]);
end; end;
end; end;

2
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -2591,6 +2591,8 @@ begin
FreeAndNil(FWorkbook); FreeAndNil(FWorkbook);
FWorkbook := TsWorkbook.Create; FWorkbook := TsWorkbook.Create;
FWorksheet := FWorkbook.AddWorksheet('Sheet1'); FWorksheet := FWorkbook.AddWorksheet('Sheet1');
FWorksheet.OnChangeCell := @ChangedCellHandler;
FWorksheet.OnChangeFont := @ChangedFontHandler;
FInitColCount := AColCount; FInitColCount := AColCount;
FInitRowCount := ARowCount; FInitRowCount := ARowCount;
Setup; Setup;

91
components/fpspreadsheet/fpsutils.pas
View File

@ -68,7 +68,8 @@ function UTF8TextToXMLText(AText: ansistring): ansistring;
function IfThen(ACondition: Boolean; AValue1,AValue2: TsNumberFormat): TsNumberFormat; overload; function IfThen(ACondition: Boolean; AValue1,AValue2: TsNumberFormat): TsNumberFormat; overload;
function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean; function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean; overload;
function IsDateTimeFormat(AFormatStr: String): Boolean; overload;
function BuildNumberFormatString(ANumberFormat: TsNumberFormat; function BuildNumberFormatString(ANumberFormat: TsNumberFormat;
const AFormatSettings: TFormatSettings; ADecimals: Integer = -1; const AFormatSettings: TFormatSettings; ADecimals: Integer = -1;
@ -88,6 +89,8 @@ function SpecialDateTimeFormat(ACode: String;
const AFormatSettings: TFormatSettings; ForWriting: Boolean): String; const AFormatSettings: TFormatSettings; ForWriting: Boolean): String;
function SplitAccountingFormatString(const AFormatString: String; ASection: ShortInt; function SplitAccountingFormatString(const AFormatString: String; ASection: ShortInt;
var ALeft, ARight: String): Byte; var ALeft, ARight: String): Byte;
procedure SplitFormatString(const AFormatString: String; out APositivePart,
ANegativePart, AZeroPart: String);
function SciFloat(AValue: Double; ADecimals: Byte): String; function SciFloat(AValue: Double; ADecimals: Byte): String;
//function TimeIntervalToString(AValue: TDateTime; AFormatStr: String): String; //function TimeIntervalToString(AValue: TDateTime; AFormatStr: String): String;
@ -556,6 +559,49 @@ begin
nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM, nfTimeInterval]; nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM, nfTimeInterval];
end; end;
function IsDateTimeFormat(AFormatStr: string): Boolean;
var
P, PStart, PEnd: PChar;
token: Char;
begin
if AFormatStr = '' then
Result := false
else begin
PStart := PChar(@AFormatStr[1]);
PEnd := PStart + Length(AFormatStr);
P := PStart;
while P < PEnd do begin
token := P^;
case token of // Skip quoted text
'"': begin
inc(P);
token := P^;
while (P < PEnd) and (token <> '"') do begin
inc(P);
token := P^;
end;
end;
{
'[': begin
inc(P);
token := P^;
while (P < PEnd) and (token <> ']') do begin
inc(P);
token := P^;
end;
end;
}
'y', 'Y', 'm', 'M', 'd', 'D', 'h', 'H', 'n', 'N', 's', 'S', ':':
begin
Result := true;
exit;
end;
end;
inc(P);
end;
end;
end;
{ Builds a date/time format string from the numberformat code. If the format code { Builds a date/time format string from the numberformat code. If the format code
is nfFmtDateTime the given AFormatString is used. AFormatString can use the is nfFmtDateTime the given AFormatString is used. AFormatString can use the
abbreviations "dm" (for "d/mmm"), "my" (for "mmm/yy"), "ms" (for "mm:ss") abbreviations "dm" (for "d/mmm"), "my" (for "mmm/yy"), "ms" (for "mm:ss")
@ -889,6 +935,49 @@ begin
end; end;
end; end;
procedure SplitFormatString(const AFormatString: String; out APositivePart,
ANegativePart, AZeroPart: String);
var
P, PStart, PEnd: PChar;
token: Char;
where: Byte; // 0 = positive part, 1 = negative part, 2 = zero part
begin
APositivePart := '';
ANegativePart := '';
AZeroPart := '';
if AFormatString = '' then
exit;
PStart := PChar(@AFormatString[1]);
PEnd := PStart + Length(AFormatString);
P := PStart;
where := 0;
while P < PEnd do begin
token := P^;
case token of
'"': begin // Skip quoted strings
inc(P);
token := P^;
while (P < PEnd) and (token <> '"') do begin
inc(P);
token := P^;
end;
end;
';': begin // Separator between parts
inc(where);
if where = 3 then
exit;
end
else case where of
0: APositivePart := APositivePart + token;
1: ANegativePart := ANegativePart + token;
2: AZeroPart := AZeroPart + token;
end;
end;
inc(P);
end;
end;
{ Formats the number AValue in "scientific" format with the given number of { Formats the number AValue in "scientific" format with the given number of
decimals. "Scientific" is the same as "exponential", but with exponents rounded decimals. "Scientific" is the same as "exponential", but with exponents rounded
to multiples of 3 (like for "kilo" - "Mega" - "Giga" etc.). } to multiples of 3 (like for "kilo" - "Mega" - "Giga" etc.). }

40
components/fpspreadsheet/tests/datetests.pas
View File

@ -856,8 +856,8 @@ end;
procedure TSpreadReadDateTests.TestReadODFDate13; procedure TSpreadReadDateTests.TestReadODFDate13;
begin begin
Ignore('ODF code does not support custom date format'); //Ignore('ODF code does not support custom date format');
//TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF,13); TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF,13);
end; end;
procedure TSpreadReadDateTests.TestReadODFDate14; procedure TSpreadReadDateTests.TestReadODFDate14;
@ -1055,8 +1055,8 @@ end;
procedure TSpreadReadDateTests.TestReadODFDate1899_13; procedure TSpreadReadDateTests.TestReadODFDate1899_13;
begin begin
Ignore('ODF code does not support custom date format'); //Ignore('ODF code does not support custom date format');
//TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,13); TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,13);
end; end;
procedure TSpreadReadDateTests.TestReadODFDate1899_14; procedure TSpreadReadDateTests.TestReadODFDate1899_14;
@ -1066,14 +1066,14 @@ end;
procedure TSpreadReadDateTests.TestReadODFDate1899_15; procedure TSpreadReadDateTests.TestReadODFDate1899_15;
begin begin
Ignore('ODF code does not support custom date format'); //Ignore('ODF code does not support custom date format');
//TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,15); TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,15);
end; end;
procedure TSpreadReadDateTests.TestReadODFDate1899_16; procedure TSpreadReadDateTests.TestReadODFDate1899_16;
begin begin
Ignore('ODF code does not support custom date format'); //Ignore('ODF code does not support custom date format');
//TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,16); TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,16);
end; end;
procedure TSpreadReadDateTests.TestReadODFDate1899_17; procedure TSpreadReadDateTests.TestReadODFDate1899_17;
@ -1098,8 +1098,8 @@ end;
procedure TSpreadReadDateTests.TestReadODFDate1899_21; procedure TSpreadReadDateTests.TestReadODFDate1899_21;
begin begin
Ignore('ODF code does not support custom date format'); //Ignore('ODF code does not support custom date format');
//TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,21); TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,21);
end; end;
procedure TSpreadReadDateTests.TestReadODFDate1899_22; procedure TSpreadReadDateTests.TestReadODFDate1899_22;
@ -1109,14 +1109,14 @@ end;
procedure TSpreadReadDateTests.TestReadODFDate1899_23; procedure TSpreadReadDateTests.TestReadODFDate1899_23;
begin begin
Ignore('ODF code does not support custom date format'); //Ignore('ODF code does not support custom date format');
//TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,23); TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,23);
end; end;
procedure TSpreadReadDateTests.TestReadODFDate1899_24; procedure TSpreadReadDateTests.TestReadODFDate1899_24;
begin begin
Ignore('ODF code does not support custom date format'); //Ignore('ODF code does not support custom date format');
//TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,24); TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,24);
end; end;
procedure TSpreadReadDateTests.TestReadODFDate1899_25; procedure TSpreadReadDateTests.TestReadODFDate1899_25;
@ -1141,8 +1141,8 @@ end;
procedure TSpreadReadDateTests.TestReadODFDate1899_29; procedure TSpreadReadDateTests.TestReadODFDate1899_29;
begin begin
Ignore('ODF code does not support custom date format'); //Ignore('ODF code does not support custom date format');
//TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,29); TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,29);
end; end;
procedure TSpreadReadDateTests.TestReadODFDate1899_30; procedure TSpreadReadDateTests.TestReadODFDate1899_30;
@ -1152,14 +1152,14 @@ end;
procedure TSpreadReadDateTests.TestReadODFDate1899_31; procedure TSpreadReadDateTests.TestReadODFDate1899_31;
begin begin
Ignore('ODF code does not support custom date format'); //Ignore('ODF code does not support custom date format');
//TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,31); TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,31);
end; end;
procedure TSpreadReadDateTests.TestReadODFDate1899_32; procedure TSpreadReadDateTests.TestReadODFDate1899_32;
begin begin
Ignore('ODF code does not support custom date format'); //Ignore('ODF code does not support custom date format');
//TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,32); TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,32);
end; end;
procedure TSpreadReadDateTests.TestReadODFDate1899_33; procedure TSpreadReadDateTests.TestReadODFDate1899_33;