From 0396e0805dcca4ecd39f3222e6946788506d4663 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Wed, 29 Oct 2014 16:39:49 +0000 Subject: [PATCH] fpspreadsheet: Registration of currency symbols. Add currency dialog to spready. Automatic detection of currencies in in worksheet.WriteCellAsNumber. Avoid redundant code in csv reader's currency detection. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3698 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../examples/spready/mainform.lfm | 11 +- .../examples/spready/mainform.pas | 19 +- .../examples/spready/sfcurrencyform.lfm | 81 ++++++++ .../examples/spready/sfcurrencyform.pas | 78 +++++++ .../examples/spready/spready.lpi | 14 +- .../examples/spready/spready.lpr | 5 +- components/fpspreadsheet/fpscsv.pas | 21 +- components/fpspreadsheet/fpscurrency.pas | 190 ++++++++++++++++++ .../fpspreadsheet/fpsnumformatparser.pas | 12 +- components/fpspreadsheet/fpspreadsheet.pas | 43 ++-- 10 files changed, 439 insertions(+), 35 deletions(-) create mode 100644 components/fpspreadsheet/examples/spready/sfcurrencyform.lfm create mode 100644 components/fpspreadsheet/examples/spready/sfcurrencyform.pas create mode 100644 components/fpspreadsheet/fpscurrency.pas diff --git a/components/fpspreadsheet/examples/spready/mainform.lfm b/components/fpspreadsheet/examples/spready/mainform.lfm index 76d32ffab..ec2694de1 100644 --- a/components/fpspreadsheet/examples/spready/mainform.lfm +++ b/components/fpspreadsheet/examples/spready/mainform.lfm @@ -1413,12 +1413,15 @@ object MainFrm: TMainFrm end object MnuSettings: TMenuItem Caption = 'Settings' - object MenuItem75: TMenuItem + object MnuNumberFormatSettings: TMenuItem Action = AcFormatSettings end object MnuCSVParams: TMenuItem Action = AcCSVParams end + object MnuCurrencySymbol: TMenuItem + Action = AcCurrencySymbols + end end end object ImageList: TImageList @@ -3216,6 +3219,12 @@ object MainFrm: TMainFrm Hint = 'Sort selected range' OnExecute = AcSortExecute end + object AcCurrencySymbols: TAction + Category = 'Settings' + Caption = 'Currency symbols...' + Hint = 'Names and symbols known as valid currencies' + OnExecute = AcCurrencySymbolsExecute + end end object FontDialog: TFontDialog MinFontSize = 0 diff --git a/components/fpspreadsheet/examples/spready/mainform.pas b/components/fpspreadsheet/examples/spready/mainform.pas index dee8b5845..13e7ab18b 100644 --- a/components/fpspreadsheet/examples/spready/mainform.pas +++ b/components/fpspreadsheet/examples/spready/mainform.pas @@ -81,6 +81,7 @@ type AcFormatSettings: TAction; AcSortColAsc: TAction; AcSort: TAction; + AcCurrencySymbols: TAction; AcViewInspector: TAction; AcWordwrap: TAction; AcVAlignDefault: TAction; @@ -170,11 +171,12 @@ type MenuItem72: TMenuItem; MenuItem73: TMenuItem; MenuItem74: TMenuItem; - MenuItem75: TMenuItem; + MnuNumberFormatSettings: TMenuItem; MenuItem76: TMenuItem; MenuItem77: TMenuItem; MenuItem78: TMenuItem; MenuItem79: TMenuItem; + MnuCurrencySymbol: TMenuItem; MnuCSVParams: TMenuItem; MnuSettings: TMenuItem; mnuInspector: TMenuItem; @@ -279,6 +281,7 @@ type procedure AcBorderExecute(Sender: TObject); procedure AcCopyFormatExecute(Sender: TObject); procedure AcCSVParamsExecute(Sender: TObject); + procedure AcCurrencySymbolsExecute(Sender: TObject); procedure AcDeleteColumnExecute(Sender: TObject); procedure AcDeleteRowExecute(Sender: TObject); procedure AcEditExecute(Sender: TObject); @@ -350,7 +353,7 @@ implementation uses TypInfo, LCLIntf, LCLType, fpcanvas, fpsutils, fpscsv, - sFormatSettingsForm, sCSVParamsForm, sSortParamsForm; + sFormatSettingsForm, sCSVParamsForm, sSortParamsForm, sfCurrencyForm; const DROPDOWN_COUNT = 24; @@ -519,6 +522,18 @@ begin end; end; +procedure TMainFrm.AcCurrencySymbolsExecute(Sender: TObject); +var + F: TCurrencyForm; +begin + F := TCurrencyForm.Create(nil); + try + F.ShowModal; + finally + F.Free; + end; +end; + procedure TMainFrm.AcDeleteColumnExecute(Sender: TObject); var c: Integer; diff --git a/components/fpspreadsheet/examples/spready/sfcurrencyform.lfm b/components/fpspreadsheet/examples/spready/sfcurrencyform.lfm new file mode 100644 index 000000000..e9c75f8d6 --- /dev/null +++ b/components/fpspreadsheet/examples/spready/sfcurrencyform.lfm @@ -0,0 +1,81 @@ +object CurrencyForm: TCurrencyForm + Left = 361 + Height = 324 + Top = 177 + Width = 278 + Caption = 'Currency symbols' + ClientHeight = 324 + ClientWidth = 278 + Constraints.MinHeight = 166 + Constraints.MinWidth = 172 + OnCreate = FormCreate + Position = poMainFormCenter + LCLVersion = '1.3' + object ButtonPanel: TButtonPanel + Left = 6 + Height = 38 + Top = 280 + Width = 266 + OKButton.Name = 'OKButton' + OKButton.DefaultCaption = True + OKButton.OnClick = OKButtonClick + HelpButton.Name = 'HelpButton' + HelpButton.DefaultCaption = True + CloseButton.Name = 'CloseButton' + CloseButton.DefaultCaption = True + CancelButton.Name = 'CancelButton' + CancelButton.DefaultCaption = True + TabOrder = 2 + ShowButtons = [pbOK, pbCancel] + end + object LblInfo: TLabel + Left = 4 + Height = 20 + Top = 46 + Width = 270 + Align = alTop + BorderSpacing.Around = 4 + Caption = 'These strings indicate currencies:' + ParentColor = False + WordWrap = True + end + object Panel1: TPanel + Left = 0 + Height = 42 + Top = 0 + Width = 278 + Align = alTop + BevelOuter = bvNone + ClientHeight = 42 + ClientWidth = 278 + TabOrder = 0 + object BtnAdd: TBitBtn + Left = 8 + Height = 30 + Top = 8 + Width = 75 + Caption = 'Add' + OnClick = BtnAddClick + TabOrder = 0 + end + object BtnDelete: TBitBtn + Left = 88 + Height = 30 + Top = 8 + Width = 75 + Caption = 'Delete' + OnClick = BtnDeleteClick + TabOrder = 1 + end + end + object CurrencyListbox: TListBox + Left = 4 + Height = 204 + Top = 70 + Width = 270 + Align = alClient + BorderSpacing.Around = 4 + ItemHeight = 0 + TabOrder = 1 + end +end diff --git a/components/fpspreadsheet/examples/spready/sfcurrencyform.pas b/components/fpspreadsheet/examples/spready/sfcurrencyform.pas new file mode 100644 index 000000000..20284729a --- /dev/null +++ b/components/fpspreadsheet/examples/spready/sfcurrencyform.pas @@ -0,0 +1,78 @@ +unit sfCurrencyForm; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + ButtonPanel, StdCtrls, ExtCtrls, Buttons; + +type + + { TCurrencyForm } + + TCurrencyForm = class(TForm) + BtnAdd: TBitBtn; + BtnDelete: TBitBtn; + ButtonPanel: TButtonPanel; + LblInfo: TLabel; + CurrencyListbox: TListBox; + Panel1: TPanel; + procedure BtnAddClick(Sender: TObject); + procedure BtnDeleteClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure OKButtonClick(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + CurrencyForm: TCurrencyForm; + +implementation + +uses + fpscurrency; + +{ TCurrencyForm } + +procedure TCurrencyForm.FormCreate(Sender: TObject); +begin + GetRegisteredCurrencies(CurrencyListbox.Items); + CurrencyListbox.ItemIndex := CurrencyListbox.Items.Count-1; +end; + +procedure TCurrencyForm.BtnAddClick(Sender: TObject); +var + s: String; + i: Integer; +begin + s := InputBox('Input', 'Currency symbol:', ''); + if s <> '' then begin + i := CurrencyListbox.Items.IndexOf(s); + if i = -1 then + i := CurrencyListbox.Items.Add(s); + CurrencyListbox.ItemIndex := i; + end; +end; + +procedure TCurrencyForm.BtnDeleteClick(Sender: TObject); +begin + if CurrencyListbox.ItemIndex > -1 then + CurrencyListbox.Items.Delete(CurrencyListbox.ItemIndex); +end; + +procedure TCurrencyForm.OKButtonClick(Sender: TObject); +begin + RegisterCurrencies(CurrencyListbox.Items, true); +end; + + +initialization + {$I sfCurrencyForm.lrs} + +end. + diff --git a/components/fpspreadsheet/examples/spready/spready.lpi b/components/fpspreadsheet/examples/spready/spready.lpi index b4a42713e..636f792a1 100644 --- a/components/fpspreadsheet/examples/spready/spready.lpi +++ b/components/fpspreadsheet/examples/spready/spready.lpi @@ -92,7 +92,7 @@ - + @@ -134,6 +134,18 @@ + + + + + + + + + + + + diff --git a/components/fpspreadsheet/examples/spready/spready.lpr b/components/fpspreadsheet/examples/spready/spready.lpr index c16b07fb4..777fb9e95 100644 --- a/components/fpspreadsheet/examples/spready/spready.lpr +++ b/components/fpspreadsheet/examples/spready/spready.lpr @@ -4,8 +4,8 @@ program spready; uses Interfaces, // this includes the LCL widgetset - Forms, mainform, laz_fpspreadsheet_visual, -sCSVParamsForm, sCtrls, sFormatSettingsForm, sSortParamsForm; + Forms, mainform, laz_fpspreadsheet_visual, sCSVParamsForm, sCtrls, + sFormatSettingsForm, sSortParamsForm, sfCurrencyForm, fpsCurrency; {$R *.res} @@ -15,6 +15,7 @@ begin MainFrm.BeforeRun; Application.CreateForm(TFormatSettingsForm, FormatSettingsForm); Application.CreateForm(TSortParamsForm, SortParamsForm); + Application.CreateForm(TCurrencyForm, CurrencyForm); Application.Run; end. diff --git a/components/fpspreadsheet/fpscsv.pas b/components/fpspreadsheet/fpscsv.pas index 417fb9bf0..6d134f6a4 100644 --- a/components/fpspreadsheet/fpscsv.pas +++ b/components/fpspreadsheet/fpscsv.pas @@ -91,7 +91,7 @@ function LineEndingAsString(ALineEnding: TsCSVLineEnding): String; implementation uses - StrUtils, DateUtils, LConvEncoding, Math, fpsutils; + StrUtils, DateUtils, LConvEncoding, Math, fpsutils, fpscurrency; { Initializes the FormatSettings of the CSVParams to default values which can be replaced by the FormatSettings of the workbook's FormatSettings } @@ -237,15 +237,14 @@ begin ACurrencySymbol := StrUtils.IfThen(CSVParams.FormatSettings.CurrencyString = '', FWorkbook.FormatSettings.CurrencyString, CSVParams.FormatSettings.CurrencyString); - p := pos(ACurrencySymbol, AText); - if p > 0 then begin - Delete(AText, p, Length(ACurrencySymbol)); - AText := Trim(AText); - if AText = '' then - exit; - // Negative financial values are often enclosed by parenthesis - if ((AText[1] = '(') and (AText[Length(AText)] = ')')) then - AText := '-' + Trim(Copy(AText, 2, Length(AText)-2)); + if RemoveCurrencySymbol(ACurrencySymbol, AText) then + begin + if IsNegative(AText) then + begin + if AText = '' then + exit; + AText := '-' + AText; + end; end else ACurrencySymbol := ''; @@ -360,7 +359,7 @@ begin if IsNumber(AText, dblValue, nf, decs, currSym, warning) then begin if currSym <> '' then - FWorksheet.WriteCurrency(ARow, ACol, dblValue, nfCurrency, decs, currSym) + FWorksheet.WriteCurrency(ARow, ACol, dblValue, nfCurrency, -1, currSym) else FWorksheet.WriteNumber(ARow, ACol, dblValue, nf, decs); if warning <> '' then diff --git a/components/fpspreadsheet/fpscurrency.pas b/components/fpspreadsheet/fpscurrency.pas new file mode 100644 index 000000000..60f9911b5 --- /dev/null +++ b/components/fpspreadsheet/fpscurrency.pas @@ -0,0 +1,190 @@ +unit fpsCurrency; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +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 + +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) 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, p: 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. + diff --git a/components/fpspreadsheet/fpsnumformatparser.pas b/components/fpspreadsheet/fpsnumformatparser.pas index 00995f66a..d2c2abae9 100644 --- a/components/fpspreadsheet/fpsnumformatparser.pas +++ b/components/fpspreadsheet/fpsnumformatparser.pas @@ -157,7 +157,7 @@ type implementation uses - TypInfo, StrUtils, fpsutils; + TypInfo, StrUtils, LazUTF8, fpsutils, fpsCurrency; { TsNumFormatParser } @@ -266,14 +266,16 @@ var begin if (FWorkbook = nil) or (FWorkbook.FormatSettings.CurrencyString = '') then Result := false - else begin - uValue := Uppercase(AValue); - Result := (uValue = Uppercase(AnsiToUTF8(FWorkbook.FormatSettings.CurrencyString))) or + else + Result := CurrencyRegistered(AValue); + { + uValue := UTF8Uppercase(AValue); + Result := (uValue = UTF8Uppercase(FWorkbook.FormatSettings.CurrencyString)) or (uValue = '$') or (uValue = 'USD') or (uValue = '€') or (uValue = 'EUR') or (uValue = '£') or (uValue = 'GBP') or (uValue = '¥') or (uValue = 'JPY'); - end; + } end; { Creates a formatstring for all sections. diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 8ddf41101..12cf36c6a 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -1234,7 +1234,7 @@ implementation uses Math, StrUtils, TypInfo, lazutf8, - fpsStrings, fpsStreams, fpsUtils, fpsNumFormatParser, fpsExprParser; + fpsStrings, fpsStreams, fpsUtils, fpsCurrency, fpsNumFormatParser, fpsExprParser; const { These are reserved system colors by Microsoft @@ -1324,7 +1324,6 @@ var 'wheat' // $16 ); - {@@ ---------------------------------------------------------------------------- Registers a new reader/writer pair for a given spreadsheet file format -------------------------------------------------------------------------------} @@ -3818,6 +3817,7 @@ var isPercent: Boolean; number: Double; r, c: Cardinal; + currSym: String; begin if ACell = nil then exit; @@ -3837,11 +3837,20 @@ begin isPercent := Pos('%', AValue) = Length(AValue); if isPercent then Delete(AValue, Length(AValue), 1); - if TryStrToFloat(AValue, number, FWorkbook.FormatSettings) then begin + if TryStrToCurrency(AValue, number, currSym, FWorkbook.FormatSettings) then + begin + WriteCurrency(ACell, number, nfCurrencyRed, -1, currSym); + exit; + end; + + if TryStrToFloat(AValue, number, FWorkbook.FormatSettings) then + begin if isPercent then WriteNumber(ACell, number/100, nfPercentage) - else begin - if IsDateTimeFormat(ACell^.NumberFormat) then begin + else + begin + if IsDateTimeFormat(ACell^.NumberFormat) then + begin ACell^.NumberFormat := nfGeneral; ACell^.NumberFormatStr := ''; end; @@ -3850,21 +3859,25 @@ begin exit; end; - if TryStrToDateTime(AValue, number, FWorkbook.FormatSettings) then begin + if TryStrToDateTime(AValue, number, FWorkbook.FormatSettings) then + begin if number < 1.0 then begin // this is a time alone - if not IsTimeFormat(ACell^.NumberFormat) then begin + if not IsTimeFormat(ACell^.NumberFormat) then + begin ACell^.NumberFormat := nfLongTime; ACell^.NumberFormatStr := ''; end; end else if frac(number) = 0.0 then begin // this is a date alone - if not (ACell^.NumberFormat in [nfShortDate, nfLongDate, nfShortDateTime]) - then begin + if not (ACell^.NumberFormat in [nfShortDate, nfLongDate, nfShortDateTime]) then + begin ACell^.NumberFormat := nfShortDate; ACell^.NumberFormatStr := ''; end; - end else begin - if not IsDateTimeFormat(ACell^.NumberFormat) then begin + end else + begin + if not IsDateTimeFormat(ACell^.NumberFormat) then + begin ACell^.NumberFormat := nfShortDateTime; ACell^.NumberFormatStr := ''; end; @@ -3937,6 +3950,7 @@ begin ANegCurrFormat := Workbook.FormatSettings.NegCurrFormat; if ACurrencySymbol = '?' then ACurrencySymbol := Workbook.FormatSettings.CurrencyString; + RegisterCurrency(ACurrencySymbol); fmt := BuildCurrencyFormatString( nfdDefault, @@ -4353,10 +4367,12 @@ begin if ANumberFormat <> nfGeneral then begin Include(ACell^.UsedFormattingFields, uffNumberFormat); if ANumberFormat in [nfCurrency, nfCurrencyRed] then + begin ACell^.NumberFormatStr := BuildCurrencyFormatString(nfdDefault, ANumberFormat, Workbook.FormatSettings, ADecimals, - APosCurrFormat, ANegCurrFormat, ACurrencySymbol) - else + APosCurrFormat, ANegCurrFormat, ACurrencySymbol); + RegisterCurrency(ACurrencySymbol); + end else ACell^.NumberFormatStr := BuildNumberFormatString(ANumberFormat, Workbook.FormatSettings, ADecimals); end else begin @@ -8231,6 +8247,7 @@ end; initialization + // Default palette MakeLEPalette(@DEFAULT_PALETTE, Length(DEFAULT_PALETTE)); finalization