diff --git a/components/fpspreadsheet/examples/excel8demo/excel8write.lpr b/components/fpspreadsheet/examples/excel8demo/excel8write.lpr
index 0a4c3de62..5517d29d0 100644
--- a/components/fpspreadsheet/examples/excel8demo/excel8write.lpr
+++ b/components/fpspreadsheet/examples/excel8demo/excel8write.lpr
@@ -42,16 +42,19 @@ begin
MyWorksheet := MyWorkbook.AddWorksheet(Str_Worksheet1);
MyWorksheet.Options := MyWorksheet.Options - [soShowGridLines];
+ {
MyWorksheet.Options := MyWorksheet.Options + [soHasFrozenPanes];
myWorksheet.LeftPaneWidth := 1;
MyWorksheet.TopPaneHeight := 2;
+ }
{ non-frozen panes not working, at the moment. Requires SELECTION records?
MyWorksheet.LeftPaneWidth := 20*72*2; // 72 pt = inch --> 2 inches = 5 cm
}
// Write some cells
- MyWorksheet.WriteNumber(0, 0, 1.0);// A1
+// MyWorksheet.WriteNumber(0, 0, 1.0);// A1
+ MyWorksheet.WriteNumber(0, 0, 1.0, nfFixed, 3);// A1
MyWorksheet.WriteNumber(0, 1, 2.0);// B1
MyWorksheet.WriteNumber(0, 2, 3.0);// C1
MyWorksheet.WriteNumber(0, 3, 4.0);// D1
diff --git a/components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpi b/components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpi
index f04d7864a..009e9d077 100644
--- a/components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpi
+++ b/components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpi
@@ -107,7 +107,7 @@
-
+
@@ -131,26 +131,24 @@
-
-
-
-
+
+
-
-
+
+
-
+
@@ -163,7 +161,7 @@
-
+
@@ -171,7 +169,7 @@
-
+
@@ -179,7 +177,7 @@
-
+
@@ -187,14 +185,14 @@
-
+
-
+
@@ -202,7 +200,7 @@
-
+
@@ -210,7 +208,7 @@
-
+
@@ -218,7 +216,7 @@
-
+
@@ -226,7 +224,7 @@
-
+
@@ -235,7 +233,7 @@
-
+
@@ -243,7 +241,7 @@
-
+
@@ -251,24 +249,23 @@
-
+
-
+
-
-
-
+
+
@@ -277,22 +274,27 @@
-
+
-
+
+
-
-
-
+
+
+
+
+
+
+
@@ -300,7 +302,7 @@
-
+
@@ -308,7 +310,7 @@
-
+
@@ -316,7 +318,7 @@
-
+
@@ -324,384 +326,394 @@
-
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
@@ -731,6 +743,15 @@
+
+
+
+
+
+
+
+
+
diff --git a/components/fpspreadsheet/fpsnumformatparser.pas b/components/fpspreadsheet/fpsnumformatparser.pas
new file mode 100644
index 000000000..8233215f1
--- /dev/null
+++ b/components/fpspreadsheet/fpsnumformatparser.pas
@@ -0,0 +1,598 @@
+unit fpsNumFormatParser;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+interface
+
+uses
+ SysUtils, fpspreadsheet;
+
+
+const
+ psOK = 0;
+ psErrNoValidColorIndex = 1;
+ psErrNoValidCompareNumber = 2;
+ psErrUnknownInfoInBrackets = 3;
+ psErrConditionalFormattingNotSupported = 4;
+ psErrNoUsableFormat = 5;
+ psErrNoValidNumberFormat = 6;
+ psErrNoValidDateTimeFormat = 7;
+
+{ TsNumFormatParser }
+
+type
+ TsCompareOperation = (coNotUsed,
+ coEqual, coNotEqual, coLess, coGreater, coLessEqual, coGreaterEqual
+ );
+
+ TsNumFormatSection = record
+ FormatString: String;
+ CompareOperation: TsCompareOperation;
+ CompareValue: Double;
+ Color: TsColor;
+ CountryCode: String;
+ CurrencySymbol: String;
+ Decimals: Byte;
+ NumFormat: TsNumberFormat;
+ end;
+
+ TsNumFormatParser = class
+ private
+ FWorkbook: TsWorkbook;
+ FCurrent: PChar;
+ FStart: PChar;
+ FEnd: PChar;
+ FCurrSection: Integer;
+ FSections: array of TsNumFormatSection;
+ FFormatSettings: TFormatSettings;
+ FFormatString: String;
+ FStatus: Integer;
+ function GetParsedSectionCount: Integer;
+ function GetParsedSections(AIndex: Integer): TsNumFormatSection;
+
+ protected
+ procedure AddChar(AChar: Char);
+ procedure AddSection;
+ procedure AnalyzeBracket(const AValue: String);
+ procedure AnalyzeText(const AValue: String);
+ procedure CheckSections;
+ procedure Parse(const AFormatString: String);
+ procedure ScanAMPM(var s: String);
+ procedure ScanBrackets;
+ procedure ScanDateTime;
+ procedure ScanDateTimeParts(TestToken, Replacement: Char; var s: String);
+ procedure ScanFormat;
+ procedure ScanNumber;
+ procedure ScanText;
+
+ public
+ constructor Create(AWorkbook: TsWorkbook; const AFormatString: String);
+ destructor Destroy; override;
+ property FormatString: String read FFormatString;
+ property ParsedSectionCount: Integer read GetParsedSectionCount;
+ property ParsedSections[AIndex: Integer]: TsNumFormatSection read GetParsedSections;
+ property Status: Integer read FStatus;
+ end;
+
+implementation
+
+uses
+ fpsutils;
+
+const
+ COMPARE_STR: array[TsCompareOperation] of string = (
+ '', '=', '<>', '<', '>', '<=', '>'
+ );
+
+{ TsNumFormatParser }
+
+constructor TsNumFormatParser.Create(AWorkbook: TsWorkbook;
+ const AFormatString: String);
+begin
+ inherited Create;
+ FWorkbook := AWorkbook;
+ FFormatSettings := DefaultFormatSettings;
+ FFormatSettings.DecimalSeparator := '.';
+ FFormatSettings.ThousandSeparator := ',';
+ Parse(AFormatString);
+end;
+
+destructor TsNumFormatParser.Destroy;
+begin
+ FSections := nil;
+ inherited Destroy;
+end;
+
+procedure TsNumFormatParser.AddChar(AChar: Char);
+begin
+ with FSections[FCurrSection] do
+ FormatString := FormatString + AChar;
+end;
+
+procedure TsNumFormatParser.AddSection;
+begin
+ FCurrSection := Length(FSections);
+ SetLength(FSections, FCurrSection + 1);
+ with FSections[FCurrSection] do begin
+ FormatString := '';
+ CompareOperation := coNotUsed;
+ CompareValue := 0.0;
+ Color := scBlack;
+ CountryCode := '';
+ CurrencySymbol := '';
+ Decimals := 0;
+ NumFormat := nfGeneral;
+ end;
+end;
+
+procedure TsNumFormatParser.AnalyzeBracket(const AValue: String);
+var
+ lValue: String;
+ n: Integer;
+begin
+ lValue := lowercase(AValue);
+ // Colors
+ if lValue = 'red' then
+ FSections[FCurrSection].Color := scRed
+ else
+ if lValue = 'black' then
+ FSections[FCurrSection].Color := scBlack
+ else
+ if lValue = 'blue' then
+ FSections[FCurrSection].Color := scBlue
+ else
+ if lValue = 'white' then
+ FSections[FCurrSection].Color := scWhite
+ else
+ if lValue = 'green' then
+ FSections[FCurrSection].Color := scGreen
+ else
+ if lValue = 'cyan' then
+ FSections[FCurrSection].Color := scCyan
+ else
+ if lValue = 'magenta' then
+ FSections[FCurrSection].Color := scMagenta
+ else
+ if copy(lValue, 1, 5) = 'color' then begin
+ lValue := copy(lValue, 6, Length(lValue));
+ if not TryStrToInt(trim(lValue), n) then begin
+ FStatus := psErrNoValidColorIndex;
+ exit;
+ end;
+ FSections[FCurrSection].Color := n;
+ end
+ else
+ // Conditions
+ if lValue[1] in ['=', '<', '>'] then begin
+ n := 1;
+ case lValue[1] of
+ '=': FSections[FCurrSection].CompareOperation := coEqual;
+ '<': case lValue[2] of
+ '>': begin FSections[FCurrSection].CompareOperation := coNotEqual; inc(n); end;
+ '=': begin FSections[FCurrSection].CompareOperation := coLessEqual; inc(n); end;
+ else FSections[FCurrSection].CompareOperation := coLess;
+ end;
+ '>': case lValue[2] of
+ '=': begin FSections[FCurrSection].CompareOperation := coGreaterEqual; inc(n); end;
+ else FSections[FCurrSection].CompareOperation := coGreater;
+ end;
+ end;
+ Delete(lValue, 1, n);
+ if not TryStrToFloat(trim(lValue), FSections[FCurrSection].CompareValue) then
+ FStatus := psErrNoValidCompareNumber;
+ end else
+ // Locale information
+ if lValue[1] = '$' then begin
+ FSections[FCurrSection].CountryCode := Copy(AValue, 2, Length(AValue));
+ end else
+ FStatus := psErrUnknownInfoInBrackets;
+end;
+
+procedure TsNumFormatParser.AnalyzeText(const AValue: String);
+var
+ uValue: String;
+begin
+ uValue := Uppercase(AValue);
+ if (uValue = '$') or (uValue = 'USD') or (uValue = '€') or (uValue = 'EUR') or
+ (uValue = '£') or (uValue = 'GBP') or (uValue = '¥') or (uValue = 'JPY')
+ then
+ FSections[FCurrSection].CurrencySymbol := AValue;
+end;
+
+procedure TsNumFormatParser.CheckSections;
+var
+ i: Integer;
+ ns: Integer;
+ s: String;
+begin
+ ns := Length(FSections);
+
+ for i:=0 to ns-1 do begin
+ if FSections[i].FormatString = '' then
+ FSections[i].NumFormat := nfGeneral;
+
+ if (FSections[i].CurrencySymbol <> '') and (FSections[i].NumFormat = nfFixedTh) then
+ FSections[i].NumFormat := nfCurrency;
+
+ if FSections[i].CompareOperation <> coNotUsed then begin
+ FStatus := psErrConditionalFormattingNotSupported;
+ exit;
+ end;
+
+ case FSections[i].NumFormat of
+ nfGeneral, nfFixed, nfFixedTh, nfPercentage, nfExp, nfSci, nfCurrency:
+ try
+ s := FormatFloat(FSections[i].FormatString, 1.0, FWorkBook.FormatSettings);
+ except
+ FStatus := psErrNoValidNumberFormat;
+ exit;
+ end;
+
+ nfShortDateTime, nfShortDate, nfShortTime, nfShortTimeAM,
+ nfLongDate, nfLongTime, nfLongTimeAM, nfFmtDateTime:
+ try
+ s := FormatDateTimeEx(FSections[i].FormatString, now(), FWorkbook.FormatSettings);
+ except
+ FStatus := psErrNoValidDateTimeFormat;
+ exit;
+ end;
+ end;
+ end;
+
+ if ns = 2 then
+ FFormatString := Format('%s;%s;%s', [
+ FSections[0].FormatString,
+ FSections[1].FormatString,
+ FSections[0].FormatString // make sure that fpc understands the "zero"
+ ])
+ else
+ if ns > 0 then begin
+ FFormatString := FSections[0].FormatString;
+ for i:=1 to ns-1 do
+ FFormatString := Format('%s;%s', [FFormatString, FSections[i].FormatString]);
+ end else
+ FStatus := psErrNoUsableFormat;
+end;
+
+{
+function TsNumFormatParser.GetNumFormat: TsNumberFormat;
+var
+ i: Integer;
+begin
+ if FStatus <> psOK then
+ Result := nfGeneral
+ else
+ if (FSections[0].NumFormat = nfCurrency) and (FSections[1].NumFormat = nfCurrency) and
+ (FSections[2].NumFormat = nfCurrency)
+ then begin
+ if (FSections[1].Color = scNotDefined) then begin
+ if (FSections[2].FormatString = '-') then
+ Result := nfCurrencyDash
+ else
+ Result := nfCurrency;
+ end else
+ if FSections[1].Color = scRed then begin
+ if (FSections[2].Formatstring = '-') then
+ Result := nfCurrencyDashRed
+ else
+ Result := nfCurrencyRed;
+ end;
+ end else
+ Result := FSections[0].NumFormat;
+end;
+}
+
+function TsNumFormatParser.GetParsedSectionCount: Integer;
+begin
+ Result := Length(FSections);
+end;
+
+function TsNumFormatParser.GetParsedSections(AIndex: Integer): TsNumFormatSection;
+begin
+ Result := FSections[AIndex];
+end;
+
+procedure TsNumFormatParser.Parse(const AFormatString: String);
+var
+ token: Char;
+begin
+ FStatus := psOK;
+ AddSection;
+ FStart := @AFormatString[1];
+ FEnd := FStart + Length(AFormatString) - 1;
+ FCurrent := FStart;
+ while (FCurrent <= FEnd) and (FStatus = psOK) do begin
+ token := FCurrent^;
+ case token of
+ '[': ScanBrackets;
+ ';': AddSection;
+ else ScanFormat;
+ end;
+ inc(FCurrent);
+ end;
+ CheckSections;
+end;
+
+{ Extracts the text between square brackets --> AnalyzeBracket }
+procedure TsNumFormatParser.ScanBrackets;
+var
+ s: String;
+ token: Char;
+begin
+ inc(FCurrent); // cursor stands at '['
+ while (FCurrent <= FEnd) and (FStatus = psOK) do begin
+ token := FCurrent^;
+ case token of
+ ']': begin
+ AnalyzeBracket(s);
+ break;
+ end;
+ else
+ s := s + token;
+ end;
+ inc(FCurrent);
+ end;
+end;
+
+procedure TsNumFormatParser.ScanDateTime;
+var
+ token: Char;
+ done: Boolean;
+ s: String;
+ i: Integer;
+ nf: TsNumberFormat;
+ partStr: String;
+ isTime: Boolean;
+ isAMPM: Boolean;
+begin
+ done := false;
+ s := '';
+ isTime := false;
+ isAMPM := false;
+
+ while (FCurrent <= FEnd) and (FStatus = psOK) and (not done) do begin
+ token := FCurrent^;
+ case token of
+ '\' : begin
+ inc(FCurrent);
+ token := FCurrent^;
+ s := s + token;
+ end;
+ 'Y', 'y' : begin
+ ScanDateTimeParts(token, token, s);
+ isTime := false;
+ end;
+ 'M', 'm' : if isTime then // help fpc to separate "month" and "minute"
+ ScanDateTimeParts(token, 'n', s)
+ else // both "month" and "minute" work in fpc to some degree
+ ScanDateTimeParts(token, token, s);
+ 'D', 'd' : begin
+ ScanDateTimeParts(token, token, s);
+ isTime := false;
+ end;
+ 'H', 'h' : begin
+ ScanDateTimeParts(token, token, s);
+ isTime := true;
+ end;
+ 'S', 's' : begin
+ ScanDateTimeParts(token, token, s);
+ isTime := true;
+ end;
+ '/', ':', '.', ']', '[', ' '
+ : s := s + token;
+ '0' : ScanDateTimeParts(token, 'z', s);
+ 'A', 'a' : begin
+ ScanAMPM(s);
+ isAMPM := true;
+ end;
+ else begin
+ done := true;
+ dec(FCurrent);
+ // char pointer must be at end of date/time mask.
+ end;
+ end;
+ if not done then inc(FCurrent);
+ end;
+
+ FSections[FCurrSection].FormatString := FSections[FCurrSection].FormatString + s;
+ s := FSections[FCurrSection].FormatString;
+
+ // Check format
+ try
+ if s <> '' then begin
+ FormatDateTime(s, now);
+ // !!!! MODIFY TO USE EXTENDED SYNTAX !!!!!
+
+ if s = FWorkbook.FormatSettings.LongDateFormat then
+ nf := nfLongDate
+ else
+ if s = FWorkbook.FormatSettings.ShortDateFormat then
+ nf := nfShortDate
+ else
+ if s = FWorkbook.FormatSettings.LongTimeFormat then
+ nf := nfLongTime
+ else
+ if s = FWorkbook.FormatSettings.ShortTimeFormat then
+ nf := nfShortTime
+ else
+ nf := nfFmtDateTime;
+ FSections[FCurrSection].NumFormat := nf;
+ end;
+
+ except
+ FStatus := psErrNoValidDateTimeFormat;
+ end;
+end;
+
+procedure TsNumFormatParser.ScanAMPM(var s: String);
+var
+ token: Char;
+begin
+ while (FCurrent <= FEnd) do begin
+ token := FCurrent^;
+ if token in ['A', 'a', 'P', 'p', 'm', 'M', '/'] then
+ s := s + token
+ else begin
+ dec(FCurrent);
+ exit;
+ end;
+ inc(FCurrent);
+ end;
+end;
+
+procedure TsNumFormatParser.ScanDateTimeParts(TestToken, Replacement: Char;
+ var s: String);
+var
+ token: Char;
+begin
+ s := s + Replacement;
+ while (FCurrent <= FEnd) do begin
+ inc(FCurrent);
+ token := FCurrent^;
+ if token = TestToken then
+ s := s + Replacement
+ else begin
+ dec(FCurrent);
+ break;
+ end;
+ end;
+end;
+
+procedure TsNumFormatParser.ScanFormat;
+var
+ token: Char;
+ done: Boolean;
+begin
+ done := false;
+ while (FCurrent <= FEnd) and (FStatus = psOK) and (not done) do begin
+ token := FCurrent^;
+ case token of
+ // Strip Excel's formatting symbols
+ '\', '*' : ;
+ '_' : inc(FCurrent);
+ '"' : begin
+ inc(FCurrent);
+ ScanText;
+ end;
+ '0', '#', '.', ',', '-': ScanNumber;
+ 'y', 'Y', 'm', 'M',
+ 'd', 'D', 'h', 's', '[': ScanDateTime;
+ ' ' : AddChar(token);
+ ';' : begin
+ done := true;
+ dec(FCurrent);
+ // Cursor must stay on the ";"
+ end;
+ end;
+ if not done then inc(FCurrent);
+ end;
+end;
+
+procedure TsNumFormatParser.ScanNumber;
+var
+ token: Char;
+ done: Boolean;
+ countdecs: Boolean;
+ s: String;
+ hasThSep: Boolean;
+ isExp: Boolean;
+ isSci: Boolean;
+ hasHash: Boolean;
+ hasPerc: Boolean;
+ nf: TsNumberFormat;
+begin
+ countdecs := false;
+ done := false;
+ hasThSep := false;
+ hasHash := false;
+ hasPerc := false;
+ isExp := false;
+ isSci := false;
+ s := '';
+ while (FCurrent <= FEnd) and (FStatus = psOK) and (not done) do begin
+ token := FCurrent^;
+ case token of
+ ',': begin
+ hasThSep := true;
+ s := s + token;
+ end;
+ '.': begin
+ countdecs := true;
+ FSections[FCurrSection].Decimals := 0;
+ s := s + token;
+ end;
+ '0': begin
+ if countdecs then inc(FSections[FCurrSection].Decimals);
+ s := s + token;
+ end;
+ 'E', 'e':
+ begin
+ if hasHash and countdecs then isSci := true else isExp := true;
+ countdecs := false;
+ s := s + token;
+ end;
+ '+', '-':
+ s := s + token;
+ '#': begin
+ hasHash := true;
+ countdecs := false;
+ s := s + token;
+ end;
+ '%': begin
+ hasPerc := true;
+ s := s + token;
+ end;
+ else begin
+ done := true;
+ dec(FCurrent);
+ end;
+ end;
+ if not done then
+ inc(FCurrent);
+ end;
+
+ if s <> '' then begin
+ if isExp then
+ nf := nfExp
+ else if isSci then
+ nf := nfSci
+ else if hasPerc then
+ nf := nfPercentage
+ else if hasThSep then
+ nf := nfFixedTh
+ else
+ nf := nfFixed;
+ end else
+ nf := nfGeneral;
+
+ FSections[FCurrSection].NumFormat := nf;
+ FSections[FCurrSection].FormatString := FSections[FCurrSection].FormatString + s;
+end;
+
+{ Scans a text in quotation marks. Tries to interpret the text as a currency
+ symbol (--> AnalyzeText) }
+procedure TsNumFormatParser.ScanText;
+var
+ token: Char;
+ done: Boolean;
+ s: String;
+begin
+ done := false;
+ s := '';
+ while (FCurrent <= FEnd) and (FStatus = psOK) and not done do begin
+ token := FCurrent^;
+ if token = '"' then begin
+ done := true;
+ AnalyzeText(s);
+ end else begin
+ s := s + token;
+ inc(FCurrent);
+ end;
+ end;
+ FSections[FCurrSection].FormatString := Format('%s"%s"',
+ [FSections[FCurrSection].FormatString, s]);
+end;
+
+end.
diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas
index b8965e385..05a4cec15 100755
--- a/components/fpspreadsheet/fpspreadsheet.pas
+++ b/components/fpspreadsheet/fpspreadsheet.pas
@@ -538,6 +538,7 @@ type
function GetItem(AIndex: Integer): TsNumFormatData;
procedure SetItem(AIndex: Integer; AValue: TsNumFormatData);
protected
+ FWorkbook: TsWorkbook;
FFirstFormatIndexInFile: Integer;
FNextFormatIndex: Integer;
procedure AddBuiltinFormats; virtual;
@@ -562,6 +563,7 @@ type
function FormatStringForWriting(AIndex: Integer): String; virtual;
procedure Sort;
+ property Workbook: TsWorkbook read FWorkbook;
property FirstFormatIndexInFile: Integer read FFirstFormatIndexInFile;
property Items[AIndex: Integer]: TsNumFormatData read GetItem write SetItem; default;
end;
@@ -2938,6 +2940,7 @@ begin
inherited Create;
FWorkbook := AWorkbook;
CreateNumFormatList;
+ FNumFormatList.FWorkbook := AWorkbook;
end;
destructor TsCustomSpreadReader.Destroy;
@@ -3008,6 +3011,7 @@ begin
inherited Create;
FWorkbook := AWorkbook;
CreateNumFormatList;
+ FNumFormatList.FWorkbook := AWorkbook;
end;
destructor TsCustomSpreadWriter.Destroy;
diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas
index 81685a55b..0728410b2 100644
--- a/components/fpspreadsheet/fpsutils.pas
+++ b/components/fpspreadsheet/fpsutils.pas
@@ -78,7 +78,9 @@ function SciFloat(AValue: Double; ADecimals: Byte): String;
//function TimeIntervalToString(AValue: TDateTime; AFormatStr: String): String;
procedure MakeTimeIntervalMask(Src: String; var Dest: String);
-function FormatDateTimeEx(const FormatStr: string; DateTime: TDateTime): string;
+function FormatDateTimeEx(const FormatStr: string; DateTime: TDateTime): String; overload;
+function FormatDateTimeEx(const FormatStr: string; DateTime: TDateTime;
+ AFormatSettings: TFormatSettings): string; overload;
implementation
@@ -1248,5 +1250,11 @@ begin
DateTimeToString(Result, FormatStr, DateTime, DefaultFormatSettings);
end;
+function FormatDateTimeEx(const FormatStr: string; DateTime: TDateTime;
+ AFormatSettings: TFormatSettings): string;
+begin
+ DateTimeToString(Result, FormatStr, DateTime, AFormatSettings);
+end;
+
end.
diff --git a/components/fpspreadsheet/laz_fpspreadsheet.lpk b/components/fpspreadsheet/laz_fpspreadsheet.lpk
index 879784266..28604f339 100644
--- a/components/fpspreadsheet/laz_fpspreadsheet.lpk
+++ b/components/fpspreadsheet/laz_fpspreadsheet.lpk
@@ -1,4 +1,4 @@
-
+
@@ -27,7 +27,7 @@
-
+
@@ -104,6 +104,10 @@
+
+
+
+
@@ -122,5 +126,8 @@
+
+ <_ExternHelp Items="Count"/>
+
diff --git a/components/fpspreadsheet/laz_fpspreadsheet.pas b/components/fpspreadsheet/laz_fpspreadsheet.pas
index 404773919..cc45ec599 100644
--- a/components/fpspreadsheet/laz_fpspreadsheet.pas
+++ b/components/fpspreadsheet/laz_fpspreadsheet.pas
@@ -8,12 +8,10 @@ interface
uses
fpolestorage, fpsallformats, fpsopendocument, fpspreadsheet, xlsbiff2,
- xlsbiff5, xlsbiff8, xlsxooxml, fpsutils,
- fpszipper,
- uvirtuallayer_types,
+ xlsbiff5, xlsbiff8, xlsxooxml, fpsutils, fpszipper, uvirtuallayer_types,
uvirtuallayer, uvirtuallayer_ole, uvirtuallayer_ole_helpers,
uvirtuallayer_ole_types, uvirtuallayer_stream, fpolebasic, xlscommon,
- wikitable, LazarusPackageIntf;
+ wikitable, fpsNumFormatParser, LazarusPackageIntf;
implementation
diff --git a/components/fpspreadsheet/tests/numformatparsertests.pas b/components/fpspreadsheet/tests/numformatparsertests.pas
new file mode 100644
index 000000000..2e611c0eb
--- /dev/null
+++ b/components/fpspreadsheet/tests/numformatparsertests.pas
@@ -0,0 +1,182 @@
+unit numformatparsertests;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ // Not using Lazarus package as the user may be working with multiple versions
+ // Instead, add .. to unit search path
+ Classes, SysUtils, fpcunit, testutils, testregistry,
+ fpsallformats, fpspreadsheet, fpsnumformatparser, xlsbiff8
+ {and a project requirement for lclbase for utf8 handling},
+ testsutility;
+
+type
+ TParserTestData = record
+ FormatString: String;
+ SollFormatString: String;
+ SollNumFormat: TsNumberFormat;
+ SollSectionCount: Integer;
+ SollDecimals: Byte;
+ SollCurrencySymbol: String;
+ end;
+
+var
+ ParserTestData: Array[0..5] of TParserTestData;
+
+procedure InitParserTestData;
+
+type
+ TSpreadNumFormatParserTests = class(TTestCase)
+ private
+ protected
+ // Set up expected values:
+ procedure SetUp; override;
+ procedure TearDown; override;
+ // Reads numbers values from spreadsheet and checks against list
+ // One cell per test so some tests can fail and those further below may still work
+ published
+ procedure TestNumFormatParser;
+ end;
+
+
+implementation
+
+uses
+ TypInfo;
+
+procedure InitParserTestData;
+begin
+ // Tests with 1 format section only
+ with ParserTestData[0] do begin
+ FormatString := '0';
+ SollFormatString := '0';
+ SollNumFormat := nfFixed;
+ SollSectionCount := 1;
+ SollDecimals := 0;
+ SollCurrencySymbol := '';
+ end;
+ with ParserTestData[1] do begin
+ FormatString := '0.000';
+ SollFormatString := '0.000';
+ SollNumFormat := nfFixed;
+ SollSectionCount := 1;
+ SollDecimals := 3;
+ SollCurrencySymbol := '';
+ end;
+ with ParserTestData[2] do begin
+ FormatString := '#,##0.000';
+ SollFormatString := '#,##0.000';
+ SollNumFormat := nfFixedTh;
+ SollSectionCount := 1;
+ SollDecimals := 3;
+ SollCurrencySymbol := '';
+ end;
+ with ParserTestData[3] do begin
+ FormatString := '0.000%';
+ SollFormatString := '0.000%';
+ SollNumFormat := nfPercentage;
+ SollSectionCount := 1;
+ SollDecimals := 3;
+ SollCurrencySymbol := '';
+ end;
+ with ParserTestData[4] do begin
+ FormatString := 'hh:mm:ss';
+ SollFormatString := 'hh:nn:ss';
+ SollNumFormat := nfLongTime;
+ SollSectionCount := 1;
+ SollDecimals := 0;
+ SollCurrencySymbol := '';
+ end;
+ with ParserTestData[5] do begin
+ FormatString := 'hh:mm:ss AM/PM';
+ SollFormatString := 'hh:nn:ss AM/PM';
+ SollNumFormat := nfLongTimeAM;
+ SollSectionCount := 1;
+ SollDecimals := 0;
+ SollCurrencySymbol := '';
+ end;
+ {
+ with ParserTestData[4] do begin
+ FormatString := '#,##0.00 "$";-#,##0.00 "$";0.00 "$"';
+ SollFormatString := '#,##0.00 "$";-#,##0.00 "$";0.00 "$"';
+ SollNumFormat := nfCurrency;
+ SollSectionCount := 3;
+ SollDecimals := 2;
+ SollCurrencySymbol := '$';
+ end;
+ with ParserTestData[5] do begin
+ FormatString := '#,##0.00 "$";-#,##0.00 "$";-';
+ SollFormatString := '#,##0.00 "$";-#,##0.00 "$";-';
+ SollNumFormat := nfCurrencyDash;
+ SollSectionCount := 3;
+ SollDecimals := 2;
+ SollCurrencySymbol := '$';
+ end; }
+
+ {
+ // This case will report a mismatching FormatString because of the [RED] --> ignore
+ with ParserTestData[6] do begin
+ FormatString := '#,##0.00 "$";[RED]-#,##0.00 "$";-';
+ SollFormatString := '#,##0.00 "$";-#,##0.00 "$";-';
+ SollNumFormat := nfCurrencyDashRed;
+ SollSectionCount := 3;
+ SollDecimals := 2;
+ SollCurrencySymbol := '$';
+ end;
+ }
+end;
+
+{ TSpreadNumFormatParserTests }
+
+procedure TSpreadNumFormatParserTests.SetUp;
+begin
+ inherited SetUp;
+ InitParserTestData;
+end;
+
+procedure TSpreadNumFormatParserTests.TearDown;
+begin
+ inherited TearDown;
+end;
+
+procedure TSpreadNumFormatParserTests.TestNumFormatParser;
+var
+ i: Integer;
+ parser: TsNumFormatParser;
+ MyWorkbook: TsWorkbook;
+begin
+ MyWorkbook := TsWorkbook.Create; // needed to provide the FormatSettings for the parser
+ try
+ for i:=0 to 6 do begin
+ parser := TsNumFormatParser.Create(MyWorkbook, ParserTestData[i].FormatString);
+ try
+ CheckEquals(ParserTestData[i].SollFormatString, parser.FormatString,
+ 'Test format string ' + ParserTestData[i].FormatString + ' construction mismatch');
+ CheckEquals(ord(ParserTestData[i].SollNumFormat), ord(parser.ParsedSections[0].NumFormat),
+ 'Test format (' + GetEnumName(TypeInfo(TsNumberFormat), integer(ParserTestData[i].SollNumFormat)) +
+ ') detection mismatch');
+ CheckEquals(ParserTestData[i].SollDecimals, parser.ParsedSections[0].Decimals,
+ 'Test format (' + ParserTestData[i].FormatString + ') decimal detection mismatch');
+ CheckEquals(ParserTestData[i].SollCurrencySymbol, parser.ParsedSections[0].CurrencySymbol,
+ 'Test format (' + ParserTestData[i].FormatString + ') currency symbol detection mismatch');
+ CheckEquals(ParserTestData[i].SollSectionCount, parser.ParsedSectionCount,
+ 'Test format (' + ParserTestData[i].FormatString + ') section count mismatch');
+ finally
+ parser.Free;
+ end;
+ end;
+ finally
+ MyWorkbook.Free;
+ end;
+end;
+
+initialization
+ // Register so these tests are included in a full run
+ RegisterTest(TSpreadNumFormatParserTests);
+ InitParserTestData; //useful to have norm data if other code want to use this unit
+end.
+
+end.
+
diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpi b/components/fpspreadsheet/tests/spreadtestgui.lpi
index ddd31284d..f3f990a08 100644
--- a/components/fpspreadsheet/tests/spreadtestgui.lpi
+++ b/components/fpspreadsheet/tests/spreadtestgui.lpi
@@ -78,7 +78,7 @@
-
+
@@ -134,6 +134,11 @@
+
+
+
+
+
diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpr b/components/fpspreadsheet/tests/spreadtestgui.lpr
index 4d09ec536..ae6ee071e 100644
--- a/components/fpspreadsheet/tests/spreadtestgui.lpr
+++ b/components/fpspreadsheet/tests/spreadtestgui.lpr
@@ -5,7 +5,7 @@ program spreadtestgui;
uses
Interfaces, Forms, GuiTestRunner, datetests, stringtests, numberstests,
manualtests, testsutility, internaltests, formattests, colortests, fonttests,
- optiontests;
+ optiontests, numformatparsertests;
begin
Application.Initialize;
diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas
index b1f7d4bc9..867512616 100644
--- a/components/fpspreadsheet/xlscommon.pas
+++ b/components/fpspreadsheet/xlscommon.pas
@@ -480,7 +480,7 @@ type
implementation
uses
- StrUtils;
+ StrUtils, fpsNumFormatParser;
function ConvertExcelDateTimeToDateTime(
const AExcelDateNum: Double; ADateMode: TDateMode): TDateTime;
@@ -533,21 +533,6 @@ begin
end;
-{ TsBIFFNumFormatParser } (*
-
-constructor TsBIFFNumFormatParser.Create(AFormatString: String);
-begin
- inherited;
- FFormatString := AFormatString;
- Parse;
-end;
-
-procedure TsBIFFNumFormatParser.Parse;
-begin
- //
-end;
- *)
-
{ TsBIFFNumFormatList }
{ These are the built-in number formats as used by fpc. Before writing to file
@@ -608,12 +593,29 @@ procedure TsBIFFNumFormatList.Analyze(AFormatIndex: Integer;
var AFormatString: String; var ANumFormat: TsNumberFormat;
var ADecimals: Byte; var ACurrencySymbol: String);
var
+ parser: TsNumFormatParser;
fmt: String;
begin
+
+ {
+ AFormatString := 'hh:mm AM/PM'; //"€" #,##.0;[red]"$" -#,##.000;-';
+
+
+ parser := TsNumFormatParser.Create(Workbook, AFormatString);
+ try
+ fmt := parser.FormatString;
+ ANumFormat := parser.ParsedSections[0].NumFormat;
+ ADecimals := parser.ParsedSections[0].Decimals;
+ ACurrencySymbol := parser.ParsedSections[0].CurrencySymbol;
+ finally
+ parser.Free;
+ end;
+ }
+
fmt := Lowercase(AFormatString);
{ Check the built-in formats first:
The prefix "[$-F400]" before the formatting string means that the system's
- long Time format string is used. }
+ long time format string is used. }
if (pos('[$-F400]', AFormatString) = 1) then begin
ANumFormat := nfLongTime;
AFormatString := ''; // will be replaced by system's format setting