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

fpspreadsheet: Add formatting of numbers as fractions

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4073 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-03-31 19:01:16 +00:00
parent c208e3f4e9
commit 5c2b844bb7
10 changed files with 651 additions and 130 deletions
Download Patch File Download Diff File Expand all files Collapse all files

193
components/fpspreadsheet/examples/visual/fpsctrls/main.lfm
View File

@ -820,6 +820,77 @@ object MainForm: TMainForm
Hint = 'Currency format (negative values in red)'
NumberFormat = nfCurrencyRed
end
object AcFileOpen: TFileOpen
Category = 'File'
Caption = '&Open ...'
Dialog.Filter = 'All spreadsheet files|*.xls;*.xlsx;*.ods;*.csv|All Excel files (*.xls, *.xlsx)|*.xls;*.xlsx|Excel XML spreadsheet (*.xlsx)|*.xlsx|Excel 97-2003 spreadsheets (*.xls)|*.xls|Excel 5 spreadsheet (*.xls)|*.xls|Excel 2.1 spreadsheets (*.xls)|*.xls|LibreOffice/OpenOffice spreadsheet (*.ods)|*.ods|Comma-delimited files (*.csv)|*.csv'
Dialog.Options = [ofExtensionDifferent, ofFileMustExist, ofEnableSizing, ofViewDetail]
Hint = 'Open spreadsheet file'
ImageIndex = 44
ShortCut = 16463
OnAccept = AcFileOpenAccept
end
object AcFileSaveAs: TFileSaveAs
Category = 'File'
Caption = 'Save &as ...'
Dialog.Title = 'AcSaveFileAs'
Dialog.Filter = 'Excel XML spreadsheet (*.xlsx)|*.xlsx|Excel 97-2003 spreadsheets (*.xls)|*.xls|Excel 5 spreadsheet (*.xls)|*.xls|Excel 2.1 spreadsheets (*.xls)|*.xls|LibreOffice/OpenOffice spreadsheet (*.ods)|*.ods|Comma-delimited files (*.csv)|*.csv|WikiTable (WikiMedia-Format, *.wikitable_wikimedia)|*.wikitable_wikimedia'
Hint = 'Save spreadsheet'
ImageIndex = 45
OnAccept = AcFileSaveAsAccept
end
object AcViewInspector: TAction
Category = 'View'
AutoCheck = True
Caption = 'Inspector'
OnExecute = AcViewInspectorExecute
end
object AcRowAdd: TAction
Category = 'Edit'
Caption = 'Add row'
Hint = 'Add row'
ImageIndex = 48
OnExecute = AcRowAddExecute
end
object AcColAdd: TAction
Category = 'Edit'
Caption = 'Add column'
Hint = 'Add column'
ImageIndex = 47
OnExecute = AcColAddExecute
end
object AcRowDelete: TAction
Category = 'Edit'
Caption = 'Delete row'
Hint = 'Delete row'
ImageIndex = 50
OnExecute = AcRowDeleteExecute
end
object AcColDelete: TAction
Category = 'Edit'
Caption = 'Delete column'
Hint = 'Delete column'
ImageIndex = 49
OnExecute = AcColDeleteExecute
end
object AcSettingsCSVParams: TAction
Category = 'Settings'
Caption = 'CSV parameters...'
Hint = 'Parameters for CSV files'
OnExecute = AcSettingsCSVParamsExecute
end
object AcSettingsCurrency: TAction
Category = 'Settings'
Caption = 'Currency symbols...'
Hint = 'Define currency symbols'
OnExecute = AcSettingsCurrencyExecute
end
object AcSettingsFormatSettings: TAction
Category = 'Settings'
Caption = 'Number format settings...'
Hint = 'Define number format settings'
OnExecute = AcSettingsFormatSettingsExecute
end
object AcNumFormatExp: TsNumberFormatAction
Category = 'FPSpreadsheet'
WorkbookSource = WorkbookSource
@ -827,6 +898,27 @@ object MainForm: TMainForm
Hint = 'Exponential format'
NumberFormat = nfExp
end
object AcNumFormatFraction1: TsNumberFormatAction
Category = 'FPSpreadsheet'
WorkbookSource = WorkbookSource
Caption = 'Fraction (1 digit)'
NumberFormat = nfFraction
NumberFormatString = '#" "#/#'
end
object AcNumFormatFraction2: TsNumberFormatAction
Category = 'FPSpreadsheet'
WorkbookSource = WorkbookSource
Caption = 'Fraction (2 digits)'
NumberFormat = nfFraction
NumberFormatString = '#" "##/##'
end
object AcNumFormatFraction3: TsNumberFormatAction
Category = 'FPSpreadsheet'
WorkbookSource = WorkbookSource
Caption = 'Fraction (3 digits)'
NumberFormat = nfFraction
NumberFormatString = '#" "###/###'
end
object AcNumFormatDateTime: TsNumberFormatAction
Category = 'FPSpreadsheet'
WorkbookSource = WorkbookSource
@ -1323,25 +1415,6 @@ object MainForm: TMainForm
Hint = 'Merge cells'
ImageIndex = 23
end
object AcFileOpen: TFileOpen
Category = 'File'
Caption = '&Open ...'
Dialog.Filter = 'All spreadsheet files|*.xls;*.xlsx;*.ods;*.csv|All Excel files (*.xls, *.xlsx)|*.xls;*.xlsx|Excel XML spreadsheet (*.xlsx)|*.xlsx|Excel 97-2003 spreadsheets (*.xls)|*.xls|Excel 5 spreadsheet (*.xls)|*.xls|Excel 2.1 spreadsheets (*.xls)|*.xls|LibreOffice/OpenOffice spreadsheet (*.ods)|*.ods|Comma-delimited files (*.csv)|*.csv'
Dialog.Options = [ofExtensionDifferent, ofFileMustExist, ofEnableSizing, ofViewDetail]
Hint = 'Open spreadsheet file'
ImageIndex = 44
ShortCut = 16463
OnAccept = AcFileOpenAccept
end
object AcFileSaveAs: TFileSaveAs
Category = 'File'
Caption = 'Save &as ...'
Dialog.Title = 'AcSaveFileAs'
Dialog.Filter = 'Excel XML spreadsheet (*.xlsx)|*.xlsx|Excel 97-2003 spreadsheets (*.xls)|*.xls|Excel 5 spreadsheet (*.xls)|*.xls|Excel 2.1 spreadsheets (*.xls)|*.xls|LibreOffice/OpenOffice spreadsheet (*.ods)|*.ods|Comma-delimited files (*.csv)|*.csv|WikiTable (WikiMedia-Format, *.wikitable_wikimedia)|*.wikitable_wikimedia'
Hint = 'Save spreadsheet'
ImageIndex = 45
OnAccept = AcFileSaveAsAccept
end
object AcCopyFormat: TsCopyAction
Category = 'FPSpreadsheet'
WorkbookSource = WorkbookSource
@ -1349,40 +1422,6 @@ object MainForm: TMainForm
Hint = 'Copy format'
ImageIndex = 46
end
object AcViewInspector: TAction
Category = 'View'
AutoCheck = True
Caption = 'Inspector'
OnExecute = AcViewInspectorExecute
end
object AcRowAdd: TAction
Category = 'Edit'
Caption = 'Add row'
Hint = 'Add row'
ImageIndex = 48
OnExecute = AcRowAddExecute
end
object AcColAdd: TAction
Category = 'Edit'
Caption = 'Add column'
Hint = 'Add column'
ImageIndex = 47
OnExecute = AcColAddExecute
end
object AcRowDelete: TAction
Category = 'Edit'
Caption = 'Delete row'
Hint = 'Delete row'
ImageIndex = 50
OnExecute = AcRowDeleteExecute
end
object AcColDelete: TAction
Category = 'Edit'
Caption = 'Delete column'
Hint = 'Delete column'
ImageIndex = 49
OnExecute = AcColDeleteExecute
end
object AcCopyToClipboard: TsCopyAction
Category = 'FPSpreadsheet'
WorkbookSource = WorkbookSource
@ -1452,24 +1491,6 @@ object MainForm: TMainForm
Hint = 'Delete comment'
ImageIndex = 55
end
object AcSettingsCSVParams: TAction
Category = 'Settings'
Caption = 'CSV parameters...'
Hint = 'Parameters for CSV files'
OnExecute = AcSettingsCSVParamsExecute
end
object AcSettingsCurrency: TAction
Category = 'Settings'
Caption = 'Currency symbols...'
Hint = 'Define currency symbols'
OnExecute = AcSettingsCurrencyExecute
end
object AcSettingsFormatSettings: TAction
Category = 'Settings'
Caption = 'Number format settings...'
Hint = 'Define number format settings'
OnExecute = AcSettingsFormatSettingsExecute
end
object AcHyperlinkNew: TsCellHyperlinkAction
Category = 'FPSpreadsheet'
WorkbookSource = WorkbookSource
@ -4828,6 +4849,21 @@ object MainForm: TMainForm
object MenuItem13: TMenuItem
Caption = '-'
end
object MenuItem117: TMenuItem
Action = AcNumFormatFraction1
AutoCheck = True
end
object MenuItem116: TMenuItem
Action = AcNumFormatFraction2
AutoCheck = True
end
object MenuItem115: TMenuItem
Action = AcNumFormatFraction3
AutoCheck = True
end
object MenuItem114: TMenuItem
Caption = '-'
end
object MenuItem53: TMenuItem
Action = AcNumFormatExp
AutoCheck = True
@ -4970,6 +5006,21 @@ object MainForm: TMainForm
object MenuItem20: TMenuItem
Caption = '-'
end
object MenuItem112: TMenuItem
Action = AcNumFormatFraction1
AutoCheck = True
end
object MenuItem110: TMenuItem
Action = AcNumFormatFraction2
AutoCheck = True
end
object MenuItem113: TMenuItem
Action = AcNumFormatFraction3
AutoCheck = True
end
object MenuItem111: TMenuItem
Caption = '-'
end
object MenuItem21: TMenuItem
Action = AcNumFormatExp
AutoCheck = True

11
components/fpspreadsheet/examples/visual/fpsctrls/main.pas
View File

@ -40,6 +40,14 @@ type
MenuItem107: TMenuItem;
MenuItem108: TMenuItem;
MenuItem109: TMenuItem;
MenuItem110: TMenuItem;
MenuItem111: TMenuItem;
MenuItem112: TMenuItem;
MenuItem113: TMenuItem;
MenuItem114: TMenuItem;
MenuItem115: TMenuItem;
MenuItem116: TMenuItem;
MenuItem117: TMenuItem;
MnuSettings: TMenuItem;
MenuItem11: TMenuItem;
MenuItem12: TMenuItem;
@ -224,6 +232,9 @@ type
AcHyperlinkNew: TsCellHyperlinkAction;
AcHyperlinkEdit: TsCellHyperlinkAction;
AcHyperlinkDelete: TsCellHyperlinkAction;
AcNumFormatFraction2: TsNumberFormatAction;
AcNumFormatFraction1: TsNumberFormatAction;
AcNumFormatFraction3: TsNumberFormatAction;
Splitter2: TSplitter;
Splitter3: TSplitter;
ToolBar2: TToolBar;

46
components/fpspreadsheet/fpsnumformat.pas
View File

@ -78,6 +78,8 @@ type
property Items[AIndex: Integer]: TsNumFormatData read GetItem write SetItem; default;
end;
function FormatAsFraction(ANumFormatStr: String; AValue: Double): String;
function IsCurrencyFormat(AFormat: TsNumberFormat): Boolean;
function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean; overload;
function IsDateTimeFormat(AFormatStr: String): Boolean; overload;
@ -91,6 +93,50 @@ uses
Math,
fpsUtils, fpsNumFormatParser;
{@@ ----------------------------------------------------------------------------
Formats a floating point value as a fraction according to the specified
formatting string.
@param ANumFormatStr String with formatting codes
-------------------------------------------------------------------------------}
function FormatAsFraction(ANumFormatStr: String; AValue: Double): String;
var
parser: TsNumFormatParser;
int,num,denom: Integer;
maxNum, maxDenom: Integer;
isNeg: Boolean;
begin
if AValue < 0 then begin
isNeg := true;
AValue := abs(AValue);
end else
isNeg := false;
parser := TsNumFormatParser.Create(nil, ANumFormatStr);
try
if parser.NumFormat <> nfFraction then
raise Exception.Create('[FormatAsFraction] No formatting string for fractions.');
if parser.FracInt = 0 then
int := 0
else
begin
int := trunc(AValue);
AValue := frac(AValue);
end;
maxNum := Round(IntPower(10, parser.FracNumerator));
maxDenom := Round(IntPower(10, parser.FracDenominator));
FloatToFraction(AValue, maxNum, maxDenom, num, denom);
if int = 0 then
Result := Format('%d/%d', [num, denom])
else
Result := Format('%d %d/%d', [int, num, denom]);
if isNeg then Result := '-' + Result;
finally
parser.Free;
end;
end;
{@@ ----------------------------------------------------------------------------
Checks whether the given number format code is for currency,
i.e. requires currency symbol.

226
components/fpspreadsheet/fpsnumformatparser.pas
View File

@ -29,9 +29,10 @@ type
nftYear, nftMonth, nftDay, nftHour, nftMinute, nftSecond, nftMilliseconds,
nftAMPM, nftMonthMinute, nftDateTimeSep,
nftSign, nftSignBracket,
nftDigit, nftOptDigit, nftDecs, nftOptDec,
nftDigit, nftOptDigit, nftOptSpaceDigit, nftDecs, nftOptDec,
nftExpChar, nftExpSign, nftExpDigits,
nftPercent,
nftFraction,
nftCurrSymbol, nftCountry,
nftColor, nftCompareOp, nftCompareValue,
nftSpace, nftEscaped,
@ -51,6 +52,9 @@ type
Elements: TsNumFormatElements;
NumFormat: TsNumberFormat;
Decimals: Byte;
FracInt: Integer;
FracNumerator: Integer;
FracDenominator: Integer;
CurrencySymbol: String;
Color: TsColor;
end;
@ -69,6 +73,9 @@ type
FStatus: Integer;
function GetCurrencySymbol: String;
function GetDecimals: byte;
function GetFracDenominator: Integer;
function GetFracInt: Integer;
function GetFracNumerator: Integer;
function GetFormatString(ADialect: TsNumFormatDialect): String;
function GetNumFormat: TsNumberFormat;
function GetParsedSectionCount: Integer;
@ -115,10 +122,13 @@ type
// Format string
function BuildFormatString(ADialect: TsNumFormatDialect): String; virtual;
function BuildFormatStringFromSection(ASection: Integer;
ADialect: TsNumFormatDialect): String; virtual;
ADialect: TsNumFormatDialect; AStartIndex: Integer = 0): String; virtual;
// NumberFormat
procedure EvalNumFormatOfSection(ASection: Integer; out ANumFormat: TsNumberFormat;
out ADecimals: byte; out ACurrencySymbol: String; out AColor: TsColor);
procedure EvalNumFormatOfSection(ASection: Integer);
{; out ANumFormat: TsNumberFormat;
out ADecimals: byte; out ANumerator, ADenominator: Integer;
out ACurrencySymbol: String; out AColor: TsColor);
}
function IsCurrencyAt(ASection: Integer; out ANumFormat: TsNumberFormat;
out ADecimals: byte; out ACurrencySymbol: String; out AColor: TsColor): Boolean;
function IsDateAt(ASection,AIndex: Integer; out ANumberFormat: TsNumberFormat;
@ -144,6 +154,9 @@ type
property CurrencySymbol: String read GetCurrencySymbol;
property Decimals: Byte read GetDecimals write SetDecimals;
property FormatString[ADialect: TsNumFormatDialect]: String read GetFormatString;
property FracDenominator: Integer read GetFracDenominator;
property FracInt: Integer read GetFracInt;
property FracNumerator: Integer read GetFracNumerator;
property NumFormat: TsNumberFormat read GetNumFormat;
property ParsedSectionCount: Integer read GetParsedSectionCount;
property ParsedSections[AIndex: Integer]: TsNumFormatSection read GetParsedSections;
@ -283,7 +296,7 @@ end;
{ Creates a format string for the given section. This implementation covers
the formatstring dialects of fpc (nfdDefault) and Excel (nfdExcel). }
function TsNumFormatParser.BuildFormatStringFromSection(ASection: Integer;
ADialect: TsNumFormatDialect): String;
ADialect: TsNumFormatDialect; AStartIndex: Integer = 0): String;
var
element: TsNumFormatElement;
i: Integer;
@ -303,6 +316,8 @@ begin
Result := Result + '0';
nftOptDigit, nftOptDec:
Result := Result + '#';
nftOptSpaceDigit:
Result := Result + '#'; /// !!!!!!!!!!! TO BE CHANGED !!!!!!!!!!!!!!!!!
nftYear:
Result := Result + DupeString(IfThen(ADialect = nfdExcel, 'Y', 'y'), element.IntValue);
nftMonth:
@ -324,7 +339,7 @@ begin
nftDecs, nftExpDigits, nftMilliseconds:
Result := Result + Dupestring('0', element.IntValue);
nftSpace, nftSign, nftSignBracket, nftExpChar, nftExpSign, nftPercent,
nftAMPM, nftDateTimeSep:
nftFraction, nftAMPM, nftDateTimeSep:
if element.TextValue <> '' then Result := Result + element.TextValue;
nftCurrSymbol:
if element.TextValue <> '' then begin
@ -443,12 +458,16 @@ begin
end;
end;
EvalNumFormatOfSection(ASection,
EvalNumFormatOfSection(ASection);
{
FSections[ASection].NumFormat,
FSections[ASection].Decimals,
FSections[ASection].Numerator,
FSections[ASection].Denominator,
FSections[ASection].CurrencySymbol,
FSections[ASection].Color
);
}
end;
procedure TsNumFormatParser.ClearAll;
@ -526,33 +545,68 @@ begin
end;
end;
procedure TsNumFormatParser.EvalNumFormatOfSection(ASection: Integer;
out ANumFormat: TsNumberFormat; out ADecimals: byte; out ACurrencySymbol: String;
procedure TsNumFormatParser.EvalNumFormatOfSection(ASection: Integer);
{
out ANumFormat: TsNumberFormat; out ADecimals: byte;
out ANumerator, ADenominator: Integer; out ACurrencySymbol: String;
out AColor: TsColor);
}
var
nf: TsNumberFormat;
nf, nf1: TsNumberFormat;
next: Integer = 0;
decs, num, denom: Byte;
cs: String;
clr: TsColor;
begin
ANumFormat := nfCustom;
ADecimals := 0;
ACurrencySymbol := '';
AColor := scNotDefined;
nf := nfCustom;
decs := 0;
num := 0;
denom := 0;
cs := '';
clr := scNotDefined;
with FSections[ASection] do begin
if Length(Elements) = 0 then begin
ANumFormat := nfGeneral;
FSections[ASection].NumFormat := nfGeneral;
exit;
end;
// Look for number formats
if IsNumberAt(ASection, 0, ANumFormat, ADecimals, next) then begin
if IsNumberAt(ASection, 0, nf, decs, next) then begin
// nfFixed, nfFixedTh
if next = Length(Elements) then
begin
FSections[ASection].NumFormat := nf;
FSections[ASection].Decimals := decs;
exit;
end;
// nfPercentage
if IsTokenAt(nftPercent, ASection, next) and (next+1 = Length(Elements))
then begin
ANumFormat := nfPercentage;
FSections[ASection].NumFormat := nfPercentage;
FSections[ASection].Decimals := decs;
exit;
end;
// nfFraction
if IsTextAt(' ', ASection, next) and
IsNumberAt(ASection, next+1, nf, num, next) and
IsTokenAt(nftFraction, ASection, next) and
IsNumberAt(ASection, next+1, nf, denom, next) and
(next = Length(Elements))
then begin
FSections[ASection].NumFormat := nfFraction;
FSections[ASection].FracInt := integer(decs); // "decs" means "number of integer digits", here
FSections[ASection].FracNumerator := integer(num);
FSections[ASection].FracDenominator := integer(denom);
exit;
end;
if IsTokenAt(nftFraction, ASection, next) and
IsNumberAt(ASection, next+1, nf, denom, next) and
(next = Length(Elements))
then begin
FSections[ASection].NumFormat := nfFraction;
FSections[ASection].FracNumerator := integer(decs);
FSections[ASection].FracDenominator := integer(denom);
exit;
end;
// nfExp
@ -560,38 +614,53 @@ begin
if IsTokenAt(nftExpSign, ASection, next+1) and IsTokenAt(nftExpDigits, ASection, next+2) and
(next+3 = Length(Elements))
then begin
if ANumFormat = nfFixed then
ANumFormat := nfExp;
exit;
if nf = nfFixed then
begin
FSections[ASection].NumFormat := nfExp;
FSections[ASection].Decimals := decs;
exit;
end;
end;
end;
end;
// Currency?
if IsCurrencyAt(ASection, ANumFormat, ADecimals, ACurrencySymbol, AColor)
then exit;
if IsCurrencyAt(ASection, nf, decs, cs, clr) then
begin
FSections[ASection].NumFormat := nf;
FSections[ASection].Decimals := decs;
FSections[ASection].CurrencySymbol := cs;
FSections[ASection].Color := clr;
exit;
end;
// Look for date formats
if IsDateAt(ASection, 0, ANumFormat, next) then begin
if IsDateAt(ASection, 0, nf, next) then begin
if (next = Length(Elements)) then
begin
FSections[ASection].NumFormat := nf;
exit;
if IsTextAt(' ', ASection, next) and IsTimeAt(ASection, next+1, nf, next) and
end;
if IsTokenAt(nftSpace, ASection, next) and IsTimeAt(ASection, next+1, nf1, next) and
(next = Length(Elements))
then begin
if (ANumFormat = nfShortDate) and (nf = nfShortTime) then
ANumFormat := nfShortDateTime;
if (nf = nfShortDate) and (nf1 = nfShortTime) then
FSections[ASection].NumFormat := nfShortDateTime;
end;
exit;
end;
// Look for time formats
if IsTimeAt(ASection, 0, ANumFormat, next) then
if IsTimeAt(ASection, 0, nf, next) then
if next = Length(Elements) then
begin
FSections[ASection].NumFormat := nf;
exit;
end;
end;
// What is left must be a custom format.
ANumFormat := nfCustom;
FSections[ASection].NumFormat := nfCustom;
end;
{ Extracts the currency symbol form the formatting sections. It is assumed that
@ -647,6 +716,30 @@ begin
Result := 0;
end;
function TsNumFormatParser.GetFracDenominator: Integer;
begin
if Length(FSections) > 0 then
Result := FSections[0].FracDenominator
else
Result := 0;
end;
function TsNumFormatParser.GetFracInt: Integer;
begin
if Length(FSections) > 0 then
Result := FSections[0].FracInt
else
Result := 0;
end;
function TsNumFormatParser.GetFracNumerator: Integer;
begin
if Length(FSections) > 0 then
Result := FSections[0].FracNumerator
else
Result := 0;
end;
{ Tries to extract a common builtin number format from the sections. If there
are multiple sections, it is always a custom format, except for Currency and
Accounting. }
@ -882,10 +975,13 @@ end;
{ Checks whether the format tokens beginning at AIndex for ASection represent
at standard number format, like nfFixed, nfPercentage etc.
Returns TRUE if it does. }
Returns TRUE if it does.
NOTE: ADecimals can have various meanings -- see EvalNumFormatOfSection}
function TsNumFormatParser.IsNumberAt(ASection,AIndex: Integer;
out ANumberFormat: TsNumberFormat; out ADecimals: Byte;
out ANextIndex: Integer): Boolean;
var
i: Integer;
begin
Result := false;
ANumberFormat := nfGeneral;
@ -911,28 +1007,56 @@ begin
end;
end else
// Now look also for optional digits ('#')
if IsTokenAt(nftOptDigit, ASection, AIndex) and // '#'
IsTokenAt(nftThSep, ASection, AIndex+1) and // ','
IsTokenAt(nftOptDigit, ASection, AIndex+2) and // '#'
IsTokenAt(nftOptDigit, ASection, Aindex+3) and // '#'
IsTokenAt(nftDigit, ASection, AIndex+4) // '0'
then begin
if IsTokenAt(nftDecSep, ASection, AIndex+5) and // '.'
IsTokenAt(nftDecs, ASection, AIndex+6) // count of decimals
if IsTokenAt(nftOptDigit, ASection, AIndex) then begin // '#'
if IsTokenAt(nftThSep, ASection, AIndex+1) and // ','
IsTokenAt(nftOptDigit, ASection, AIndex+2) and // '#'
IsTokenAt(nftOptDigit, ASection, Aindex+3) and // '#'
IsTokenAt(nftDigit, ASection, AIndex+4) // '0'
then begin
// This is the case with decimal separator, like "#,##0.000"
Result := true;
ANumberFormat := nfFixedTh;
ADecimals := FSections[ASection].Elements[AIndex+6].IntValue;
ANextIndex := AIndex+7;
if IsTokenAt(nftDecSep, ASection, AIndex+5) and // '.'
IsTokenAt(nftDecs, ASection, AIndex+6) // count of decimals
then begin
// This is the case with decimal separator, like "#,##0.000"
Result := true;
ANumberFormat := nfFixedTh;
ADecimals := FSections[ASection].Elements[AIndex+6].IntValue;
ANextIndex := AIndex+7;
end else
if not IsTokenAt(nftDecSep, ASection, AIndex+5) then begin
// and this is without decimal separator, "#,##0"
result := true;
ANumberFormat := nfFixedTh;
ADecimals := 0;
ANextIndex := AIndex + 5;
end;
end else
if not IsTokenAt(nftDecSep, ASection, AIndex+5) then begin
// and this is without decimal separator, "#,##0"
begin // Isolated '#'
result := true;
ANumberFormat := nfFixedTh;
ADecimals := 0;
ANextIndex := AIndex + 5;
inc(AIndex);
ANextIndex := AIndex;
ADecimals := 1;
while IsTokenAt(nftOptDigit, ASection, AIndex) do
begin
inc(AIndex);
inc(ANextIndex);
inc(ADecimals);
end;
ANumberFormat := nfFraction;
end;
end else
if IsTokenAt(nftOptSpaceDigit, ASection, AIndex) then // '?'
begin
Result := true;
inc(AIndex);
ANextIndex := AIndex;
ADecimals := 1;
while IsTokenAt(nftOptSpaceDigit, ASection, AIndex) do
begin
inc(AIndex);
inc(ANextIndex);
inc(ADecimals);
end;
ANumberFormat := nfFraction;
end;
end;
@ -1024,7 +1148,7 @@ function TsNumFormatParser.IsTimeAt(ASection,AIndex: Integer;
exit;
end;
end;
Result := true;
Result := i >= Length(AFmtStr); //true;
end;
var
@ -1053,7 +1177,7 @@ begin
ANumberFormat := IfThen(AMPM, nfShortTimeAM, nfShortTime);
exit;
end;
fmt := AddAMPM(FWorkbook.FormatSettings.ShortTimeFormat, FWorkbook.FormatSettings);
fmt := FWorkbook.FormatSettings.ShortTimeFormat;
if CheckFormat(fmt, ANextIndex, AMPM, isInterval) then begin
ANumberFormat := IfThen(AMPM, nfShortTimeAM, nfShortTime);
exit;
@ -1454,7 +1578,7 @@ begin
ScanQuotedText;
'(', ')':
AddElement(nftSignBracket, FToken);
'0', '#', '.', ',', '-':
'0', '#', '?', '.', ',', '-':
ScanNumber;
'y', 'Y', 'm', 'M', 'd', 'D', 'h', 'N', 'n', 's':
ScanDateTime;
@ -1514,7 +1638,9 @@ begin
'+', '-':
AddElement(nftSign, FToken);
'#': AddElement(nftOptDigit, FToken);
'?': AddElement(nftOptSpaceDigit, FToken);
'%': AddElement(nftPercent, FToken);
'/': AddElement(nftFraction, FToken);
else
FToken := PrevToken;
Exit;

51
components/fpspreadsheet/fpsopendocument.pas
View File

@ -508,6 +508,7 @@ var
s: String;
isTimeOnly: Boolean;
isInterval: Boolean;
num, denom: byte;
begin
Result := '';
@ -571,6 +572,39 @@ begin
exit;
end;
// nfFraction
if IsTextAt(' ', ASection, next) and
IsNumberAt(ASection, next+1, nf, num, next) and
IsTokenAt(nftFraction, ASection, next) and
IsNumberAt(ASection, next+1, nf, denom, next) and
(next = Length(Elements))
then begin
Result :=
'<number:number-style style:name="' + AFormatName + '">' +
sColor +
'<number:fraction ' +
'number:min-integer-digits="' + IntToStr(decs) + '" ' +
'number:min-numerator-digits="' + IntToStr(num) + '" ' +
'number:min-denominator-digits="' + IntToStr(denom) + '" ' +
'/>' +
'</number:number-style>';
exit;
end;
if IsTokenAt(nftFraction, ASection, next) and
IsNumberAt(ASection, next+1, nf, denom, next) and
(next = Length(Elements))
then begin
Result :=
'<number:number-style style:name="' + AFormatName + '">' +
sColor +
'<number:fraction ' +
'number:min-numerator-digits="' + IntToStr(decs) + '" ' +
'number:min-denominator-digits="' + IntToStr(denom) + '" ' +
'/>' +
'</number:number-style>';
exit;
end;
// nfPercentage
if IsTokenAt(nftPercent, ASection, next) and (next+1 = Length(Elements)) then
begin
@ -1678,6 +1712,7 @@ procedure TsSpreadOpenDocReader.ReadNumFormats(AStylesNode: TDOMNode);
nfs: String;
decs: Byte;
s: String;
fracInt, fracNum, fracDenom: Integer;
grouping: Boolean;
nex: Integer;
cs: String;
@ -1697,11 +1732,6 @@ procedure TsSpreadOpenDocReader.ReadNumFormats(AStylesNode: TDOMNode);
end else
if nodeName = 'number:number' then
begin
{
if ANumFormatName = 'number:currency-style' then
s := GetAttrValue(node, 'decimal-places')
else
}
s := GetAttrValue(node, 'number:decimal-places');
if s = '' then s := GetAttrValue(node, 'decimal-places');
if s <> '' then decs := StrToInt(s) else decs := 0;
@ -1709,6 +1739,17 @@ procedure TsSpreadOpenDocReader.ReadNumFormats(AStylesNode: TDOMNode);
nf := IfThen(grouping, nfFixedTh, nfFixed);
nfs := nfs + BuildNumberFormatString(nf, Workbook.FormatSettings, decs);
end else
if nodeName = 'number:fraction' then
begin
nf := nfFraction;
s := GetAttrValue(node, 'number:min-integer-digits');
if s <> '' then fracInt := StrToInt(s) else fracInt := 0;
s := GetAttrValue(node, 'number:min-numerator-digits');
if s <> '' then fracNum := StrToInt(s) else fracNum := 0;
s := GetAttrValue(node, 'number:min-denominator-digits');
if s <> '' then fracDenom := StrToInt(s) else fracDenom := 0;
nfs := nfs + BuildFractionFormatString(fracInt > 0, fracNum, fracDenom);
end else
if nodeName = 'number:scientific-number' then
begin
nf := nfExp;

68
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -312,6 +312,10 @@ type
procedure WriteNumberFormat(ACell: PCell; ANumFormat: TsNumberFormat;
ADecimals: Integer; ACurrencySymbol: String = '';
APosCurrFormat: Integer = -1; ANegCurrFormat: Integer = -1); overload;
function WriteFractionFormat(ARow, ACol: Cardinal; AMixedFraction: Boolean;
ANumeratorDigits, ADenominatorDigits: Integer): PCell; overload;
procedure WriteFractionFormat(ACell: PCell; AMixedFraction: Boolean;
ANumeratorDigits, ADenominatorDigits: Integer); overload;
function WriteTextRotation(ARow, ACol: Cardinal; ARotation: TsTextRotation): PCell; overload;
procedure WriteTextRotation(ACell: PCell; ARotation: TsTextRotation); overload;
@ -2514,6 +2518,8 @@ function TsWorksheet.ReadAsUTF8Text(ACell: PCell;
function FloatToStrNoNaN(const AValue: Double;
ANumberFormat: TsNumberFormat; ANumberFormatStr: string): string; //ansistring;
var
i: Integer;
begin
if IsNan(AValue) then
Result := ''
@ -2524,6 +2530,9 @@ function TsWorksheet.ReadAsUTF8Text(ACell: PCell;
if (ANumberFormat = nfPercentage) then
Result := FormatFloat(ANumberFormatStr, AValue*100, AFormatSettings)
else
if (ANumberFormat = nfFraction) then
Result := FormatAsFraction(ANumberFormatStr, AValue)
else
if IsCurrencyFormat(ANumberFormat) then
Result := FormatCurr(ANumberFormatStr, AValue, AFormatSettings)
else
@ -4026,6 +4035,7 @@ var
number: Double;
currSym: String;
fmt: TsCellFormat;
maxDig: Integer;
begin
if ACell = nil then
exit;
@ -4047,6 +4057,13 @@ begin
exit;
end;
if TryFractionStrToFloat(AValue, number, maxdig) then
begin
WriteNumber(ACell, number);
WriteFractionFormat(ACell, true, maxdig, maxdig);
exit;
end;
if TryStrToFloat(AValue, number, FWorkbook.FormatSettings) then
begin
if isPercent then
@ -4616,7 +4633,56 @@ begin
end;
{@@ ----------------------------------------------------------------------------
Adds number format to the formatting of a cell
Formats a number as a fraction
@param ARow Row index of the cell
@param ACol Column index of the cell
@param ANumFormat Identifier of the format to be applied. Must be
either nfFraction or nfMixedFraction
@param ANumeratorDigts Count of numerator digits
@param ADenominatorDigits Count of denominator digits
@return Pointer to the cell
@see TsNumberFormat
-------------------------------------------------------------------------------}
function TsWorksheet.WriteFractionFormat(ARow, ACol: Cardinal;
AMixedFraction: Boolean; ANumeratorDigits, ADenominatorDigits: Integer): PCell;
begin
Result := GetCell(ARow, ACol);
WriteFractionFormat(Result, AMixedFraction, ANumeratorDigits, ADenominatorDigits);
end;
{@@ ----------------------------------------------------------------------------
Formats a number as a fraction
@param ACell Pointer to the cell to be formatted
@param ANumFormat Identifier of the format to be applied. Must be
either nfFraction or nfMixedFraction
@param ANumeratorDigts Count of numerator digits
@param ADenominatorDigits Count of denominator digits
@see TsNumberFormat
-------------------------------------------------------------------------------}
procedure TsWorksheet.WriteFractionFormat(ACell: PCell;
AMixedFraction: Boolean; ANumeratorDigits, ADenominatorDigits: Integer);
var
fmt: TsCellFormat;
begin
if ACell = nil then
exit;
fmt := Workbook.GetCellFormat(ACell^.FormatIndex);
fmt.NumberFormat := nfFraction;
fmt.NumberFormatStr := BuildFractionFormatString(AMixedFraction,
ANumeratorDigits, ADenominatorDigits);
Include(fmt.UsedFormattingFields, uffNumberFormat);
ACell^.FormatIndex := Workbook.AddCellFormat(fmt);
ChangedCell(ACell^.Row, ACell^.Col);
end;
{@@ ----------------------------------------------------------------------------
Adds a number format to the formatting of a cell
@param ARow The row of the cell
@param ACol The column of the cell

2
components/fpspreadsheet/fpstypes.pas
View File

@ -203,7 +203,7 @@ type
// general-purpose for all numbers
nfGeneral,
// numbers
nfFixed, nfFixedTh, nfExp, nfPercentage,
nfFixed, nfFixedTh, nfExp, nfPercentage, nfFraction,
// currency
nfCurrency, nfCurrencyRed,
// dates and times

178
components/fpspreadsheet/fpsutils.pas
View File

@ -101,6 +101,8 @@ function BuildCurrencyFormatString(ADialect: TsNumFormatDialect;
ADecimals, APosCurrFormat, ANegCurrFormat: Integer; ACurrencySymbol: String): String;
function BuildDateTimeFormatString(ANumberFormat: TsNumberFormat;
const AFormatSettings: TFormatSettings; AFormatString: String = ''): String;
function BuildFractionFormatString(AMixedFraction: Boolean;
ANumeratorDigits, ADenominatorDigits: Integer): String;
function BuildNumberFormatString(ANumberFormat: TsNumberFormat;
const AFormatSettings: TFormatSettings; ADecimals: Integer = -1): String;
@ -111,6 +113,8 @@ function CountDecs(AFormatString: String; ADecChars: TsDecsChars = ['0']): Byte;
function AddIntervalBrackets(AFormatString: String): String;
function DayNamesToString(const ADayNames: TWeekNameArray;
const AEmptyStr: String): String;
procedure FloatToFraction(AValue: Double; AMaxNumerator, AMaxDenominator: Integer;
out ANumerator, ADenominator: Integer);
function MakeLongDateFormat(ADateFormat: String): String;
function MakeShortDateFormat(ADateFormat: String): String;
function MonthNamesToString(const AMonthNames: TMonthNameArray;
@ -125,6 +129,9 @@ procedure MakeTimeIntervalMask(Src: String; var Dest: String);
function TryStrToFloatAuto(AText: String; out ANumber: Double;
out ADecimalSeparator, AThousandSeparator: Char; out AWarning: String): Boolean;
function TryFractionStrToFloat(AText: String; out ANumber: Double;
out AMaxDigits: Integer): Boolean;
function TwipsToPts(AValue: Integer): Single;
function PtsToTwips(AValue: Single): Integer;
function cmToPts(AValue: Double): Double;
@ -1127,6 +1134,26 @@ begin
end;
end;
{@@ ----------------------------------------------------------------------------
Builds a number format string for fraction formatting from the number format
code and the count of numerator and denominator digits.
@param AMixedFraction If TRUE fraction is presented as mixed fraction
@param ANumeratorDigits Count of numerator digits
@param ADenominatorDigits Count of denominator digits
@return String of formatting code, here something like: '##/##' or '# ##/##'
-------------------------------------------------------------------------------}
function BuildFractionFormatString(AMixedFraction: Boolean;
ANumeratorDigits, ADenominatorDigits: Integer): String;
begin
Result := Format('%s/%s', [
DupeString('#', ANumeratorDigits), DupeString('#', ADenominatorDigits)
]);
if AMixedFraction then
Result := '#" "' + Result;
end;
{@@ ----------------------------------------------------------------------------
Builds a number format string from the number format code and the count of
decimal places.
@ -1306,6 +1333,99 @@ begin
end;
end;
{@@ ----------------------------------------------------------------------------
Approximates a floating point value as a fraction and returns the values of
numerator and denominator.
@param AValue Floating point value to be analyzed
@param AMaxNumerator Maximum value of the numerator allowed
@param AMaxDenominator Maximum value of the denominator allowed
@param ANumerator (out) Numerator of the best approximating fraction
@param ADenominator (out) Denominator of the best approximating fraction
-------------------------------------------------------------------------------}
procedure FloatToFraction(AValue: Double; AMaxNumerator, AMaxDenominator: Integer;
out ANumerator, ADenominator: Integer);
// "Stern-Brocot-Tree"
// Original from : http://stackoverflow.com/questions/5124743/algorithm-for-simplifying-decimal-to-fractions
// Procedure adapted by forum user "circular": http://forum.lazarus.freepascal.org/index.php/topic,27805.msg172372.html#msg172372
var
n: Integer;
lower_n, lower_d, upper_n, upper_d, middle_n, middle_d: Integer;
isNeg: Boolean;
backup_num, backup_denom: Integer;
newResult_num, newResult_denom: Integer;
EPS: Double;
begin
EPS := 0.01 / AMaxDenominator;
isNeg := AValue < 0;
if isNeg then
AValue := -AValue;
n := Trunc(AValue);
newResult_num := round(AValue);
newResult_denom := 1;
if isNeg then newResult_num := -newResult_num;
backup_num := newResult_num;
backup_denom := newResult_denom;
AValue := AValue - n;
// Lower fraction is 0/1
lower_n := 0;
lower_d := 1;
// Upper fraction is 1/1
upper_n := 1;
upper_d := 1;
while true do
begin
if abs(newResult_num/newResult_denom - n - AValue) <
abs(backup_num/backup_denom - n - AValue)
then begin
backup_num := newResult_num;
backup_denom := newResult_denom;
end;
// middle fraction is (lower_n + upper_n) / (lower_d + upper_d)
middle_n := lower_n + upper_n;
middle_d := lower_d + upper_d;
newResult_num := n * middle_d + middle_n;
newResult_denom := middle_d;
// newResult.Normalize;
if (newResult_num > AMaxNumerator) or (newResult_denom > AMaxDenominator)
then begin
ANumerator := backup_num;
ADenominator := backup_denom;
exit;
end;
if isNeg then newResult_num := -newResult_num;
// AValue + EPS < middle
if middle_d * (AValue + EPS) < middle_n then
begin
// middle is our new upper
upper_n := middle_n;
upper_d := middle_d;
end else
// middle < AValue - EPS
if middle_n < (AValue - EPS) * middle_d then
begin
// middle is our new lower
lower_n := middle_n;
lower_d := middle_d;
end else
// middle is our best fraction
begin
ANumerator := newResult_num;
ADenominator := newResult_denom;
exit;
end;
end;
end;
{@@ ----------------------------------------------------------------------------
Creates a long date format string out of a short date format string.
Retains the order of year-month-day and the separators, but uses 4 digits
@ -1722,6 +1842,64 @@ begin
end;
end;
{@@ ----------------------------------------------------------------------------
Assumes that the specified text is a string representation of a mathematical
fraction and tries to extract the floating point value of this number.
Returns also the maximum count of digits used in the numerator or
denominator of the fraction
@param AText String to be considered
@param ANumber (out) value of the converted floating point number
@param AMaxDigits Maximum count of digits used in the numerator or
denominator of the fraction
@return TRUE if a number value can be retrieved successfully, FALSE otherwise
@example AText := '1 3/4' --> ANumber = 1.75; AMaxDigits = 1; Result = true
-------------------------------------------------------------------------------}
function TryFractionStrToFloat(AText: String; out ANumber: Double;
out AMaxDigits: Integer): Boolean;
var
p: Integer;
s, sInt, sNum, sDenom: String;
i,num,denom: Integer;
begin
Result := false;
s := '';
sInt := '';
sNum := '';
sDenom := '';
p := 1;
while p <= Length(AText) do begin
case AText[p] of
'0'..'9': s := s + AText[p];
' ': begin sInt := s; s := ''; end;
'/': begin sNum := s; s := ''; end;
else exit;
end;
inc(p);
end;
sDenom := s;
if (sInt <> '') and not TryStrToInt(sInt, i) then
exit;
if (sNum = '') or not TryStrtoInt(sNum, num) then
exit;
if (sDenom = '') or not TryStrToInt(sDenom, denom) then
exit;
if denom = 0 then
exit;
ANumber := num / denom;
if sInt <> '' then
ANumber := ANumber + i;
AMaxDigits := Length(sDenom);
Result := true;
end;
{@@ ----------------------------------------------------------------------------
Excel's unit of row heights is "twips", i.e. 1/20 point.
Converts Twips to points.

3
components/fpspreadsheet/xlscommon.pas
View File

@ -623,7 +623,8 @@ begin
AddFormat( 9, nfPercentage, '0%');
AddFormat(10, nfPercentage, '0.00%');
AddFormat(11, nfExp, '0.00E+00');
// fraction formats 12 ('# ?/?') and 13 ('# ??/??') not supported
AddFormat(12, nfFraction, '# ?/?');
AddFormat(13, nfFraction, '# ??/??');
AddFormat(14, nfShortDate, fs.ShortDateFormat); // 'M/D/YY'
AddFormat(15, nfLongDate, fs.LongDateFormat); // 'D-MMM-YY'
AddFormat(16, nfCustom, 'd/mmm'); // 'D-MMM'

3
components/fpspreadsheet/xlsxooxml.pas
View File

@ -405,7 +405,8 @@ begin
AddFormat( 9, nfPercentage, '0%');
AddFormat(10, nfPercentage, '0.00%');
AddFormat(11, nfExp, '0.00E+00');
// fraction formats 12 ('# ?/?') and 13 ('# ??/??') not supported
AddFormat(12, nfFraction, '# ?/?');
AddFormat(13, nfFraction, '# ??/??');
AddFormat(14, nfShortDate, fs.ShortDateFormat); // 'M/D/YY'
AddFormat(15, nfLongDate, fs.LongDateFormat); // 'D-MMM-YY'
AddFormat(16, nfCustom, 'd/mmm'); // 'D-MMM'