pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Integrate number format parser into fpspreadsheet. Some regressions in format detection...

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3068 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-05-20 16:13:48 +00:00
parent 7c3d710fbe
commit 00ed56d1ef
10 changed files with 574 additions and 264 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
components/fpspreadsheet/examples/excel8demo/excel8write.lpr
View File

@ -29,7 +29,8 @@ var
number: Double;
lCell: PCell;
lCol: TCol;
i, r: Integer;
i: Integer;
r: Integer = 10;
begin
MyDir := ExtractFilePath(ParamStr(0));
@ -53,7 +54,7 @@ begin
}
// Write some cells
// MyWorksheet.WriteNumber(0, 0, 1.0);// A1
MyWorksheet.WriteDateTime(0, 20, now, nfShortTime); //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
@ -206,10 +207,6 @@ begin
inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfFmtDateTime, mm:ss.zzz');
MyWorksheet.WriteDateTime(r, 1, now, nfFmtDateTime, 'mm:ss.zzz');
// NOTE: The upper option "MSZ" = "mm:ss.z" should result only in 1 decimal.
// This is true for writing, but in reading always 3 decimals are displayed.
// This is due to fpc's SysUtile.FormatDateTime which does not distinguish
// both cases.
// Write formatted numbers
number := 12345.67890123456789;
@ -252,7 +249,6 @@ begin
MyWorksheet.WriteUTF8Text(r, 0, 'nfFixedTh, 3 decs');
MyWorksheet.WriteNumber(r, 1, number, nfFixedTh, 3);
MyWorksheet.WriteNumber(r, 2, -number, nfFixedTh, 3);
inc(r,2);
MyWorksheet.WriteUTF8Text(r, 0, 'nfSci, 1 dec');
MyWorksheet.WriteNumber(r, 1, number, nfSci, 1);

91
components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpi
View File

@ -137,8 +137,7 @@
<Unit2>
<Filename Value="..\..\fpspreadsheet.pas"/>
<UnitName Value="fpspreadsheet"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="6"/>
<EditorIndex Value="5"/>
<WindowIndex Value="0"/>
<TopLine Value="132"/>
<CursorPos X="16" Y="164"/>
@ -148,7 +147,7 @@
<Unit3>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<UnitName Value="fpspreadsheetgrid"/>
<EditorIndex Value="8"/>
<EditorIndex Value="6"/>
<WindowIndex Value="0"/>
<TopLine Value="636"/>
<CursorPos X="20" Y="647"/>
@ -286,10 +285,11 @@
<Unit20>
<Filename Value="..\..\xlscommon.pas"/>
<UnitName Value="xlscommon"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="4"/>
<WindowIndex Value="0"/>
<TopLine Value="1181"/>
<CursorPos X="31" Y="1194"/>
<TopLine Value="650"/>
<CursorPos X="16" Y="662"/>
<UsageCount Value="88"/>
<Bookmarks Count="1">
<Item0 X="41" Y="1209" ID="1"/>
@ -577,143 +577,139 @@
</Unit57>
<Unit58>
<Filename Value="d:\lazarus-svn\fpc\2.6.2\source\rtl\objpas\sysutils\dati.inc"/>
<EditorIndex Value="5"/>
<WindowIndex Value="0"/>
<TopLine Value="890"/>
<CursorPos X="16" Y="796"/>
<UsageCount Value="15"/>
<Loaded Value="True"/>
</Unit58>
<Unit59>
<Filename Value="d:\lazarus-svn\fpc\2.6.2\source\rtl\objpas\sysutils\sysinth.inc"/>
<EditorIndex Value="7"/>
<WindowIndex Value="0"/>
<TopLine Value="36"/>
<CursorPos X="5" Y="43"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
</Unit59>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
<Caret Line="164" Column="60" TopLine="132"/>
</Position1>
<Position2>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="164" Column="60" TopLine="132"/>
<Caret Line="1511" Column="15" TopLine="1478"/>
</Position2>
<Position3>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1511" Column="15" TopLine="1478"/>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1170" Column="36" TopLine="1170"/>
</Position3>
<Position4>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1170" Column="36" TopLine="1170"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position4>
<Position5>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
<Caret Line="940" Column="14" TopLine="908"/>
</Position5>
<Position6>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="940" Column="14" TopLine="908"/>
<Caret Line="960" Column="14" TopLine="928"/>
</Position6>
<Position7>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="960" Column="14" TopLine="928"/>
<Caret Line="1013" Column="14" TopLine="982"/>
</Position7>
<Position8>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1013" Column="14" TopLine="982"/>
<Caret Line="1059" Column="14" TopLine="1027"/>
</Position8>
<Position9>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1059" Column="14" TopLine="1027"/>
<Caret Line="1081" Column="41" TopLine="1049"/>
</Position9>
<Position10>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1081" Column="41" TopLine="1049"/>
<Caret Line="1089" Column="43" TopLine="1057"/>
</Position10>
<Position11>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1089" Column="43" TopLine="1057"/>
<Caret Line="1093" Column="14" TopLine="1061"/>
</Position11>
<Position12>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1093" Column="14" TopLine="1061"/>
<Caret Line="1157" Column="14" TopLine="1126"/>
</Position12>
<Position13>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1157" Column="14" TopLine="1126"/>
<Caret Line="1197" Column="20" TopLine="1177"/>
</Position13>
<Position14>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1197" Column="20" TopLine="1177"/>
<Caret Line="403" Column="16" TopLine="397"/>
</Position14>
<Position15>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="403" Column="16" TopLine="397"/>
<Caret Line="924" Column="14" TopLine="893"/>
</Position15>
<Position16>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="924" Column="14" TopLine="893"/>
<Caret Line="413" Column="19" TopLine="402"/>
</Position16>
<Position17>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="413" Column="19" TopLine="402"/>
<Caret Line="414" Column="33" TopLine="388"/>
</Position17>
<Position18>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="414" Column="33" TopLine="388"/>
<Caret Line="854" Column="39" TopLine="825"/>
</Position18>
<Position19>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="854" Column="39" TopLine="825"/>
<Caret Line="672" Column="1" TopLine="648"/>
</Position19>
<Position20>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="672" Column="1" TopLine="648"/>
<Caret Line="870" Column="1" TopLine="832"/>
</Position20>
<Position21>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="870" Column="1" TopLine="832"/>
<Caret Line="867" Column="24" TopLine="848"/>
</Position21>
<Position22>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="867" Column="24" TopLine="848"/>
<Caret Line="926" Column="34" TopLine="907"/>
</Position22>
<Position23>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="926" Column="34" TopLine="907"/>
<Caret Line="956" Column="1" TopLine="937"/>
</Position23>
<Position24>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="956" Column="1" TopLine="937"/>
<Caret Line="1024" Column="63" TopLine="1006"/>
</Position24>
<Position25>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1024" Column="63" TopLine="1006"/>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1478" Column="48" TopLine="1478"/>
</Position25>
<Position26>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1478" Column="48" TopLine="1478"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position26>
<Position27>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1058" Column="9" TopLine="1039"/>
</Position27>
<Position28>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1058" Column="9" TopLine="1039"/>
<Caret Line="1055" Column="44" TopLine="1039"/>
</Position28>
<Position29>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1055" Column="44" TopLine="1039"/>
<Caret Line="1135" Column="22" TopLine="1120"/>
</Position29>
<Position30>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1135" Column="22" TopLine="1120"/>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="164" Column="16" TopLine="132"/>
</Position30>
</JumpHistory>
</ProjectOptions>
@ -743,15 +739,6 @@
</Other>
</CompilerOptions>
<Debugging>
<BreakPoints Count="1">
<Item1>
<Kind Value="bpkSource"/>
<WatchScope Value="wpsLocal"/>
<WatchKind Value="wpkWrite"/>
<Source Value="..\..\xlscommon.pas"/>
<Line Value="664"/>
</Item1>
</BreakPoints>
<Watches Count="2">
<Item1>
<Expression Value="recordtype"/>

325
components/fpspreadsheet/fpsnumformatparser.pas
View File

@ -27,6 +27,8 @@ type
coEqual, coNotEqual, coLess, coGreater, coLessEqual, coGreaterEqual
);
TsConversionDirection = (cdToFPSpreadsheet, cdFromFPSpreadsheet);
TsNumFormatSection = record
FormatString: String;
CompareOperation: TsCompareOperation;
@ -38,17 +40,23 @@ type
NumFormat: TsNumberFormat;
end;
TsNumFormatSections = array of TsNumFormatSection;
TsNumFormatParser = class
private
FCreateMethod: Byte;
FWorkbook: TsWorkbook;
FCurrent: PChar;
FStart: PChar;
FEnd: PChar;
FCurrSection: Integer;
FSections: array of TsNumFormatSection;
FSections: TsNumFormatSections;
FFormatSettings: TFormatSettings;
FFormatString: String;
FNumFormat: TsNumberFormat;
FConversionDirection: TsConversionDirection;
FStatus: Integer;
function GetFormatString: String;
function GetParsedSectionCount: Integer;
function GetParsedSections(AIndex: Integer): TsNumFormatSection;
@ -58,6 +66,8 @@ type
procedure AnalyzeBracket(const AValue: String);
procedure AnalyzeText(const AValue: String);
procedure CheckSections;
function CreateFormatStringFromSection(ASection: Integer): String; virtual;
function CreateFormatStringFromSections: String;
procedure Parse(const AFormatString: String);
procedure ScanAMPM(var s: String);
procedure ScanBrackets;
@ -68,9 +78,16 @@ type
procedure ScanText;
public
constructor Create(AWorkbook: TsWorkbook; const AFormatString: String);
constructor Create(AWorkbook: TsWorkbook; const AFormatString: String;
AConversionDirection: TsConversionDirection = cdToFPSpreadsheet); overload;
constructor Create(AWorkbook: TsWorkbook; const AFormatSections: TsNumFormatSections;
AConversionDirection: TsConversionDirection = cdFromFPSpreadsheet); overload;
destructor Destroy; override;
property FormatString: String read FFormatString;
procedure CopySections(const FromSections: TsNumFormatSections;
var ToSections: TsNumFormatSections);
procedure CopySectionsTo(var ADestination: TsNumFormatSections);
property Builtin_NumFormat: TsNumberFormat read FNumFormat;
property FormatString: String read GetFormatString;
property ParsedSectionCount: Integer read GetParsedSectionCount;
property ParsedSections[AIndex: Integer]: TsNumFormatSection read GetParsedSections;
property Status: Integer read FStatus;
@ -88,10 +105,15 @@ const
{ TsNumFormatParser }
{ Creates a number format parser for analyzing a formatstring that has been read
from a spreadsheet file. The conversion, by default, will go FROM the file TO
the fpspreadsheet procedures. }
constructor TsNumFormatParser.Create(AWorkbook: TsWorkbook;
const AFormatString: String);
const AFormatString: String; AConversionDirection: TsConversionDirection = cdToFPSpreadsheet);
begin
inherited Create;
FCreateMethod := 0;
FConversionDirection := AConversionDirection;
FWorkbook := AWorkbook;
FFormatSettings := DefaultFormatSettings;
FFormatSettings.DecimalSeparator := '.';
@ -99,6 +121,22 @@ begin
Parse(AFormatString);
end;
{ Creates a number format parser to create a format string from the individual
format sections given in "AFormatSections". It is assumed by default that the
format string will be written to file. Therefore, it can contain features of
the destination file format and, in general, will not work if called by
fpspreadsheet. }
constructor TsNumFormatParser.Create(AWorkbook: TsWorkbook;
const AFormatSections: TsNumFormatSections;
AConversionDirection: TsConversionDirection = cdFromFPSpreadsheet);
begin
inherited Create;
FCreateMethod := 1;
FConversionDirection := AConversionDirection;
FWorkbook := AWorkbook;
CopySections(AFormatSections, FSections);
end;
destructor TsNumFormatParser.Destroy;
begin
FSections := nil;
@ -119,7 +157,7 @@ begin
FormatString := '';
CompareOperation := coNotUsed;
CompareValue := 0.0;
Color := scBlack;
Color := scNotDefined;
CountryCode := '';
CurrencySymbol := '';
Decimals := 0;
@ -221,6 +259,7 @@ begin
exit;
end;
// Check format strings
case FSections[i].NumFormat of
nfGeneral, nfFixed, nfFixedTh, nfPercentage, nfExp, nfSci, nfCurrency:
try
@ -241,6 +280,29 @@ begin
end;
end;
// Extract built-in NumFormat identifier for currency (needs several entries in
// three sections).
if (ns = 3) and
(FSections[0].NumFormat = nfCurrency) and
(FSections[1].NumFormat = nfCurrency) and
(FSections[2].NumFormat = nfCurrency)
then begin
if ((FSections[2].FormatString = '-') or (FSections[2].FormatString = '"-"')) then begin
if (FSections[1].Color = scRed) then
FNumFormat := nfCurrencyDashRed
else
FNumFormat := nfCurrencyDash;
end else begin
if (FSections[1].Color = scRed) then
FNumFormat := nfCurrencyRed;
end;
end else
// If there are other multi-section formatstrings they must be a custom format
if (ns > 1) then
FNumFormat := nfCustom
else
FNumFormat := FSections[0].NumFormat;
if ns = 2 then
FFormatString := Format('%s;%s;%s', [
FSections[0].FormatString,
@ -256,33 +318,79 @@ begin
FStatus := psErrNoUsableFormat;
end;
{
function TsNumFormatParser.GetNumFormat: TsNumberFormat;
procedure TsNumFormatParser.CopySections(
const FromSections: TsNumFormatSections; var ToSections: TsNumformatSections);
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;
SetLength(ToSections, Length(FromSections));
for i:= 0 to High(FromSections) do begin
ToSections[i].FormatString := FromSections[i].FormatString;
ToSections[i].CompareOperation := FromSections[i].CompareOperation;
ToSections[i].CompareValue := FromSections[i].CompareValue;
ToSections[i].Color := FromSections[i].Color;
ToSections[i].CurrencySymbol := FromSections[i].CurrencySymbol;
ToSections[i].Decimals := FromSections[i].Decimals;
ToSections[i].NumFormat := FromSections[i].NumFormat;
end;
end;
procedure TsNumFormatParser.CopySectionsTo(var ADestination: TsNumFormatSections);
begin
CopySections(FSections, ADestination);
end;
function TsNumFormatParser.CreateFormatStringFromSections: String;
var
i: Integer;
begin
if Length(FSections) = 0 then
Result := ''
else begin
Result := CreateFormatStringFromSection(0);
for i:=1 to High(FSections) do
Result := Result + ';' + CreateFormatStringFromSection(i);
end;
end;
function TsNumFormatParser.CreateFormatStringFromSection(ASection: Integer): String;
begin
with FSections[ASection] do
if (NumFormat = nfFmtDateTime) or (NumFormat = nfCustom) then begin
Result := FormatString;
exit;
end;
Result := BuildNumberFormatString(FSections[ASection].NumFormat,
FWorkbook.FormatSettings,
FSections[ASection].Decimals,
FSections[ASection].CurrencySymbol
);
if FConversionDirection = cdFromFPSpreadsheet then begin
// This is typical of Excel, but is valid for all others as well.
// Override if you need to change
if FSections[ASection].Color < 8 then
Result := Format('[%s]%s', [FWorkbook.GetColorName(FSections[ASection].Color), Result])
else
if FSections[ASection].Color < scNotDefined then
Result := Format('[Color%d]%s', [FSections[ASection].Color, Result]);
if FSections[ASection].CompareOperation <> coNotUsed then
Result := Format('[%s%g]%s', [
COMPARE_STR[FSections[ASection].CompareOperation],
FSections[ASection].CompareValue,
Result
]);
end;
end;
function TsNumFormatParser.GetFormatString: String;
begin
case FCreateMethod of
0: Result := FFormatString;
1: Result := CreateFormatStringFromSections;
end;
end;
}
function TsNumFormatParser.GetParsedSectionCount: Integer;
begin
@ -355,74 +463,77 @@ begin
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;
'\':
begin
inc(FCurrent);
token := FCurrent^;
s := s + token;
end;
'Y', 'y':
begin
ScanDateTimeParts(token, token, s);
isTime := false;
end;
'M', 'm':
ScanDateTimeParts(token, token, s);
{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);}
'N', 'n':
ScanDateTimeParts(token, 'n', s); // fpc dialect for "minutes"
'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', 'z', 'Z':
ScanDateTimeParts(token, token, 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;
if s <> '' then begin
if s = FWorkbook.FormatSettings.LongDateFormat then
nf := nfLongDate
else
if s = FWorkbook.FormatSettings.ShortDateFormat then
nf := nfShortDate
else
if s = StripAMPM(FWorkbook.FormatSettings.LongTimeFormat) then
nf := IfThen(isAMPM, nfLongTimeAM, nfLongTime)
else
if s = StripAMPM(FWorkbook.FormatSettings.ShortTimeFormat) then
nf := IfThen(isAMPM, nfShortTimeAM, nfShortTime)
else
nf := nfFmtDateTime;
// 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;
FSections[FCurrSection].NumFormat := nf;
end;
end;
@ -470,21 +581,27 @@ 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;
'\', '*':
;
'_':
inc(FCurrent);
'"':
begin
inc(FCurrent);
ScanText;
end;
'0', '#', '.', ',', '-':
ScanNumber;
'y', 'Y', 'm', 'M', 'd', 'D', 'h', 'N', 'n', 's', '[':
ScanDateTime;
' ':
AddChar(token);
';':
begin
done := true;
dec(FCurrent);
// Cursor must stay on the ";"
end;
end;
if not done then inc(FCurrent);
end;

4
components/fpspreadsheet/fpsopendocument.pas
View File

@ -184,7 +184,7 @@ end;
procedure TsSpreadOpenDocReader.CreateNumFormatList;
begin
FreeAndNil(FNumFormatList);
FNumFormatList := TsSpreadOpenDocNumFormatList.Create;
FNumFormatList := TsSpreadOpenDocNumFormatList.Create(Workbook);
end;
function TsSpreadOpenDocReader.GetAttrValue(ANode : TDOMNode; AAttrName : string) : string;
@ -471,7 +471,7 @@ end;
procedure TsSpreadOpenDocWriter.CreateNumFormatList;
begin
FreeAndNil(FNumFormatList);
FNumFormatList := TsSpreadOpenDocNumFormatList.Create;
FNumFormatList := TsSpreadOpenDocNumFormatList.Create(Workbook);
end;
procedure TsSpreadOpenDocWriter.WriteMimetype;

204
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -362,16 +362,21 @@ type
FOnChangeCell: TsCellEvent;
FOnChangeFont: TsCellEvent;
procedure RemoveCallback(data, arg: pointer);
protected
procedure ChangedCell(ARow, ACol: Cardinal);
procedure ChangedFont(ARow, ACol: Cardinal);
public
Name: string;
{ Base methods }
constructor Create;
destructor Destroy; override;
{ Utils }
class function CellPosToText(ARow, ACol: Cardinal): string;
{ Data manipulation methods - For Cells }
procedure CopyCell(AFromRow, AFromCol, AToRow, AToCol: Cardinal; AFromWorksheet: TsWorksheet);
procedure CopyFormat(AFormat: PCell; AToRow, AToCol: Cardinal);
@ -390,35 +395,25 @@ type
function ReadUsedFormatting(ARow, ACol: Cardinal): TsUsedFormattingFields;
function ReadBackgroundColor(ARow, ACol: Cardinal): TsColor;
procedure RemoveAllCells;
{ Writing of values }
procedure WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring);
procedure WriteBlank(ARow, ACol: Cardinal);
procedure WriteBoolValue(ARow, ACol: Cardinal; AValue: Boolean);
procedure WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime;
AFormat: TsNumberFormat = nfShortDateTime; AFormatStr: String = '');
procedure WriteErrorValue(ARow, ACol: Cardinal; AValue: TErrorValue);
procedure WriteFormula(ARow, ACol: Cardinal; AFormula: TsFormula);
procedure WriteNumber(ARow, ACol: Cardinal; ANumber: double;
AFormat: TsNumberFormat = nfGeneral; ADecimals: Byte = 2;
ACurrencySymbol: String = ''); overload;
procedure WriteNumber(ARow, ACol: Cardinal; ANumber: double;
AFormatString: String); overload;
procedure WriteBlank(ARow, ACol: Cardinal);
procedure WriteBoolValue(ARow, ACol: Cardinal; AValue: Boolean);
procedure WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime;
AFormat: TsNumberFormat = nfShortDateTime; AFormatStr: String = '');
procedure WriteDecimals(ARow, ACol: Cardinal; ADecimals: byte); overload;
procedure WriteDecimals(ACell: PCell; ADecimals: Byte); overload;
procedure WriteErrorValue(ARow, ACol: Cardinal; AValue: TErrorValue);
procedure WriteFormula(ARow, ACol: Cardinal; AFormula: TsFormula);
procedure WriteRPNFormula(ARow, ACol: Cardinal; AFormula: TsRPNFormula);
procedure WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring);
{ Writing of cell attributes }
procedure WriteNumberFormat(ARow, ACol: Cardinal; ANumberFormat: TsNumberFormat;
const AFormatString: String = '');
function WriteFont(ARow, ACol: Cardinal; const AFontName: String;
AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor): Integer; overload;
procedure WriteFont(ARow, ACol: Cardinal; AFontIndex: Integer); overload;
function WriteFontColor(ARow, ACol: Cardinal; AFontColor: TsColor): Integer;
function WriteFontName(ARow, ACol: Cardinal; AFontName: String): Integer;
function WriteFontSize(ARow, ACol: Cardinal; ASize: Single): Integer;
function WriteFontStyle(ARow, ACol: Cardinal; AStyle: TsFontStyles): Integer;
procedure WriteTextRotation(ARow, ACol: Cardinal; ARotation: TsTextRotation);
procedure WriteUsedFormatting(ARow, ACol: Cardinal; AUsedFormatting: TsUsedFormattingFields);
procedure WriteBackgroundColor(ARow, ACol: Cardinal; AColor: TsColor);
procedure WriteBorderColor(ARow, ACol: Cardinal; ABorder: TsCellBorder; AColor: TsColor);
procedure WriteBorderLineStyle(ARow, ACol: Cardinal; ABorder: TsCellBorder;
ALineStyle: TsLineStyle);
@ -428,9 +423,31 @@ type
procedure WriteBorderStyle(ARow, ACol: Cardinal; ABorder: TsCellBorder;
ALineStyle: TsLineStyle; AColor: TsColor); overload;
procedure WriteBorderStyles(ARow, ACol: Cardinal; const AStyles: TsCellBorderStyles);
procedure WriteDecimals(ARow, ACol: Cardinal; ADecimals: byte); overload;
procedure WriteDecimals(ACell: PCell; ADecimals: Byte); overload;
function WriteFont(ARow, ACol: Cardinal; const AFontName: String;
AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor): Integer; overload;
procedure WriteFont(ARow, ACol: Cardinal; AFontIndex: Integer); overload;
function WriteFontColor(ARow, ACol: Cardinal; AFontColor: TsColor): Integer;
function WriteFontName(ARow, ACol: Cardinal; AFontName: String): Integer;
function WriteFontSize(ARow, ACol: Cardinal; ASize: Single): Integer;
function WriteFontStyle(ARow, ACol: Cardinal; AStyle: TsFontStyles): Integer;
procedure WriteHorAlignment(ARow, ACol: Cardinal; AValue: TsHorAlignment);
procedure WriteNumberFormat(ARow, ACol: Cardinal; ANumberFormat: TsNumberFormat;
const AFormatString: String = '');
procedure WriteTextRotation(ARow, ACol: Cardinal; ARotation: TsTextRotation);
procedure WriteUsedFormatting(ARow, ACol: Cardinal; AUsedFormatting: TsUsedFormattingFields);
procedure WriteVertAlignment(ARow, ACol: Cardinal; AValue: TsVertAlignment);
procedure WriteWordwrap(ARow, ACol: Cardinal; AValue: boolean);
{ Data manipulation methods - For Rows and Cols }
function FindRow(ARow: Cardinal): PRow;
function FindCol(ACol: Cardinal): PCol;
@ -442,11 +459,13 @@ type
procedure WriteRowHeight(ARow: Cardinal; AHeight: Single);
procedure WriteColInfo(ACol: Cardinal; AData: TCol);
procedure WriteColWidth(ACol: Cardinal; AWidth: Single);
{ Properties }
property Cells: TAVLTree read FCells;
property Cols: TIndexedAVLTree read FCols;
property Rows: TIndexedAVLTree read FRows;
property Workbook: TsWorkbook read FWorkbook;
// These are properties to interface to fpspreadsheetgrid.
property Options: TsSheetOptions read FOptions write FOptions;
property LeftPaneWidth: Integer read FLeftPaneWidth write FLeftPaneWidth;
@ -547,7 +566,7 @@ type
var ACurrencySymbol: String); virtual;
procedure RemoveFormat(AIndex: Integer);
public
constructor Create;
constructor Create(AWorkbook: TsWorkbook);
destructor Destroy; override;
function AddFormat(AFormatCell: PCell): Integer; overload;
function AddFormat(AFormatIndex: Integer; ANumFormat: TsNumberFormat;
@ -718,7 +737,7 @@ procedure MakeLEPalette(APalette: PsPalette; APaletteSize: Integer);
implementation
uses
Math, StrUtils, fpsutils;
Math, StrUtils, fpsUtils, fpsNumFormatParser;
{ Translatable strings }
resourcestring
@ -727,6 +746,9 @@ resourcestring
lpNoValidSpreadsheetFile = '"%s" is not a valid spreadsheet file';
lpUnknownSpreadsheetFormat = 'unknown format';
lpInvalidFontIndex = 'Invalid font index';
lpInvalidNumberFormat = 'Trying to use an incompatible number format.';
lpNoValidNumberFormatString = 'No valid number format string.';
lpNoValidDateTimeFormatString = 'No valid date/time format string.';
lpTRUE = 'TRUE';
lpFALSE = 'FALSE';
lpErrEmptyIntersection = '#NULL!';
@ -1407,14 +1429,19 @@ begin
ACell^.ContentType := cctNumber;
ACell^.NumberValue := ANumber;
ACell^.Decimals := ADecimals;
if IsDateTimeFormat(AFormat) then
raise Exception.Create(lpInvalidNumberFormat);
if AFormat <> nfGeneral then begin
Include(ACell^.UsedFormattingFields, uffNumberFormat);
ACell^.NumberFormat := AFormat;
ACell^.Decimals := ADecimals;
ACell^.CurrencySymbol := ACurrencySymbol;
ACell^.NumberFormatStr := BuildNumFormatString(ACell^.NumberFormat,
ACell^.NumberFormatStr := BuildNumberFormatString(ACell^.NumberFormat,
Workbook.FormatSettings, ADecimals, ACurrencySymbol);
end;
ChangedCell(ARow, ACol);
end;
@ -1427,13 +1454,32 @@ procedure TsWorksheet.WriteNumber(ARow, ACol: Cardinal; ANumber: Double;
AFormatString: String);
var
ACell: PCell;
parser: TsNumFormatParser;
nf: TsNumberFormat;
begin
parser := TsNumFormatParser.Create(Workbook, AFormatString, cdToFPSpreadsheet);
try
// Format string ok?
if parser.Status <> psOK then
raise Exception.Create(lpNoValidNumberFormatString);
if IsDateTimeFormat(parser.Builtin_NumFormat)
then raise Exception.Create(lpInvalidNumberFormat);
// If format string matches a built-in format use its format identifier,
// All this is considered when calling Builtin_NumFormat of the parser.
nf := parser.Builtin_NumFormat;
finally
parser.Free;
end;
ACell := GetCell(ARow, ACol);
Include(ACell^.UsedFormattingFields, uffNumberFormat);
ACell^.ContentType := cctNumber;
ACell^.NumberValue := ANumber;
ACell^.NumberFormat := nfCustom;
ACell^.NumberFormat := nf;
ACell^.NumberFormatStr := AFormatString;
ACell^.Decimals := 0;
ACell^.CurrencySymbol := '';
ChangedCell(ARow, ACol);
end;
@ -1482,6 +1528,7 @@ end;
Must follow the rules for "FormatDateTime", or use
"dm" as abbreviation for "d/mmm", "my" for "mmm/yy",
"ms" for "nn:ss", "msz" for "nn:ss.z" (optional)
or use any other free format (at your own risk...)
Note: at least Excel xls does not recognize a separate datetime cell type:
a datetime is stored as a (floating point) Number, and the cell is formatted
@ -1494,9 +1541,25 @@ procedure TsWorksheet.WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime;
var
ACell: PCell;
fmt: String;
parser: TsNumFormatParser;
begin
ACell := GetCell(ARow, ACol);
if AFormat = nfFmtDateTime then begin
AFormatStr := BuildDateTimeFormatString(AFormat, Workbook.FormatSettings, AFormatStr);
parser := TsNumFormatParser.Create(Workbook, AFormatStr, cdToFPSpreadsheet);
try
// Check that the format string can be reckognized.
if parser.Status <> psOK then
raise Exception.Create(lpNoValidNumberFormatString);
// Check that the format string belongs to date/time values
if not (IsDateTimeFormat(parser.Builtin_NumFormat) or (parser.Builtin_NumFormat = nfFmtDateTime))
then raise Exception.Create(lpNoValidDateTimeFormatString);
AFormatStr := parser.FormatString;
finally
parser.Free;
end;
end;
ACell := GetCell(ARow, ACol);
ACell^.ContentType := cctDateTime;
ACell^.DateTimeValue := AValue;
// Date/time is actually a number field in Excel.
@ -1504,34 +1567,8 @@ begin
// The user can choose another date format if he wants to
Include(ACell^.UsedFormattingFields, uffNumberFormat);
ACell^.NumberFormat := AFormat;
case AFormat of
nfShortDateTime:
ACell^.NumberFormatStr := FormatSettings.ShortDateFormat + ' ' + FormatSettings.ShortTimeFormat;
nfShortDate:
ACell^.NumberFormatStr := FormatSettings.ShortDateFormat;
nfLongDate:
ACell^.NumberFormatStr := 'dd/mmm/yyyy';
nfShortTime:
ACell^.NumberFormatStr := 't';
nfLongTime:
ACell^.NumberFormatStr := 'tt';
nfShortTimeAM:
ACell^.NumberFormatStr := 'hh:nn AM/PM';
nfLongTimeAM:
ACell^.NumberFormatStr := 'hh:nn:ss AM/PM';
nfFmtDateTime:
begin
fmt := lowercase(AFormatStr);
if fmt = 'dm' then ACell^.NumberFormatStr := 'd/mmm'
else if fmt = 'my' then ACell^.NumberFormatStr := 'mmm/yy'
else if fmt = 'ms' then ACell^.NumberFormatStr := 'nn:ss'
else if fmt = 'msz' then ACell^.NumberFormatStr := 'nn:ss.z'
else ACell^.NumberFormatStr := AFormatStr;
end;
nfTimeInterval:
if AFormatStr = '' then ACell^.NumberFormatStr := '[h]:nn:ss'
else ACell^.NumberFormatStr := AFormatStr;
end;
ACell^.NumberFormatStr := AFormatStr;
ChangedCell(ARow, ACol);
end;
@ -1544,7 +1581,7 @@ procedure TsWorksheet.WriteDecimals(ACell: PCell; ADecimals: Byte);
begin
if (ACell <> nil) and (ACell^.ContentType = cctNumber) then begin
ACell^.Decimals := ADecimals;
ACell^.NumberFormatStr := BuildNumFormatString(ACell^.NumberFormat,
ACell^.NumberFormatStr := BuildNumberFormatString(ACell^.NumberFormat,
FWorkbook.FormatSettings, ADecimals, ACell^.CurrencySymbol);
ChangedCell(ACell^.Row, ACell^.Col);
end;
@ -1603,7 +1640,7 @@ begin
Include(ACell^.UsedFormattingFields, uffNumberFormat);
ACell^.NumberFormat := ANumberFormat;
if (AFormatString = '') then
ACell^.NumberFormatStr := BuildNumFormatString(ANumberFormat,
ACell^.NumberFormatStr := BuildNumberFormatString(ANumberFormat,
Workbook.FormatSettings, ACell^.Decimals, ACell^.CurrencySymbol)
else
ACell^.NumberFormatStr := AFormatString;
@ -2577,9 +2614,10 @@ end;
{ TsCustomNumFormatList }
constructor TsCustomNumFormatList.Create;
constructor TsCustomNumFormatList.Create(AWorkbook: TsWorkbook);
begin
inherited Create;
FWorkbook := AWorkbook;
AddBuiltinFormats;
end;
@ -2599,6 +2637,13 @@ begin
item := TsNumFormatData.Create;
item.Index := AFormatIndex;
item.NumFormat := ANumFormat;
if IsDateTimeFormat(ANumFormat) then
AFormatString := BuildDateTimeFormatString(ANumFormat, Workbook.FormatSettings,
AFormatString)
else
if item.NumFormat <> nfCustom then
AFormatString := BuildNumberFormatString(ANumFormat, Workbook.FormatSettings,
ADecimals, ACurrencySymbol);
item.FormatString := AFormatString;
item.Decimals := ADecimals;
item.CurrencySymbol := ACurrencySymbol;
@ -2644,6 +2689,38 @@ end;
If the format string cannot be directly handled by fpc it has to be transformed
to make it compatible. Can be done in overridden versions which know more
about the structure of the string in the actual file format. }
procedure TsCustomNumFormatList.Analyze(AFormatIndex: Integer;
var AFormatString: String; var ANumFormat: TsNumberFormat;
var ADecimals: Byte; var ACurrencySymbol: String);
var
parser: TsNumFormatParser;
fmt: String;
lFormatData: TsNumFormatData;
i: Integer;
begin
i := Find(AFormatIndex);
if i > 0 then begin
lFormatData := Items[i];
fmt := lFormatData.FormatString;
end else
fmt := AFormatString;
parser := TsNumFormatParser.Create(Workbook, fmt, cdToFPSpreadsheet);
try
if parser.Status = psOK then begin
ANumFormat := parser.Builtin_NumFormat;
AFormatString := parser.FormatString;
if not (parser.Builtin_NumFormat in [nfCustom, nfFmtDateTime]) then begin
ADecimals := parser.ParsedSections[0].Decimals;
ACurrencySymbol := parser.ParsedSections[0].CurrencySymbol;
end;
end;
finally
parser.Free;
end;
end;
(*
procedure TsCustomNumFormatList.Analyze(AFormatIndex: Integer;
var AFormatString: String; var ANumFormat: TsNumberFormat;
var ADecimals: Byte; var ACurrencySymbol: String);
@ -2749,6 +2826,7 @@ begin
ANumFormat := nfCustom;
end;
end;
*)
{ Called from the reader when a format item has been read from the file.
Determines the numFormat type, format string etc and stores the format in the
@ -2816,8 +2894,8 @@ begin
item := Items[Result];
if (item <> nil) and (item.NumFormat = ANumFormat) then
exit;
end
else
end;
if (ANumFormat = nfFmtDateTime) then begin
fmt := lowercase(AFormatString);
for Result := 0 to Count-1 do begin
@ -2847,9 +2925,10 @@ begin
if fmt = lowercase(item.FormatString) then
exit;
end;
end else
end;
// Check only the format string for nfCustom.
if (ANumFormat = nfCustom) then begin
if (ANumFormat = nfCustom) then
for Result := 0 to Count-1 do begin
item := Items[Result];
if (item <> nil)
@ -2858,7 +2937,7 @@ begin
then
exit;
end;
end else
// The other formats can carry additional information
for Result := 0 to Count-1 do begin
item := Items[Result];
@ -3099,7 +3178,8 @@ var
decs: Byte;
begin
if ACell^.NumberFormat = nfFmtDateTime then begin
if IsTimeFormat(ACell^.NumberFormatStr, isLong, isAMPM, isInterval, decs) then
decs := CountDecs(ACell^.NumberFormatStr, ['0', 'z', 'Z']);
// if IsTimeFormat(ACell^.NumberFormatStr, isLong, isAMPM, isInterval, decs) then
ACell^.Decimals := decs;
end;
end;

121
components/fpspreadsheet/fpsutils.pas
View File

@ -17,6 +17,7 @@ uses
// Exported types
type
TsSelectionDirection = (fpsVerticalSelection, fpsHorizontalSelection);
TsDecsChars = set of char;
const
// Date formatting string for unambiguous date/time display as strings
@ -60,19 +61,29 @@ function UTF8TextToXMLText(AText: ansistring): ansistring;
function TwipsToMillimeters(AValue: Integer): Single;
function MillimetersToTwips(AValue: Single): Integer;
function IfThen(ACondition: Boolean; AValue1,AValue2: TsNumberFormat): TsNumberFormat; overload;
function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean;
(*
function IsCurrencyFormat(s: String; out Decimals: Byte; out CurrSymbol: String;
out IsCurrencyRedFmt, IsCurrencyDashFmt: Boolean): Boolean;
function IsExpNumberFormat(s: String; out Decimals: Byte; out IsSci: Boolean): Boolean;
function IsFixedNumberFormat(s: String; out Decimals: Byte): Boolean;
function IsPercentNumberFormat(s: String; out Decimals: Byte): Boolean;
function IsThousandSepNumberFormat(s: String; out Decimals: Byte): Boolean;
function IsDateFormat(s: String; out IsLong: Boolean): Boolean;
function IsTimeFormat(s: String; out isLong, isAMPM, isInterval: Boolean;
out SecDecimals: Byte): Boolean;
function BuildNumFormatString(ANumberFormat: TsNumberFormat;
function IsDateFormat(s: String; out IsLong: Boolean): Boolean;
{function IsTimeFormat(s: String; out isLong, isAMPM, isInterval: Boolean;
out SecDecimals: Byte): Boolean;
*)
function BuildNumberFormatString(ANumberFormat: TsNumberFormat;
const AFormatSettings: TFormatSettings; ADecimals: Integer = -1;
ACurrencySymbol: String = '?'): String;
function BuildDateTimeFormatString(ANumberFormat: TsNumberFormat;
const AFormatSettings: TFormatSettings; AFormatString: String = ''): String;
function StripAMPM(const ATimeFormatString: String): String;
function CountDecs(AFormatString: String; ADecChars: TsDecsChars = ['0']): Byte;
function SciFloat(AValue: Double; ADecimals: Byte): String;
//function TimeIntervalToString(AValue: TDateTime; AFormatStr: String): String;
@ -494,8 +505,21 @@ begin
end;
{ Returns either AValue1 or AValue2, depending on the condition.
For reduciton of typing... }
function IfThen(ACondition: Boolean; AValue1, AValue2: TsNumberFormat): TsNumberFormat;
begin
if ACondition then Result := AValue1 else Result := AValue2;
end;
{ Format checking procedures }
function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean;
begin
Result := AFormat in [nfFmtDateTime, nfShortDateTime, nfShortDate, nfLongDate,
nfShortTime. nfLongTime, nfShortTimeAM, nfLongTimeAM, nfTimeInterval];
end;
(*
{ This simple parsing procedure of the Excel format string checks for a fixed
float format s, i.e. s can be '0', '0.00', '000', '0,000', and returns the
number of decimals, i.e. number of zeros behind the decimal point }
@ -661,7 +685,7 @@ begin
if ph > 0 then IsSci := true;
end;
end;
*)
{ IsDateFormat checks if the format string s corresponds to a date format }
function IsDateFormat(s: String; out IsLong: Boolean): Boolean;
begin
@ -744,9 +768,58 @@ begin
end;
end;
{ Builds a number format string from the numberformat code and the count of
decimals. }
function BuildNumFormatString(ANumberFormat: TsNumberFormat;
{ 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")
and "msz" (for "mm:ss.z"). }
function BuildDateTimeFormatString(ANumberFormat: TsNumberFormat;
const AFormatSettings: TFormatSettings; AFormatString: String = '') : string;
var
fmt: String;
begin
case ANumberFormat of
nfFmtDateTime:
begin
fmt := lowercase(AFormatString);
if (fmt = 'dm') then Result := 'd/mmm'
else if (fmt = 'my') then Result := 'mmm/yy'
else if (fmt = 'ms') then Result := 'nn:ss'
else if (fmt = 'msz') then Result := 'nn:ss.z'
else Result := AFormatString;
end;
nfShortDateTime:
Result := AFormatSettings.ShortDateFormat + ' ' + FormatSettings.ShortTimeFormat;
nfShortDate:
Result := AFormatSettings.ShortDateFormat;
nfLongDate:
Result := AFormatSettings.LongDateFormat;
nfShortTime:
Result := StripAMPM(AFormatSettings.ShortTimeFormat);
nfLongTime:
Result := StripAMPM(AFormatSettings.LongTimeFormat);
nfShortTimeAM:
begin
Result := AFormatSettings.ShortTimeFormat;
if pos('a', lowercase(AFormatSettings.ShortTimeFormat)) = 0 then
Result := Format('%s %s/%s', [Result, AFormatSettings.TimeAMString, AFormatSettings.TimePMString]);
end;
nfLongTimeAM:
begin
Result := AFormatSettings.LongTimeFormat;
if pos('a', lowercase(AFormatSettings.LongTimeFormat)) = 0 then
Result := Format('%s %s/%s', [Result, AFormatSettings.TimeAMString, AFormatSettings.TimePMString]);
end;
nfTimeInterval:
if AFormatString = '' then
Result := '[h]:mm:ss'
else
Result := AFormatString;
end;
end;
{ Builds a number format string from the numberformat code, the count of
decimals, and the currencysymbol (if not empty). }
function BuildNumberFormatString(ANumberFormat: TsNumberFormat;
const AFormatSettings: TFormatSettings; ADecimals: Integer = -1;
ACurrencySymbol: String = '?'): String;
const
@ -778,6 +851,7 @@ var
decs: String;
cf, ncf: Byte;
begin
Result := '';
cf := AFormatSettings.CurrencyFormat;
ncf := AFormatSettings.NegCurrFormat;
if ADecimals = -1 then ADecimals := AFormatSettings.CurrencyDecimals;
@ -824,6 +898,37 @@ begin
end;
end;
function StripAMPM(const ATimeFormatString: String): String;
var
i: Integer;
begin
Result := '';
i := 1;
while i <= Length(ATimeFormatString) do begin
if ATimeFormatString[i] in ['a', 'A'] then begin
inc(i);
while (i <= Length(ATimeFormatString)) and (ATimeFormatString[i] in ['p', 'P', 'm', 'M', '/']) do
inc(i);
end else
Result := Result + ATimeFormatString[i];
inc(i);
end;
end;
function CountDecs(AFormatString: String; ADecChars: TsDecsChars = ['0']): Byte;
var
i: Integer;
begin
Result := 0;
for i:=Length(AFormatString) downto 1 do begin
if AFormatString[i] in ADecChars then inc(Result);
if AFormatString[i] = '.' then exit;
end;
// Comes to this point when there is no decimal separtor.
Result := 0;
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.). }

2
components/fpspreadsheet/wikitable.pas
View File

@ -352,7 +352,7 @@ end;
procedure TsWikiTableWriter.CreateNumFormatList;
begin
FreeAndNil(FNumFormatList);
FNumFormatList := TsWikiTableNumFormatList.Create;
FNumFormatList := TsWikiTableNumFormatList.Create(Workbook);
end;
procedure TsWikiTableWriter.WriteToStrings(AStrings: TStrings);

10
components/fpspreadsheet/xlsbiff2.pas
View File

@ -43,7 +43,7 @@ type
protected
procedure AddBuiltinFormats; override;
public
constructor Create;
constructor Create(AWorkbook: TsWorkbook);
function FormatStringForWriting(AIndex: Integer): String; override;
end;
@ -166,9 +166,9 @@ const
{ TsBIFF2NumFormatList }
constructor TsBIFF2NumFormatList.Create;
constructor TsBIFF2NumFormatList.Create(AWorkbook: TsWorkbook);
begin
inherited Create;
inherited Create(AWorkbook);
end;
procedure TsBIFF2NumFormatList.AddBuiltinFormats;
@ -283,7 +283,7 @@ end;
procedure TsSpreadBIFF2Reader.CreateNumFormatList;
begin
FreeAndNil(FNumFormatList);
FNumFormatList := TsBIFF2NumFormatList.Create;
FNumFormatList := TsBIFF2NumFormatList.Create(Workbook);
end;
{ Extracts the number format data from an XF record indexed by AXFIndex.
@ -701,7 +701,7 @@ end;
procedure TsSpreadBIFF2Writer.CreateNumFormatList;
begin
FreeAndNil(FNumFormatList);
FNumFormatList := TsBIFF2NumFormatList.Create;
FNumFormatList := TsBIFF2NumFormatList.Create(Workbook);
end;
function TsSpreadBIFF2Writer.FindXFIndex(ACell: PCell): Word;

69
components/fpspreadsheet/xlscommon.pas
View File

@ -593,13 +593,15 @@ procedure TsBIFFNumFormatList.Analyze(AFormatIndex: Integer;
var AFormatString: String; var ANumFormat: TsNumberFormat;
var ADecimals: Byte; var ACurrencySymbol: String);
var
parser: TsNumFormatParser;
fmt: String;
{
parser: TsNumFormatParser;
sections: TsNumFormatSections;
}
begin
{
AFormatString := 'hh:mm AM/PM'; //"€" #,##.0;[red]"$" -#,##.000;-';
(*
AFormatString := 'hh:mm:ss.0 AM/PM'; //"€" #,##.0;[red]"$" -#,##.000;-';
parser := TsNumFormatParser.Create(Workbook, AFormatString);
try
@ -607,10 +609,18 @@ begin
ANumFormat := parser.ParsedSections[0].NumFormat;
ADecimals := parser.ParsedSections[0].Decimals;
ACurrencySymbol := parser.ParsedSections[0].CurrencySymbol;
parser.CopySectionsTo(sections);
finally
parser.Free;
end;
}
parser := TsNumFormatParser.Create(Workbook, sections);
try
fmt := parser.FormatString;
finally
parser.Free;
end;
*)
fmt := Lowercase(AFormatString);
{ Check the built-in formats first:
@ -660,6 +670,18 @@ function TsBIFFNumFormatList.FormatStringForWriting(AIndex: Integer): String;
var
item: TsNumFormatData;
i: Integer;
procedure FixN(var s: String);
// The minutes in short time formats are coded by "n" in fpc, but Excel wants "m".
var
i: Integer;
begin
for i:=1 to Length(s) do
case s[i] of
'n', 'N': s[i] := 'm'; // no "M" which will be interpreted as "Month"
end;
end;
begin
Result := inherited FormatStringForWriting(AIndex);
item := Items[AIndex];
@ -670,15 +692,19 @@ begin
for i:=1 to Length(Result) do begin
// The milliseccond format contains the symbol "z" in fpc, but Excel wants "0"
if Result[i] in ['z', 'Z'] then Result[i] := '0';
// The minutes in short time formats are coded by "n" in fpc, but Excel wants "m".
if Result[i] in ['n', 'N'] then Result[i] := 'm';
end;
FixN(Result);
end;
nfTimeInterval:
// Time interval format string could still be without square brackets
// if added by user.
// We check here for safety and add the brackets if not there.
MakeTimeIntervalMask(item.FormatString, Result);
begin
// Time interval format string could still be without square brackets
// if added by user.
// We check here for safety and add the brackets if not there.
MakeTimeIntervalMask(item.FormatString, Result);
FixN(Result);
end;
nfShortTime, nfShortTimeAM, nfLongTime, nfLongTimeAM:
FixN(Result);
nfCurrencyRed, nfCurrencyDashRed:
begin
i := Pos(';', item.FormatString);
@ -765,7 +791,7 @@ end;
procedure TsSpreadBIFFReader.CreateNumFormatList;
begin
FreeAndNil(FNumFormatList);
FNumFormatList := TsBIFFNumFormatList.Create;
FNumFormatList := TsBIFFNumFormatList.Create(Workbook);
end;
{ Extracts a number out of an RK value.
@ -812,9 +838,11 @@ procedure TsSpreadBIFFReader.ExtractNumberFormat(AXFIndex: WORD;
decs: Byte;
i: Integer;
begin
if IsTimeFormat(ANumberFormatStr, isLong, isAMPM, isInterval, decs)
decs := CountDecs(ANumberFormatStr, ['0', 'z', 'Z']);
{ if IsTimeFormat(ANumberFormatStr, isLong, isAMPM, isInterval, decs)
and (decs > 0)
then
then }
if decs > 0 then
for i:= Length(ANumberFormatStr) downto 1 do
case ANumberFormatStr[i] of
'0': ANumberFormatStr[i] := 'z';
@ -1361,7 +1389,7 @@ end;
procedure TsSpreadBIFFWriter.CreateNumFormatList;
begin
FreeAndNil(FNumFormatList);
FNumFormatList := TsBIFFNumFormatList.Create;
FNumFormatList := TsBIFFNumFormatList.Create(Workbook);
end;
function TsSpreadBIFFWriter.FormulaElementKindToExcelTokenID(
@ -1679,19 +1707,16 @@ end;
procedure TsSpreadBIFFWriter.WriteFormats(AStream: TStream);
var
i: Integer;
item: TsNumFormatData;
begin
ListAllNumFormats;
item := NumFormatList[20];
i := NumFormatList.Find(NumFormatList.FirstFormatIndexInFile);
if i > -1 then
while i < NumFormatList.Count do begin
if NumFormatList[i] <> nil then
WriteFormat(AStream, NumFormatList[i], i);
item := NumFormatList[i];
if item <> nil then begin
WriteFormat(AStream, item, i);
end;
inc(i);
end;
end;

2
components/fpspreadsheet/xlsxooxml.pas
View File

@ -393,7 +393,7 @@ end;
procedure TsSpreadOOXMLWriter.CreateNumFormatList;
begin
FreeAndNil(FNumFormatList);
FNumFormatList := TsOOXMLNumFormatList.Create;
FNumFormatList := TsOOXMLNumFormatList.Create(Workbook);
end;
{