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

460
components/fpspreadsheet/fpsopendocument.pas
View File

@ -65,6 +65,7 @@ type
FColumnList: TFPList;
FRowStyleList: TFPList;
FRowList: TFPList;
FVolatileNumFmtList: TsCustomNumFormatList;
FDateMode: TDateMode;
// Applies internally stored column widths to current worksheet
procedure ApplyColWidths;
@ -293,6 +294,7 @@ begin
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
@ -318,6 +320,8 @@ begin
for j := FCellStyleList.Count-1 downto 0 do TObject(FCellStyleList[j]).Free;
FCellStyleList.Free;
FVolatileNumFmtList.Free; // automatically destroys its items.
inherited Destroy;
end;
@ -828,14 +832,14 @@ var
Value, Str: String;
lNumber: Double;
styleName: String;
lCell: PCell;
begin
FSettings := DefaultFormatSettings;
FSettings.DecimalSeparator:='.';
Value := GetAttrValue(ACellNode,'office:value');
if UpperCase(Value)='1.#INF' then
begin
FWorkSheet.WriteNumber(Arow,ACol,1.0/0.0);
end
FWorkSheet.WriteNumber(Arow,ACol,1.0/0.0)
else
begin
// Don't merge, or else we can't debug
@ -846,6 +850,13 @@ begin
styleName := GetAttrValue(ACellNode, 'table:style-name');
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;
procedure TsSpreadOpenDocReader.ReadDateTime(ARow: Word; ACol : Word;
@ -862,16 +873,318 @@ begin
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;
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
NumFormatNode, node, childnode: TDOMNode;
decs: Integer;
fmtName: String;
grouping: boolean;
fmt: String;
numfmt_nodename, nodename: String;
nf: TsNumberFormat;
nex: Integer;
s, s1, s2: String;
NumFormatNode: TDOMNode;
numfmt_nodename, numfmtname: String;
begin
if not Assigned(AStylesNode) then
exit;
@ -880,112 +1193,27 @@ begin
while Assigned(NumFormatNode) do begin
numfmt_nodename := NumFormatNode.NodeName;
if NumFormatNode.HasAttributes then
numfmtName := GetAttrValue(NumFormatNode, 'style:name') else
numfmtName := '';
// Numbers (nfFixed, nfFixedTh, nfExp)
if numfmt_nodename = 'number:number-style' then begin
fmtName := GetAttrValue(NumFormatNode, 'style:name');
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
if numfmt_nodename = 'number:number-style' then
ReadNumberStyle(NumFormatNode, numfmtName);
// Percentage
if numfmt_nodename = 'number:percentage-style' then begin
fmtName := GetAttrValue(NumFormatNode, 'style:name');
node := NumFormatNode.FindNode('number:number');
if node <> nil then begin
nf := nfPercentage;
decs := StrToInt(GetAttrValue(node, 'number:decimal-places'));
fmt := BuildNumberFormatString(nf, Workbook.FormatSettings, decs);
NumFormatList.AddFormat(fmtName, fmt, nf, decs);
end;
end else
// Date/Time
if (numfmt_nodename = 'number:date-style') or (numfmt_nodename = 'number:time-style')
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;
if numfmt_nodename = 'number:percentage-style' then
ReadPercentageStyle(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;

14
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -1526,13 +1526,25 @@ function TsWorksheet.ReadAsUTF8Text(ACell: PCell): ansistring;
function DateTimeToStrNoNaN(const Value: Double;
ANumberFormat: TsNumberFormat; ANumberFormatStr: String; ADecimals: Word): ansistring;
var
fmtp, fmtn, fmt0: String;
begin
Result := '';
if not IsNaN(Value) then begin
if ANumberFormatStr = '' then
ANumberFormatStr := BuildDateTimeFormatString(ANumberFormat,
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;

2
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -2591,6 +2591,8 @@ begin
FreeAndNil(FWorkbook);
FWorkbook := TsWorkbook.Create;
FWorksheet := FWorkbook.AddWorksheet('Sheet1');
FWorksheet.OnChangeCell := @ChangedCellHandler;
FWorksheet.OnChangeFont := @ChangedFontHandler;
FInitColCount := AColCount;
FInitRowCount := ARowCount;
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 IsDateTimeFormat(AFormat: TsNumberFormat): Boolean;
function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean; overload;
function IsDateTimeFormat(AFormatStr: String): Boolean; overload;
function BuildNumberFormatString(ANumberFormat: TsNumberFormat;
const AFormatSettings: TFormatSettings; ADecimals: Integer = -1;
@ -88,6 +89,8 @@ function SpecialDateTimeFormat(ACode: String;
const AFormatSettings: TFormatSettings; ForWriting: Boolean): String;
function SplitAccountingFormatString(const AFormatString: String; ASection: ShortInt;
var ALeft, ARight: String): Byte;
procedure SplitFormatString(const AFormatString: String; out APositivePart,
ANegativePart, AZeroPart: String);
function SciFloat(AValue: Double; ADecimals: Byte): String;
//function TimeIntervalToString(AValue: TDateTime; AFormatStr: String): String;
@ -556,6 +559,49 @@ begin
nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM, nfTimeInterval];
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
is nfFmtDateTime the given AFormatString is used. AFormatString can use the
abbreviations "dm" (for "d/mmm"), "my" (for "mmm/yy"), "ms" (for "mm:ss")
@ -889,6 +935,49 @@ begin
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
decimals. "Scientific" is the same as "exponential", but with exponents rounded
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;
begin
Ignore('ODF code does not support custom date format');
//TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF,13);
//Ignore('ODF code does not support custom date format');
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF,13);
end;
procedure TSpreadReadDateTests.TestReadODFDate14;
@ -1055,8 +1055,8 @@ end;
procedure TSpreadReadDateTests.TestReadODFDate1899_13;
begin
Ignore('ODF code does not support custom date format');
//TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,13);
//Ignore('ODF code does not support custom date format');
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,13);
end;
procedure TSpreadReadDateTests.TestReadODFDate1899_14;
@ -1066,14 +1066,14 @@ end;
procedure TSpreadReadDateTests.TestReadODFDate1899_15;
begin
Ignore('ODF code does not support custom date format');
//TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,15);
//Ignore('ODF code does not support custom date format');
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,15);
end;
procedure TSpreadReadDateTests.TestReadODFDate1899_16;
begin
Ignore('ODF code does not support custom date format');
//TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,16);
//Ignore('ODF code does not support custom date format');
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,16);
end;
procedure TSpreadReadDateTests.TestReadODFDate1899_17;
@ -1098,8 +1098,8 @@ end;
procedure TSpreadReadDateTests.TestReadODFDate1899_21;
begin
Ignore('ODF code does not support custom date format');
//TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,21);
//Ignore('ODF code does not support custom date format');
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,21);
end;
procedure TSpreadReadDateTests.TestReadODFDate1899_22;
@ -1109,14 +1109,14 @@ end;
procedure TSpreadReadDateTests.TestReadODFDate1899_23;
begin
Ignore('ODF code does not support custom date format');
//TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,23);
//Ignore('ODF code does not support custom date format');
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,23);
end;
procedure TSpreadReadDateTests.TestReadODFDate1899_24;
begin
Ignore('ODF code does not support custom date format');
//TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,24);
//Ignore('ODF code does not support custom date format');
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,24);
end;
procedure TSpreadReadDateTests.TestReadODFDate1899_25;
@ -1141,8 +1141,8 @@ end;
procedure TSpreadReadDateTests.TestReadODFDate1899_29;
begin
Ignore('ODF code does not support custom date format');
//TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,29);
//Ignore('ODF code does not support custom date format');
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,29);
end;
procedure TSpreadReadDateTests.TestReadODFDate1899_30;
@ -1152,14 +1152,14 @@ end;
procedure TSpreadReadDateTests.TestReadODFDate1899_31;
begin
Ignore('ODF code does not support custom date format');
//TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,31);
//Ignore('ODF code does not support custom date format');
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,31);
end;
procedure TSpreadReadDateTests.TestReadODFDate1899_32;
begin
Ignore('ODF code does not support custom date format');
//TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,32);
//Ignore('ODF code does not support custom date format');
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileODF_1899,32);
end;
procedure TSpreadReadDateTests.TestReadODFDate1899_33;