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

fpspreadsheet: Better detection of fraction format by numberformat action. Some clean-up.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4145 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-05-19 16:18:01 +00:00
parent 4a45218c8f
commit 8adf987bf9
9 changed files with 109 additions and 512 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -837,21 +837,21 @@ object MainForm: TMainForm
WorkbookSource = WorkbookSource WorkbookSource = WorkbookSource
Caption = 'Fraction (1 digit)' Caption = 'Fraction (1 digit)'
NumberFormat = nfFraction NumberFormat = nfFraction
NumberFormatString = '# #/#' NumberFormatString = '# ?/?'
end end
object AcNumFormatFraction2: TsNumberFormatAction object AcNumFormatFraction2: TsNumberFormatAction
Category = 'FPSpreadsheet' Category = 'FPSpreadsheet'
WorkbookSource = WorkbookSource WorkbookSource = WorkbookSource
Caption = 'Fraction (2 digits)' Caption = 'Fraction (2 digits)'
NumberFormat = nfFraction NumberFormat = nfFraction
NumberFormatString = '# ##/##' NumberFormatString = '# ??/??'
end end
object AcNumFormatFraction3: TsNumberFormatAction object AcNumFormatFraction3: TsNumberFormatAction
Category = 'FPSpreadsheet' Category = 'FPSpreadsheet'
WorkbookSource = WorkbookSource WorkbookSource = WorkbookSource
Caption = 'Fraction (3 digits)' Caption = 'Fraction (3 digits)'
NumberFormat = nfFraction NumberFormat = nfFraction
NumberFormatString = '# ###/###' NumberFormatString = '# ???/???'
end end
object AcNumFormatDateTime: TsNumberFormatAction object AcNumFormatDateTime: TsNumberFormatAction
Category = 'FPSpreadsheet' Category = 'FPSpreadsheet'

65
components/fpspreadsheet/examples/visual/shared/sctrls.pas
View File

@@ -44,6 +44,71 @@ implementation
uses uses
Math, ButtonPanel, fpsUtils; Math, ButtonPanel, fpsUtils;
{@@ ----------------------------------------------------------------------------
Concatenates the day names specified in ADayNames to a single string. If all
daynames are empty AEmptyStr is returned
@param ADayNames Array[1..7] of day names as used in the Formatsettings
@param AEmptyStr Is returned if all day names are empty
@return String having all day names concatenated and separated by the
DefaultFormatSettings.ListSeparator
-------------------------------------------------------------------------------}
function DayNamesToString(const ADayNames: TWeekNameArray;
const AEmptyStr: String): String;
var
i: Integer;
isEmpty: Boolean;
begin
isEmpty := true;
for i:=1 to 7 do
if ADayNames[i] <> '' then
begin
isEmpty := false;
break;
end;
if isEmpty then
Result := AEmptyStr
else
begin
Result := ADayNames[1];
for i:=2 to 7 do
Result := Result + DefaultFormatSettings.ListSeparator + ' ' + ADayNames[i];
end;
end;
{@@ ----------------------------------------------------------------------------
Concatenates the month names specified in AMonthNames to a single string.
If all month names are empty AEmptyStr is returned
@param AMonthNames Array[1..12] of month names as used in the Formatsettings
@param AEmptyStr Is returned if all month names are empty
@return String having all month names concatenated and separated by the
DefaultFormatSettings.ListSeparator
-------------------------------------------------------------------------------}
function MonthNamesToString(const AMonthNames: TMonthNameArray;
const AEmptyStr: String): String;
var
i: Integer;
isEmpty: Boolean;
begin
isEmpty := true;
for i:=1 to 12 do
if AMonthNames[i] <> '' then
begin
isEmpty := false;
break;
end;
if isEmpty then
Result := AEmptyStr
else
begin
Result := AMonthNames[1];
for i:=2 to 12 do
Result := Result + DefaultFormatSettings.ListSeparator + ' ' + AMonthNames[i];
end;
end;
{ TMonthDayNamesEdit } { TMonthDayNamesEdit }

5
components/fpspreadsheet/fps.inc
View File

@@ -21,11 +21,6 @@
{ The next defines activate code duplicated from new compiler versions in case { The next defines activate code duplicated from new compiler versions in case
an old compiler is used. } an old compiler is used. }
{ Numberformats require an extended version of FormatDateTime (in SysUtils)
which is not available before FPC 3.0. Define FPS_FORMATDATETIME if the
compiler used is older. }
{$DEFINE FPS_FORMATDATETIME}
{ fpspreadsheet requires the function VarIsBool which was introduced by { fpspreadsheet requires the function VarIsBool which was introduced by
fpc 2.6.4. If an older FPC versions is used define FPS_VARISBOOL. Keep fpc 2.6.4. If an older FPC versions is used define FPS_VARISBOOL. Keep
undefined for the current FPC version. } undefined for the current FPC version. }

27
components/fpspreadsheet/fpsnumformatparser.pas
View File

@@ -305,10 +305,14 @@ begin
section := @FSections[ASection]; section := @FSections[ASection];
section^.Kind := []; section^.Kind := [];
i := 0;
for el := 0 to High(section^.Elements) do for el := 0 to High(section^.Elements) do
case section^.Elements[el].Token of case section^.Elements[el].Token of
nftZeroDecs: nftZeroDecs:
section^.Decimals := section^.Elements[el].IntValue; section^.Decimals := section^.Elements[el].IntValue;
nftIntZeroDigit, nftIntOptDigit, nftIntSpaceDigit:
i := section^.Elements[el].IntValue;
nftFracNumSpaceDigit, nftFracNumZeroDigit: nftFracNumSpaceDigit, nftFracNumZeroDigit:
section^.FracNumerator := section^.Elements[el].IntValue; section^.FracNumerator := section^.Elements[el].IntValue;
nftFracDenomSpaceDigit, nftFracDenomZeroDigit: nftFracDenomSpaceDigit, nftFracDenomZeroDigit:
@@ -331,7 +335,10 @@ begin
if (nfkFraction in section^.Kind) then if (nfkFraction in section^.Kind) then
FStatus := psErrMultipleFracSymbols FStatus := psErrMultipleFracSymbols
else else
begin
section^.Kind := section^.Kind + [nfkFraction]; section^.Kind := section^.Kind + [nfkFraction];
section^.FracInt := i;
end;
nftCurrSymbol: nftCurrSymbol:
begin begin
if (nfkCurrency in section^.Kind) then if (nfkCurrency in section^.Kind) then
@@ -405,13 +412,19 @@ begin
end else end else
begin begin
nfs := GetFormatString; nfs := GetFormatString;
formats := [nfFixed, nfFixedTh, nfPercentage, nfExp, nfFraction]; nfsTest := BuildFractionFormatString(section^.FracInt > 0, section^.FracNumerator, section^.FracDenominator);
for nf in formats do begin if sameText(nfs, nfsTest) then
nfsTest := BuildNumberFormatString(nf, FWorkbook.FormatSettings, section^.Decimals); section^.NumFormat := nfFraction
if SameText(nfs, nfsTest) then else
begin begin
section^.NumFormat := nf; formats := [nfFixed, nfFixedTh, nfPercentage, nfExp];
break; for nf in formats do begin
nfsTest := BuildNumberFormatString(nf, FWorkbook.FormatSettings, section^.Decimals);
if SameText(nfs, nfsTest) then
begin
section^.NumFormat := nf;
break;
end;
end; end;
end; end;
if (section^.NumFormat = nfCustom) and (nfkCurrency in section^.Kind) then if (section^.NumFormat = nfCustom) and (nfkCurrency in section^.Kind) then

7
components/fpspreadsheet/fpsopendocument.pas
View File

@@ -230,7 +230,7 @@ implementation
uses uses
StrUtils, Variants, LazFileUtils, URIParser, StrUtils, Variants, LazFileUtils, URIParser,
fpsPatches, fpsStrings, fpsStreams, fpsExprParser; fpsStrings, fpsStreams, fpsExprParser;
const const
{ OpenDocument general XML constants } { OpenDocument general XML constants }
@@ -5364,6 +5364,7 @@ var
r1,c1,r2,c2: Cardinal; r1,c1,r2,c2: Cardinal;
fmt: TsCellFormat; fmt: TsCellFormat;
numFmtParams: TsNumFormatParams; numFmtParams: TsNumFormatParams;
h,m,s,ms: Word;
begin begin
Unused(ARow, ACol); Unused(ARow, ACol);
@@ -5395,7 +5396,9 @@ begin
if IsTimeIntervalformat(numFmtParams) then if IsTimeIntervalformat(numFmtParams) then
begin begin
strValue := FormatDateTime(ISO8601FormatHoursOverflow, AValue, [fdoInterval]); DecodeTime(AValue, h,m,s,ms);
strValue := Format('PT%02dH%02dM%02d.%03dS', [trunc(AValue)*24+h, m, s, ms]);
// strValue := FormatDateTime(ISO8601FormatHoursOverflow, AValue, [fdoInterval]);
displayStr := FWorksheet.ReadAsUTF8Text(ACell); displayStr := FWorksheet.ReadAsUTF8Text(ACell);
// displayStr := FormatDateTime(fmt.NumberFormatStr, AValue, [fdoInterval]); // displayStr := FormatDateTime(fmt.NumberFormatStr, AValue, [fdoInterval]);
AppendToStream(AStream, Format( AppendToStream(AStream, Format(

336
components/fpspreadsheet/fpspatches.pas
View File

@@ -16,13 +16,13 @@ uses
Classes, SysUtils; Classes, SysUtils;
{$IFDEF FPS_VARISBOOL} {$IFDEF FPS_VARISBOOL}
{ Needed only if FPC version is < 2.6.4 } { Needed only if FPC version is < 2.6.4 }
function VarIsBool(const V: Variant): Boolean; function VarIsBool(const V: Variant): Boolean;
{$ENDIF} {$ENDIF}
{$IFDEF FPS_LAZUTF8} {$IFDEF FPS_LAZUTF8}
// implemented in LazUTF8 in r43348 (Laz 1.2) // implemented in LazUTF8 of r43348 (Laz 1.2)
function UTF8LeftStr(const AText: String; const ACount: Integer): String; function UTF8LeftStr(const AText: String; const ACount: Integer): String;
function UTF8RightStr(const AText: String; const ACount: Integer): String; function UTF8RightStr(const AText: String; const ACount: Integer): String;
function UTF8StringReplace(const S, OldPattern, NewPattern: String; function UTF8StringReplace(const S, OldPattern, NewPattern: String;
@@ -32,19 +32,6 @@ uses
{$ENDIF} {$ENDIF}
{$IFDEF FPS_FORMATDATETIME}
type
TFormatDateTimeOption = (fdoInterval);
TFormatDateTimeOptions = set of TFormatDateTimeOption;
// Needed if fpc version is < 3.0.
function FormatDateTime(const FormatStr: string; DateTime: TDateTime;
Options : TFormatDateTimeOptions = []): string;
function FormatDateTime(const FormatStr: string; DateTime: TDateTime;
const FormatSettings: TFormatSettings; Options : TFormatDateTimeOptions = []): string;
{$ENDIF}
implementation implementation
{$IFDEF FPS_VARISBOOL} {$IFDEF FPS_VARISBOOL}
@@ -1706,325 +1693,6 @@ begin
// Final correction of the buffer size // Final correction of the buffer size
SetLength(Result,OutCounter); SetLength(Result,OutCounter);
end; end;
{$ENDIF}
{$IFDEF FPS_FORMATDATETIME}
{******************************************************************************}
{******************************************************************************}
{ Patch for SysUtils.FormatDateTime }
{******************************************************************************}
{******************************************************************************}
{@@ ----------------------------------------------------------------------------
Applies a formatting string to a date/time value and converts the number
to a date/time string.
This functionality is available in the SysUtils unit. But it is duplicated
here to add a patch which is not available in stable fpc.
-------------------------------------------------------------------------------}
procedure DateTimeToString(out Result: string; const FormatStr: string; const DateTime: TDateTime;
const FormatSettings: TFormatSettings; Options : TFormatDateTimeOptions = []);
// Copied from "fpc/rtl/objpas/sysutils/datei.inc"
var
ResultLen: integer;
ResultBuffer: array[0..255] of char;
ResultCurrent: pchar;
procedure StoreStr(Str: PChar; Len: Integer);
begin
if ResultLen + Len < SizeOf(ResultBuffer) then
begin
StrMove(ResultCurrent, Str, Len);
ResultCurrent := ResultCurrent + Len;
ResultLen := ResultLen + Len;
end;
end;
procedure StoreString(const Str: string);
var Len: integer;
begin
Len := Length(Str);
if ResultLen + Len < SizeOf(ResultBuffer) then
begin
StrMove(ResultCurrent, pchar(Str), Len);
ResultCurrent := ResultCurrent + Len;
ResultLen := ResultLen + Len;
end;
end;
procedure StoreInt(Value, Digits: Integer);
var
S: string[16];
Len: integer;
begin
System.Str(Value:Digits, S);
for Len := 1 to Length(S) do
begin
if S[Len] = ' ' then
S[Len] := '0'
else
Break;
end;
StoreStr(pchar(@S[1]), Length(S));
end ;
var
Year, Month, Day, DayOfWeek, Hour, Minute, Second, MilliSecond: word;
procedure StoreFormat(const FormatStr: string; Nesting: Integer; TimeFlag: Boolean);
var
Token, lastformattoken, prevlasttoken: char;
FormatCurrent: pchar;
FormatEnd: pchar;
Count: integer;
Clock12: boolean;
P: pchar;
tmp: integer;
isInterval: Boolean;
begin
if Nesting > 1 then // 0 is original string, 1 is included FormatString
Exit;
FormatCurrent := PChar(FormatStr);
FormatEnd := FormatCurrent + Length(FormatStr);
Clock12 := false;
isInterval := false;
P := FormatCurrent;
// look for unquoted 12-hour clock token
while P < FormatEnd do
begin
Token := P^;
case Token of
'''', '"':
begin
Inc(P);
while (P < FormatEnd) and (P^ <> Token) do
Inc(P);
end;
'A', 'a':
begin
if (StrLIComp(P, 'A/P', 3) = 0) or
(StrLIComp(P, 'AMPM', 4) = 0) or
(StrLIComp(P, 'AM/PM', 5) = 0) then
begin
Clock12 := true;
break;
end;
end;
end; // case
Inc(P);
end ;
token := #255;
lastformattoken := ' ';
prevlasttoken := 'H';
while FormatCurrent < FormatEnd do
begin
Token := UpCase(FormatCurrent^);
Count := 1;
P := FormatCurrent + 1;
case Token of
'''', '"':
begin
while (P < FormatEnd) and (p^ <> Token) do
Inc(P);
Inc(P);
Count := P - FormatCurrent;
StoreStr(FormatCurrent + 1, Count - 2);
end ;
'A':
begin
if StrLIComp(FormatCurrent, 'AMPM', 4) = 0 then
begin
Count := 4;
if Hour < 12 then
StoreString(FormatSettings.TimeAMString)
else
StoreString(FormatSettings.TimePMString);
end
else if StrLIComp(FormatCurrent, 'AM/PM', 5) = 0 then
begin
Count := 5;
if Hour < 12 then StoreStr(FormatCurrent, 2)
else StoreStr(FormatCurrent+3, 2);
end
else if StrLIComp(FormatCurrent, 'A/P', 3) = 0 then
begin
Count := 3;
if Hour < 12 then StoreStr(FormatCurrent, 1)
else StoreStr(FormatCurrent+2, 1);
end
else
raise EConvertError.Create('Illegal character in format string');
end ;
'/': StoreStr(@FormatSettings.DateSeparator, 1);
':': StoreStr(@FormatSettings.TimeSeparator, 1);
'[': if (fdoInterval in Options) then isInterval := true else StoreStr(FormatCurrent, 1);
']': if (fdoInterval in Options) then isInterval := false else StoreStr(FormatCurrent, 1);
' ', 'C', 'D', 'H', 'M', 'N', 'S', 'T', 'Y', 'Z', 'F' :
begin
while (P < FormatEnd) and (UpCase(P^) = Token) do
Inc(P);
Count := P - FormatCurrent;
case Token of
' ': StoreStr(FormatCurrent, Count);
'Y': begin
if Count > 2 then
StoreInt(Year, 4)
else
StoreInt(Year mod 100, 2);
end;
'M': begin
if isInterval and ((prevlasttoken = 'H') or TimeFlag) then
StoreInt(Minute + (Hour + trunc(abs(DateTime))*24)*60, 0)
else
if (lastformattoken = 'H') or TimeFlag then
begin
if Count = 1 then
StoreInt(Minute, 0)
else
StoreInt(Minute, 2);
end
else
begin
case Count of
1: StoreInt(Month, 0);
2: StoreInt(Month, 2);
3: StoreString(FormatSettings.ShortMonthNames[Month]);
else
StoreString(FormatSettings.LongMonthNames[Month]);
end;
end;
end;
'D': begin
case Count of
1: StoreInt(Day, 0);
2: StoreInt(Day, 2);
3: StoreString(FormatSettings.ShortDayNames[DayOfWeek]);
4: StoreString(FormatSettings.LongDayNames[DayOfWeek]);
5: StoreFormat(FormatSettings.ShortDateFormat, Nesting+1, False);
else
StoreFormat(FormatSettings.LongDateFormat, Nesting+1, False);
end ;
end ;
'H':
if isInterval then
StoreInt(Hour + trunc(abs(DateTime))*24, 0)
else
if Clock12 then
begin
tmp := hour mod 12;
if tmp=0 then tmp:=12;
if Count = 1 then
StoreInt(tmp, 0)
else
StoreInt(tmp, 2);
end
else begin
if Count = 1 then
StoreInt(Hour, 0)
else
StoreInt(Hour, 2);
end;
'N': if isInterval then
StoreInt(Minute + (Hour + trunc(abs(DateTime))*24)*60, 0)
else
if Count = 1 then
StoreInt(Minute, 0)
else
StoreInt(Minute, 2);
'S': if isInterval then
StoreInt(Second + (Minute + (Hour + trunc(abs(DateTime))*24)*60)*60, 0)
else
if Count = 1 then
StoreInt(Second, 0)
else
StoreInt(Second, 2);
'Z': if Count = 1 then
StoreInt(MilliSecond, 0)
else
StoreInt(MilliSecond, 3);
'T': if Count = 1 then
StoreFormat(FormatSettings.ShortTimeFormat, Nesting+1, True)
else
StoreFormat(FormatSettings.LongTimeFormat, Nesting+1, True);
'C': begin
StoreFormat(FormatSettings.ShortDateFormat, Nesting+1, False);
if (Hour<>0) or (Minute<>0) or (Second<>0) then
begin
StoreString(' ');
StoreFormat(FormatSettings.LongTimeFormat, Nesting+1, True);
end;
end;
'F': begin
StoreFormat(FormatSettings.ShortDateFormat, Nesting+1, False);
StoreString(' ');
StoreFormat(FormatSettings.LongTimeFormat, Nesting+1, True);
end;
end;
prevlasttoken := lastformattoken;
lastformattoken := token;
end;
else
StoreStr(@Token, 1);
end ;
Inc(FormatCurrent, Count);
end;
end;
begin
DecodeDateFully(DateTime, Year, Month, Day, DayOfWeek);
DecodeTime(DateTime, Hour, Minute, Second, MilliSecond);
ResultLen := 0;
ResultCurrent := @ResultBuffer[0];
if FormatStr <> '' then
StoreFormat(FormatStr, 0, False)
else
StoreFormat('C', 0, False);
ResultBuffer[ResultLen] := #0;
result := StrPas(@ResultBuffer[0]);
end ;
{@@
Applies a formatting string to a date/time value and converts the number
to a date/time string.
This functionality is available in the SysUtils unit. But it is duplicated
here to add a patch which is not available in stable fpc.
}
procedure DateTimeToString(out Result: string; const FormatStr: string;
const DateTime: TDateTime; Options : TFormatDateTimeOptions = []);
begin
DateTimeToString(Result, FormatStr, DateTime, DefaultFormatSettings, Options);
end;
{@@
Applies a formatting string to a date/time value and converts the number
to a date/time string.
This functionality is available in the SysUtils unit. But it is duplicated
here to add a patch which is not available in stable fpc.
}
function FormatDateTime(const FormatStr: string; DateTime: TDateTime;
Options : TFormatDateTimeOptions = []): string;
begin
DateTimeToString(Result, FormatStr, DateTime, DefaultFormatSettings,Options);
end;
{@@
Applies a formatting string to a date/time value and converts the number
to a date/time string.
This functionality is available in the SysUtils unit. But it is duplicated
here to add a patch which is not available in stable fpc.
}
function FormatDateTime(const FormatStr: string; DateTime: TDateTime;
const FormatSettings: TFormatSettings; Options : TFormatDateTimeOptions = []): string;
begin
DateTimeToString(Result, FormatStr, DateTime, FormatSettings,Options);
end;
{$ENDIF} {$ENDIF}
end. end.

7
components/fpspreadsheet/fpspreadsheet.pas
View File

@@ -792,7 +792,7 @@ implementation
uses uses
Math, StrUtils, DateUtils, TypInfo, lazutf8, lazFileUtils, URIParser, Math, StrUtils, DateUtils, TypInfo, lazutf8, lazFileUtils, URIParser,
fpsPatches, fpsStrings, uvirtuallayer_ole, fpsStrings, uvirtuallayer_ole,
fpsUtils, fpsreaderwriter, fpsCurrency, fpsExprParser, fpsUtils, fpsreaderwriter, fpsCurrency, fpsExprParser,
fpsNumFormat, fpsNumFormatParser; fpsNumFormat, fpsNumFormatParser;
@@ -3976,6 +3976,7 @@ var
fmt: TsCellFormat; fmt: TsCellFormat;
numFmtParams: TsNumFormatParams; numFmtParams: TsNumFormatParams;
maxDig: Integer; maxDig: Integer;
isMixed: Boolean;
begin begin
if ACell = nil then if ACell = nil then
exit; exit;
@@ -3998,10 +3999,10 @@ begin
exit; exit;
end; end;
if TryFractionStrToFloat(AValue, number, maxdig) then if TryFractionStrToFloat(AValue, number, ismixed, maxdig) then
begin begin
WriteNumber(ACell, number); WriteNumber(ACell, number);
WriteFractionFormat(ACell, true, maxdig, maxdig); WriteFractionFormat(ACell, ismixed, maxdig, maxdig);
exit; exit;
end; end;

158
components/fpspreadsheet/fpsutils.pas
View File

@@ -111,18 +111,10 @@ function AddAMPM(const ATimeFormatString: String;
function StripAMPM(const ATimeFormatString: String): String; function StripAMPM(const ATimeFormatString: String): String;
function CountDecs(AFormatString: String; ADecChars: TsDecsChars = ['0']): Byte; function CountDecs(AFormatString: String; ADecChars: TsDecsChars = ['0']): Byte;
function AddIntervalBrackets(AFormatString: String): String; function AddIntervalBrackets(AFormatString: String): String;
function DayNamesToString(const ADayNames: TWeekNameArray;
const AEmptyStr: String): String;
function MakeLongDateFormat(ADateFormat: String): String; function MakeLongDateFormat(ADateFormat: String): String;
function MakeShortDateFormat(ADateFormat: String): String; function MakeShortDateFormat(ADateFormat: String): String;
function MonthNamesToString(const AMonthNames: TMonthNameArray;
const AEmptyStr: String): String;
function SpecialDateTimeFormat(ACode: String; function SpecialDateTimeFormat(ACode: String;
const AFormatSettings: TFormatSettings; ForWriting: Boolean): String; const AFormatSettings: TFormatSettings; ForWriting: Boolean): String;
{
procedure SplitFormatString(const AFormatString: String; out APositivePart,
ANegativePart, AZeroPart: String);
}
procedure MakeTimeIntervalMask(Src: String; var Dest: String); procedure MakeTimeIntervalMask(Src: String; var Dest: String);
function ConvertFloatToStr(AValue: Double; AParams: TsNumFormatParams; function ConvertFloatToStr(AValue: Double; AParams: TsNumFormatParams;
@@ -132,10 +124,10 @@ procedure FloatToFraction(AValue: Double; AMaxDenominator: Int64;
function TryStrToFloatAuto(AText: String; out ANumber: Double; function TryStrToFloatAuto(AText: String; out ANumber: Double;
out ADecimalSeparator, AThousandSeparator: Char; out AWarning: String): Boolean; out ADecimalSeparator, AThousandSeparator: Char; out AWarning: String): Boolean;
function TryFractionStrToFloat(AText: String; out ANumber: Double; function TryFractionStrToFloat(AText: String; out ANumber: Double;
out AMaxDigits: Integer): Boolean; out AIsMixed: Boolean; out AMaxDigits: Integer): Boolean;
function TwipsToPts(AValue: Integer): Single; inline; function TwipsToPts(AValue: Integer): Single; inline;
function PtsToTwips(AValue: Single): Integer; inline; function PtsToTwips(AValue: Single): Integer; inline;
function cmToPts(AValue: Double): Double; inline; function cmToPts(AValue: Double): Double; inline;
function PtsToCm(AValue: Double): Double; inline; function PtsToCm(AValue: Double): Double; inline;
function InToMM(AValue: Double): Double; inline; function InToMM(AValue: Double): Double; inline;
@@ -1347,39 +1339,6 @@ begin
end; end;
end; end;
{@@ ----------------------------------------------------------------------------
Concatenates the day names specified in ADayNames to a single string. If all
daynames are empty AEmptyStr is returned
@param ADayNames Array[1..7] of day names as used in the Formatsettings
@param AEmptyStr Is returned if all day names are empty
@return String having all day names concatenated and separated by the
DefaultFormatSettings.ListSeparator
-------------------------------------------------------------------------------}
function DayNamesToString(const ADayNames: TWeekNameArray;
const AEmptyStr: String): String;
var
i: Integer;
isEmpty: Boolean;
begin
isEmpty := true;
for i:=1 to 7 do
if ADayNames[i] <> '' then
begin
isEmpty := false;
break;
end;
if isEmpty then
Result := AEmptyStr
else
begin
Result := ADayNames[1];
for i:=2 to 7 do
Result := Result + DefaultFormatSettings.ListSeparator + ' ' + ADayNames[i];
end;
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Approximates a floating point value as a fraction and returns the values of Approximates a floating point value as a fraction and returns the values of
numerator and denominator. numerator and denominator.
@@ -1532,39 +1491,6 @@ begin
end; end;
end; end;
{@@ ----------------------------------------------------------------------------
Concatenates the month names specified in AMonthNames to a single string.
If all month names are empty AEmptyStr is returned
@param AMonthNames Array[1..12] of month names as used in the Formatsettings
@param AEmptyStr Is returned if all month names are empty
@return String having all month names concatenated and separated by the
DefaultFormatSettings.ListSeparator
-------------------------------------------------------------------------------}
function MonthNamesToString(const AMonthNames: TMonthNameArray;
const AEmptyStr: String): String;
var
i: Integer;
isEmpty: Boolean;
begin
isEmpty := true;
for i:=1 to 12 do
if AMonthNames[i] <> '' then
begin
isEmpty := false;
break;
end;
if isEmpty then
Result := AEmptyStr
else
begin
Result := AMonthNames[1];
for i:=2 to 12 do
Result := Result + DefaultFormatSettings.ListSeparator + ' ' + AMonthNames[i];
end;
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Creates the formatstrings for the date/time codes "dm", "my", "ms" and "msz" Creates the formatstrings for the date/time codes "dm", "my", "ms" and "msz"
out of the formatsettings. out of the formatsettings.
@@ -1610,81 +1536,6 @@ begin
Result := ACode; Result := ACode;
end; end;
{@@ ----------------------------------------------------------------------------
Currency formatting strings consist of three parts, separated by
semicolons, which are valid for positive, negative or zero values.
Splits such a formatting string at the positions of the semicolons and
returns the sections. If semicolons are used for other purposed within
sections they have to be quoted by " or escaped by \. If the formatting
string contains less sections than three the missing strings are returned
as empty strings.
@param AFormatString String of number formatting codes.
@param APositivePart First section of the formatting string which is valid
for positive numbers (or positive and zero, if there
are only two sections)
@param ANegativePart Second section of the formatting string which is valid
for negative numbers
@param AZeroPart Third section of the formatting string for zero.
-------------------------------------------------------------------------------}
(*
procedure SplitFormatString(const AFormatString: String; out APositivePart,
ANegativePart, AZeroPart: String);
procedure AddToken(AToken: Char; AWhere:Byte);
begin
case AWhere of
0: APositivePart := APositivePart + AToken;
1: ANegativePart := ANegativePart + AToken;
2: AZeroPart := AZeroPart + AToken;
end;
end;
var
P, PStart, PEnd: PChar;
token: Char;
where: Byte; // 0 = positive part, 1 = negative part, 2 = zero part
begin
APositivePart := '';
ANegativePart := '';
AZeroPart := '';
if AFormatString = '' then
exit;
PStart := PChar(@AFormatString[1]);
PEnd := PStart + Length(AFormatString);
P := PStart;
where := 0;
while P < PEnd do begin
token := P^;
case token of
'"': begin // Let quoted text intact
AddToken(token, where);
inc(P);
token := P^;
while (P < PEnd) and (token <> '"') do begin
AddToken(token, where);
inc(P);
token := P^;
end;
AddToken(token, where);
end;
';': begin // Separator between parts
inc(where);
if where = 3 then
exit;
end;
'\': begin // Skip "Escape" character and add next char immediately
inc(P);
token := P^;
AddToken(token, where);
end;
else AddToken(token, where);
end;
inc(P);
end;
end;
*)
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Creates a "time interval" format string having the first time code identifier Creates a "time interval" format string having the first time code identifier
in square brackets. in square brackets.
@@ -1894,7 +1745,7 @@ end;
@example AText := '1 3/4' --> ANumber = 1.75; AMaxDigits = 1; Result = true @example AText := '1 3/4' --> ANumber = 1.75; AMaxDigits = 1; Result = true
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TryFractionStrToFloat(AText: String; out ANumber: Double; function TryFractionStrToFloat(AText: String; out ANumber: Double;
out AMaxDigits: Integer): Boolean; out AIsMixed: Boolean; out AMaxDigits: Integer): Boolean;
var var
p: Integer; p: Integer;
s, sInt, sNum, sDenom: String; s, sInt, sNum, sDenom: String;
@@ -1931,6 +1782,7 @@ begin
if sInt <> '' then if sInt <> '' then
ANumber := ANumber + i; ANumber := ANumber + i;
AIsMixed := (sInt <> '');
AMaxDigits := Length(sDenom); AMaxDigits := Length(sDenom);
Result := true; Result := true;

10
components/fpspreadsheet/tests/formattests.pas
View File

@@ -27,10 +27,10 @@ var
SollNumberFormats: array[0..9] of TsNumberFormat; SollNumberFormats: array[0..9] of TsNumberFormat;
SollNumberDecimals: array[0..9] of word; SollNumberDecimals: array[0..9] of word;
SollDateTimeStrings: array[0..4, 0..9] of string; SollDateTimeStrings: array[0..4, 0..8] of string;
SollDateTimes: array[0..4] of TDateTime; SollDateTimes: array[0..4] of TDateTime;
SollDateTimeFormats: array[0..9] of TsNumberFormat; SollDateTimeFormats: array[0..8] of TsNumberFormat;
SollDateTimeFormatStrings: array[0..9] of String; SollDateTimeFormatStrings: array[0..8] of String;
SollColWidths: array[0..1] of Single; SollColWidths: array[0..1] of Single;
SollRowHeights: Array[0..2] of Single; SollRowHeights: Array[0..2] of Single;
@@ -256,7 +256,7 @@ begin
SollDateTimeFormats[6] := nfCustom; SollDateTimeFormatStrings[6] := 'dd/mmm'; SollDateTimeFormats[6] := nfCustom; SollDateTimeFormatStrings[6] := 'dd/mmm';
SolLDateTimeFormats[7] := nfCustom; SollDateTimeFormatStrings[7] := 'mmm/yy'; SolLDateTimeFormats[7] := nfCustom; SollDateTimeFormatStrings[7] := 'mmm/yy';
SollDateTimeFormats[8] := nfCustom; SollDateTimeFormatStrings[8] := 'nn:ss'; SollDateTimeFormats[8] := nfCustom; SollDateTimeFormatStrings[8] := 'nn:ss';
SollDateTimeFormats[9] := nfTimeInterval; SollDateTimeFormatStrings[9] := ''; // SollDateTimeFormats[9] := nfTimeInterval; SollDateTimeFormatStrings[9] := '';
for i:=Low(SollDateTimes) to High(SollDateTimes) do for i:=Low(SollDateTimes) to High(SollDateTimes) do
begin begin
@@ -269,7 +269,7 @@ begin
SollDateTimeStrings[i, 6] := FormatDateTime(SpecialDateTimeFormat('dm', fs, false), SollDateTimes[i], fs); SollDateTimeStrings[i, 6] := FormatDateTime(SpecialDateTimeFormat('dm', fs, false), SollDateTimes[i], fs);
SollDateTimeStrings[i, 7] := FormatDateTime(SpecialDateTimeFormat('my', fs, false), SollDateTimes[i], fs); SollDateTimeStrings[i, 7] := FormatDateTime(SpecialDateTimeFormat('my', fs, false), SollDateTimes[i], fs);
SollDateTimeStrings[i, 8] := FormatDateTime(SpecialDateTimeFormat('ms', fs, false), SollDateTimes[i], fs); SollDateTimeStrings[i, 8] := FormatDateTime(SpecialDateTimeFormat('ms', fs, false), SollDateTimes[i], fs);
SollDateTimeStrings[i, 9] := FormatDateTime('[h]:mm:ss', SollDateTimes[i], fs, [fdoInterval]); // SollDateTimeStrings[i, 9] := FormatDateTime('[h]:mm:ss', SollDateTimes[i], fs, [fdoInterval]);
end; end;
// Column width // Column width