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

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

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;

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

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.
+

components/fpspreadsheet/examples/spready/spready.lpi

@@ -92,7 +92,7 @@
         <PackageName Value="LCL"/>
       </Item2>
     </RequiredPackages>
-    <Units Count="6">
+    <Units Count="8">
       <Unit0>
         <Filename Value="spready.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -134,6 +134,18 @@
         <ResourceBaseClass Value="Form"/>
         <UnitName Value="sSortParamsForm"/>
       </Unit5>
+      <Unit6>
+        <Filename Value="sfcurrencyform.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="CurrencyForm"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="sfCurrencyForm"/>
+      </Unit6>
+      <Unit7>
+        <Filename Value="..\..\fpscurrency.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="fpsCurrency"/>
+      </Unit7>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

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.
 

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

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.
+

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.

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