mirrors/doublecmd
2
0
Fork 0
mirror of https://github.com/doublecmd/doublecmd.git synced 2026-06-21 09:58:13 +00:00
Code Issues Projects Releases Packages Wiki Activity
doublecmd/src/fpscommon.pas
Alexander Koblov 554a216fa3 FIX: File mode
2021-10-31 11:10:46 +03:00

572 lines
20 KiB
ObjectPascal
Raw Blame History

unit fpsCommon;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
const
{@@ These are some basic rgb color volues. FPSpreadsheet will support
only those built-in color constants originating in the EGA palette.
}
{@@ rgb value of @bold(black) color, BIFF2 palette index 0, BIFF8 index 8}
scBlack = $00000000;
{@@ rgb value of @bold(white) color, BIFF2 palette index 1, BIFF8 index 9 }
scWhite = $00FFFFFF;
{@@ rgb value of @bold(red) color, BIFF2 palette index 2, BIFF8 index 10 }
scRed = $000000FF;
{@@ rgb value of @bold(green) color, BIFF2 palette index 3, BIFF8 index 11 }
scGreen = $0000FF00;
{@@ rgb value of @bold(blue) color, BIFF2 palette index 4, BIFF8 indexes 12 and 39}
scBlue = $00FF0000;
{@@ rgb value of @bold(yellow) color, BIFF2 palette index 5, BIFF8 indexes 13 and 34}
scYellow = $0000FFFF;
{@@ rgb value of @bold(magenta) color, BIFF2 palette index 6, BIFF8 index 14 and 33}
scMagenta = $00FF00FF;
{@@ rgb value of @bold(cyan) color, BIFF2 palette index 7, BIFF8 indexes 15}
scCyan = $00FFFF00;
type
{@@ Colors in fpspreadsheet are given as rgb values in little-endian notation
(i.e. "r" is the low-value byte). The highest-value byte, if not zero,
indicates special colors.
@note(This byte order in TsColor is opposite to that in HTML colors.) }
TsColor = DWord;
{@@ Builtin number formats. Only uses a subset of the default formats,
enough to be able to read/write date/time values.
nfCustom allows to apply a format string directly. }
TsNumberFormat = (
// general-purpose for all numbers
nfGeneral,
// numbers
nfFixed, nfFixedTh, nfExp, nfPercentage, nfFraction,
// currency
nfCurrency, nfCurrencyRed,
// dates and times
nfShortDateTime, nfShortDate, nfLongDate, nfShortTime, nfLongTime,
nfShortTimeAM, nfLongTimeAM, nfDayMonth, nfMonthYear, nfTimeInterval,
// text
nfText,
// other (format string goes directly into the file)
nfCustom);
{@@ Ancestor of the fpSpreadsheet exceptions }
EFpSpreadsheet = class(Exception);
resourcestring
// Format
rsAmbiguousDecThouSeparator = 'Assuming usage of decimal separator in "%s".';
function Round(AValue: Double): Int64;
procedure FloatToFraction(AValue: Double; AMaxDenominator: Int64;
out ANumerator, ADenominator: Int64);
function TryStrToFloatAuto(AText: String; out ANumber: Double;
out ADecimalSeparator, AThousandSeparator: Char; out AWarning: String): Boolean;
procedure AddBuiltinBiffFormats(AList: TStringList;
AFormatSettings: TFormatSettings; ALastIndex: Integer);
procedure RegisterCurrency(ACurrencySymbol: String);
procedure RegisterCurrencies(AList: TStrings; AReplace: Boolean);
procedure UnregisterCurrency(ACurrencySymbol: String);
function CurrencyRegistered(ACurrencySymbol: String): Boolean;
procedure GetRegisteredCurrencies(AList: TStrings);
function IsNegative(var AText: String): Boolean;
function RemoveCurrencySymbol(ACurrencySymbol: String;
var AText: String): Boolean;
function TryStrToCurrency(AText: String; out ANumber: Double;
out ACurrencySymbol:String; const AFormatSettings: TFormatSettings): boolean;
implementation
uses
Math, fpsNumFormat;
{@@ ----------------------------------------------------------------------------
Special rounding function which avoids banker's rounding
-------------------------------------------------------------------------------}
function Round(AValue: Double): Int64;
begin
if AValue > 0 then
Result := trunc(AValue + 0.5)
else
Result := trunc(AValue - 0.5);
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 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; AMaxDenominator: Int64;
out ANumerator, ADenominator: Int64);
// Uses method of continued fractions, adapted version from a function in
// Bart Broersma's fractions.pp unit:
// http://svn.code.sf.net/p/flyingsheep/code/trunk/ConsoleProjecten/fractions/
const
MaxInt64 = High(Int64);
MinInt64 = Low(Int64);
var
H1, H2, K1, K2, A, NewA, tmp, prevH1, prevK1: Int64;
B, test, diff, prevdiff: Double;
PendingOverflow: Boolean;
i: Integer = 0;
begin
if (AValue > MaxInt64) or (AValue < MinInt64) then
raise EFPSpreadsheet.Create('Range error');
if abs(AValue) < 0.5 / AMaxDenominator then
begin
ANumerator := 0;
ADenominator := AMaxDenominator;
exit;
end;
H1 := 1;
H2 := 0;
K1 := 0;
K2 := 1;
B := AValue;
NewA := Round(Floor(B));
prevH1 := H1;
prevK1 := K1;
prevdiff := 1E308;
repeat
inc(i);
A := NewA;
tmp := H1;
H1 := A * H1 + H2;
H2 := tmp;
tmp := K1;
K1 := A * K1 + K2;
K2 := tmp;
test := H1/K1;
diff := test - AValue;
{ Use the previous result if the denominator becomes larger than the allowed
value, or if the difference becomes worse because the "best" result has
been missed due to rounding error - this is more stable than using a
predefined precision in comparing diff with zero. }
if (abs(K1) >= AMaxDenominator) or (abs(diff) > abs(prevdiff)) then
begin
H1 := prevH1;
K1 := prevK1;
break;
end;
if (Abs(B - A) < 1E-30) then
B := 1E30 //happens when H1/K1 exactly matches Value
else
B := 1 / (B - A);
PendingOverFlow := (B * H1 + H2 > MaxInt64) or
(B * K1 + K2 > MaxInt64) or
(B > MaxInt64);
if not PendingOverflow then
NewA := Round(Floor(B));
prevH1 := H1;
prevK1 := K1;
prevdiff := diff;
until PendingOverflow;
ANumerator := H1;
ADenominator := K1;
end;
{@@ ----------------------------------------------------------------------------
Converts a string to a floating point number. No assumption on decimal and
thousand separator are made.
Is needed for reading CSV files.
-------------------------------------------------------------------------------}
function TryStrToFloatAuto(AText: String; out ANumber: Double;
out ADecimalSeparator, AThousandSeparator: Char; out AWarning: String): Boolean;
var
i: Integer;
testSep: Char;
testSepPos: Integer;
lastDigitPos: Integer;
isPercent: Boolean;
fs: TFormatSettings;
done: Boolean;
begin
Result := false;
AWarning := '';
ADecimalSeparator := #0;
AThousandSeparator := #0;
if AText = '' then
exit;
fs := DefaultFormatSettings;
// We scan the string starting from its end. If we find a point or a comma,
// we have a candidate for the decimal or thousand separator. If we find
// the same character again it was a thousand separator, if not it was
// a decimal separator.
// There is one amgiguity: Using a thousand separator for number < 1.000.000,
// but no decimal separator misinterprets the thousand separator as a
// decimal separator.
done := false; // Indicates that both decimal and thousand separators are found
testSep := #0; // Separator candidate to be tested
testSepPos := 0; // Position of this separator candidate in the string
lastDigitPos := 0; // Position of the last numerical digit
isPercent := false; // Flag for percentage format
i := Length(AText); // Start at end...
while i >= 1 do // ...and search towards start
begin
case AText[i] of
'0'..'9':
if (lastDigitPos = 0) and (AText[i] in ['0'..'9']) then
lastDigitPos := i;
'e', 'E':
;
'%':
begin
isPercent := true;
// There may be spaces before the % sign which we don't want
dec(i);
while (i >= 1) do
if AText[i] = ' ' then
dec(i)
else
begin
inc(i);
break;
end;
end;
'+', '-':
;
'.', ',':
begin
if testSep = #0 then begin
testSep := AText[i];
testSepPos := i;
end;
// This is the right-most separator candidate in the text
// It can be a decimal or a thousand separator.
// Therefore, we continue searching from here.
dec(i);
while i >= 1 do
begin
if not (AText[i] in ['0'..'9', '+', '-', '.', ',']) then
exit;
// If we find the testSep character again it must be a thousand separator,
// and there are no decimals.
if (AText[i] = testSep) then
begin
// ... but only if there are 3 numerical digits in between
if (testSepPos - i = 4) then
begin
fs.ThousandSeparator := testSep;
// The decimal separator is the "other" character.
if testSep = '.' then
fs.DecimalSeparator := ','
else
fs.DecimalSeparator := '.';
AThousandSeparator := fs.ThousandSeparator;
ADecimalSeparator := #0; // this indicates that there are no decimals
done := true;
i := 0;
end else
begin
Result := false;
exit;
end;
end
else
// If we find the "other" separator character, then testSep was a
// decimal separator and the current character is a thousand separator.
// But there must be 3 digits in between.
if AText[i] in ['.', ','] then
begin
if testSepPos - i <> 4 then // no 3 digits in between --> no number, maybe a date.
exit;
fs.DecimalSeparator := testSep;
fs.ThousandSeparator := AText[i];
ADecimalSeparator := fs.DecimalSeparator;
AThousandSeparator := fs.ThousandSeparator;
done := true;
i := 0;
end;
dec(i);
end;
end;
else
exit; // Non-numeric character found, no need to continue
end;
dec(i);
end;
// Only one separator candicate found, we assume it is a decimal separator
if (testSep <> #0) and not done then
begin
// Warning in case of ambiguous detection of separator. If only one separator
// type is found and it is at the third position from the string's end it
// might by a thousand separator or a decimal separator. We assume the
// latter case, but create a warning.
if (lastDigitPos - testSepPos = 3) and not isPercent then
AWarning := Format(rsAmbiguousDecThouSeparator, [AText]);
fs.DecimalSeparator := testSep;
ADecimalSeparator := fs.DecimalSeparator;
// Make sure that the thousand separator is different from the decimal sep.
if testSep = '.' then fs.ThousandSeparator := ',' else fs.ThousandSeparator := '.';
end;
// Delete all thousand separators from the string - StrToFloat does not like them...
AText := StringReplace(AText, fs.ThousandSeparator, '', [rfReplaceAll]);
// Is the last character a percent sign?
if isPercent then
while (Length(AText) > 0) and (AText[Length(AText)] in ['%', ' ']) do
Delete(AText, Length(AText), 1);
// Try string-to-number conversion
Result := TryStrToFloat(AText, ANumber, fs);
// If successful ...
if Result then
begin
// ... take care of the percentage sign
if isPercent then
ANumber := ANumber * 0.01;
end;
end;
{@@ ----------------------------------------------------------------------------
These are the built-in number formats as expected in the biff spreadsheet file.
In BIFF5+ they are not written to file but they are used for lookup of the
number format that Excel used.
-------------------------------------------------------------------------------}
procedure AddBuiltinBiffFormats(AList: TStringList;
AFormatSettings: TFormatSettings; ALastIndex: Integer);
var
fs: TFormatSettings absolute AFormatSettings;
cs: String;
i: Integer;
begin
cs := fs.CurrencyString;
AList.Clear;
AList.Add(''); // 0
AList.Add('0'); // 1
AList.Add('0.00'); // 2
AList.Add('#,##0'); // 3
AList.Add('#,##0.00'); // 4
AList.Add(BuildCurrencyFormatString(nfCurrency, fs, 0, fs.CurrencyFormat, fs.NegCurrFormat, cs)); // 5
AList.Add(BuildCurrencyFormatString(nfCurrencyRed, fs, 0, fs.CurrencyFormat, fs.NegCurrFormat, cs)); // 6
AList.Add(BuildCurrencyFormatString(nfCurrency, fs, 2, fs.CurrencyFormat, fs.NegCurrFormat, cs)); // 7
AList.Add(BuildCurrencyFormatString(nfCurrencyRed, fs, 2, fs.CurrencyFormat, fs.NegCurrFormat, cs)); // 8
AList.Add('0%'); // 9
AList.Add('0.00%'); // 10
AList.Add('0.00E+00'); // 11
AList.Add('# ?/?'); // 12
AList.Add('# ??/??'); // 13
AList.Add(BuildDateTimeFormatString(nfShortDate, fs)); // 14
AList.Add(BuildDateTimeFormatString(nfLongdate, fs)); // 15
AList.Add(BuildDateTimeFormatString(nfDayMonth, fs)); // 16: 'd/mmm'
AList.Add(BuildDateTimeFormatString(nfMonthYear, fs)); // 17: 'mmm/yy'
AList.Add(BuildDateTimeFormatString(nfShortTimeAM, fs)); // 18
AList.Add(BuildDateTimeFormatString(nfLongTimeAM, fs)); // 19
AList.Add(BuildDateTimeFormatString(nfShortTime, fs)); // 20
AList.Add(BuildDateTimeFormatString(nfLongTime, fs)); // 21
AList.Add(BuildDateTimeFormatString(nfShortDateTime, fs)); // 22
for i:=23 to 36 do
AList.Add(''); // not supported
AList.Add('_(#,##0_);(#,##0)'); // 37
AList.Add('_(#,##0_);[Red](#,##0)'); // 38
AList.Add('_(#,##0.00_);(#,##0.00)'); // 39
AList.Add('_(#,##0.00_);[Red](#,##0.00)'); // 40
AList.Add('_("'+cs+'"* #,##0_);_("'+cs+'"* (#,##0);_("'+cs+'"* "-"_);_(@_)'); // 41
AList.Add('_(* #,##0_);_(* (#,##0);_(* "-"_);_(@_)'); // 42
AList.Add('_("'+cs+'"* #,##0.00_);_("'+cs+'"* (#,##0.00);_("'+cs+'"* "-"??_);_(@_)'); // 43
AList.Add('_(* #,##0.00_);_(* (#,##0.00);_(* "-"??_);_(@_)'); // 44
AList.Add('nn:ss'); // 45
AList.Add('[h]:nn:ss'); // 46
AList.Add('nn:ss.z'); // 47
AList.Add('##0.0E+00'); // 48
AList.Add('@'); // 49 "Text" format
for i:=50 to ALastIndex do AList.Add(''); // not supported/used
end;
var
CurrencyList: TStrings = nil;
{@@ ----------------------------------------------------------------------------
Registers a currency symbol UTF8 string for usage by fpspreadsheet
Currency symbols are the key for detection of currency values. In order to
reckognize strings are currency symbols they have to be registered in the
internal CurrencyList.
Registration occurs automatically for USD, "$", the currencystring defined
in the DefaultFormatSettings and for the currency symbols used explicitly
when calling WriteCurrency or WriteNumerFormat.
-------------------------------------------------------------------------------}
procedure RegisterCurrency(ACurrencySymbol: String);
begin
if not CurrencyRegistered(ACurrencySymbol) and (ACurrencySymbol <> '') then
CurrencyList.Add(ACurrencySymbol);
end;
{@@ RegisterCurrencies registers the currency strings contained in the string list
If AReplace is true, the list replaces the currently registered list.
-------------------------------------------------------------------------------}
procedure RegisterCurrencies(AList: TStrings; AReplace: Boolean);
var
i: Integer;
begin
if AList = nil then
exit;
if AReplace then CurrencyList.Clear;
for i:=0 to AList.Count-1 do
RegisterCurrency(AList[i]);
end;
{@@ ----------------------------------------------------------------------------
Removes registration of a currency symbol string for usage by fpspreadsheet
-------------------------------------------------------------------------------}
procedure UnregisterCurrency(ACurrencySymbol: String);
var
i: Integer;
begin
i := CurrencyList.IndexOf(ACurrencySymbol);
if i <> -1 then CurrencyList.Delete(i);
end;
{@@ ----------------------------------------------------------------------------
Checks whether a string is registered as valid currency symbol string
-------------------------------------------------------------------------------}
function CurrencyRegistered(ACurrencySymbol: String): Boolean;
begin
Result := CurrencyList.IndexOf(ACurrencySymbol) <> -1;
end;
{@@ ----------------------------------------------------------------------------
Writes all registered currency symbols to a string list
-------------------------------------------------------------------------------}
procedure GetRegisteredCurrencies(AList: TStrings);
begin
AList.Clear;
AList.Assign(CurrencyList);
end;
{@@ ----------------------------------------------------------------------------
Checks whether the given number string is a negative value. In case of
currency value, this can be indicated by brackets, or a minus sign at string
start or end.
-------------------------------------------------------------------------------}
function IsNegative(var AText: String): Boolean;
begin
Result := false;
if AText = '' then
exit;
if (AText[1] = '(') and (AText[Length(AText)] = ')') then
begin
Result := true;
Delete(AText, 1, 1);
Delete(AText, Length(AText), 1);
AText := Trim(AText);
end else
if (AText[1] = '-') then
begin
Result := true;
Delete(AText, 1, 1);
AText := Trim(AText);
end else
if (AText[Length(AText)] = '-') then
begin
Result := true;
Delete(AText, Length(AText), 1);
AText := Trim(AText);
end;
end;
{@@ ----------------------------------------------------------------------------
Checks wheter a specified currency symbol is contained in a string, removes
the currency symbol and returns the remaining string.
-------------------------------------------------------------------------------}
function RemoveCurrencySymbol(ACurrencySymbol: String; var AText: String): Boolean;
var
p: Integer;
begin
p := pos(ACurrencySymbol, AText);
if p > 0 then
begin
Delete(AText, p, Length(ACurrencySymbol));
AText := Trim(AText);
Result := true;
end else
Result := false;
end;
{@@ ----------------------------------------------------------------------------
Checks whether a string is a number with attached currency symbol. Looks also
for negative values in brackets.
-------------------------------------------------------------------------------}
function TryStrToCurrency(AText: String; out ANumber: Double;
out ACurrencySymbol:String; const AFormatSettings: TFormatSettings): boolean;
var
i: Integer;
s: String;
isNeg: Boolean;
begin
Result := false;
ANumber := 0.0;
ACurrencySymbol := '';
// Check the text for the presence of each known curreny symbol
for i:= 0 to CurrencyList.Count-1 do
begin
// Store string in temporary variable since it will be modified
s := AText;
// Check for this currency sign being contained in the string, remove it if found.
if RemoveCurrencySymbol(CurrencyList[i], s) then
begin
// Check for negative signs and remove them, but keep this information
isNeg := IsNegative(s);
// Try to convert remaining string to number
if TryStrToFloat(s, ANumber, AFormatSettings) then begin
// if successful: take care of negative values
if isNeg then ANumber := -ANumber;
ACurrencySymbol := CurrencyList[i];
Result := true;
exit;
end;
end;
end;
end;
initialization
// Known currency symbols
CurrencyList := TStringList.Create;
with TStringList(CurrencyList) do
begin
CaseSensitive := false;
Duplicates := dupIgnore;
end;
RegisterCurrency('USD');
RegisterCurrency('$');
RegisterCurrency(AnsiToUTF8(DefaultFormatSettings.CurrencyString));
finalization
FreeAndNil(CurrencyList);
end.
Reference in a new issue View git blame Copy permalink