fpspreadsheet: Fix usage of decimal places in fpsgrid demo.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3158 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2014-06-13 07:59:42 +00:00
parent 8aee090396
commit 95347f5d5a
4 changed files with 88 additions and 47 deletions
--- a/components/fpspreadsheet/examples/fpsgrid/mainform.lfm
+++ b/components/fpspreadsheet/examples/fpsgrid/mainform.lfm
@@ -4,7 +4,7 @@ object Form1: TForm1
  Top = 248
  Width = 884
  Caption = 'fpsGrid'
-  ClientHeight = 629
+  ClientHeight = 624
  ClientWidth = 884
  Menu = MainMenu
  OnActivate = FormActivate
@@ -14,7 +14,7 @@ object Form1: TForm1
  object Panel1: TPanel
    Left = 0
    Height = 85
-    Top = 544
+    Top = 539
    Width = 884
    Align = alBottom
    BevelOuter = bvNone
@@ -23,9 +23,9 @@ object Form1: TForm1
    TabOrder = 0
    object CbShowHeaders: TCheckBox
      Left = 8
-      Height = 19
+      Height = 24
      Top = 8
-      Width = 93
+      Width = 116
      Caption = 'Show headers'
      Checked = True
      OnClick = CbShowHeadersClick
@@ -34,9 +34,9 @@ object Form1: TForm1
    end
    object CbShowGridLines: TCheckBox
      Left = 8
-      Height = 19
+      Height = 24
      Top = 32
-      Width = 100
+      Width = 125
      Caption = 'Show grid lines'
      Checked = True
      OnClick = CbShowGridLinesClick
@@ -45,7 +45,7 @@ object Form1: TForm1
    end
    object EdFrozenCols: TSpinEdit
      Left = 389
-      Height = 23
+      Height = 28
      Top = 8
      Width = 52
      OnChange = EdFrozenColsChange
@@ -53,7 +53,7 @@ object Form1: TForm1
    end
    object EdFrozenRows: TSpinEdit
      Left = 389
-      Height = 23
+      Height = 28
      Top = 39
      Width = 52
      OnChange = EdFrozenRowsChange
@@ -61,37 +61,37 @@ object Form1: TForm1
    end
    object Label1: TLabel
      Left = 304
-      Height = 15
+      Height = 20
      Top = 13
-      Width = 62
+      Width = 77
      Caption = 'Frozen cols:'
      FocusControl = EdFrozenCols
      ParentColor = False
    end
    object Label2: TLabel
      Left = 304
-      Height = 15
+      Height = 20
      Top = 40
-      Width = 66
+      Width = 82
      Caption = 'Frozen rows:'
      FocusControl = EdFrozenRows
      ParentColor = False
    end
    object CbReadFormulas: TCheckBox
      Left = 8
-      Height = 19
+      Height = 24
      Top = 56
-      Width = 96
+      Width = 120
      Caption = 'Read formulas'
      OnChange = CbReadFormulasChange
      TabOrder = 4
    end
    object CbHeaderStyle: TComboBox
      Left = 152
-      Height = 23
+      Height = 28
      Top = 8
      Width = 116
-      ItemHeight = 15
+      ItemHeight = 20
      ItemIndex = 2
      Items.Strings = (
        'Lazarus'
@@ -106,7 +106,7 @@ object Form1: TForm1
  end
  object PageControl1: TPageControl
    Left = 0
-    Height = 465
+    Height = 460
    Top = 79
    Width = 884
    ActivePage = TabSheet1
@@ -116,11 +116,11 @@ object Form1: TForm1
    OnChange = PageControl1Change
    object TabSheet1: TTabSheet
      Caption = 'Sheet1'
-      ClientHeight = 437
+      ClientHeight = 427
      ClientWidth = 876
      object WorksheetGrid: TsWorksheetGrid
        Left = 0
-        Height = 437
+        Height = 427
        Top = 0
        Width = 876
        FrozenCols = 0
@@ -136,7 +136,7 @@ object Form1: TForm1
        TitleStyle = tsNative
        OnSelection = WorksheetGridSelection
        ColWidths = (
-          42
+          56
          64
          64
          64
@@ -244,19 +244,19 @@ object Form1: TForm1
    end
    object FontComboBox: TComboBox
      Left = 52
-      Height = 23
+      Height = 28
      Top = 2
      Width = 127
-      ItemHeight = 15
+      ItemHeight = 20
      OnSelect = FontComboBoxSelect
      TabOrder = 0
    end
    object FontSizeComboBox: TComboBox
      Left = 179
-      Height = 23
+      Height = 28
      Top = 2
      Width = 48
-      ItemHeight = 15
+      ItemHeight = 20
      Items.Strings = (
        '8'
        '9'
--- a/components/fpspreadsheet/examples/fpsgrid/mainform.pas
+++ b/components/fpspreadsheet/examples/fpsgrid/mainform.pas
@@ -455,25 +455,20 @@ procedure TForm1.AcIncDecDecimalsExecute(Sender: TObject);
 var
  cell: PCell;
  decs: Byte;
-  parser: TsNumFormatParser;
+  currsym: String;
 begin
+  currsym := Sender.ClassName;
  with WorksheetGrid do begin
    if Workbook = nil then
      exit;
    cell := Worksheet.FindCell(GetWorksheetRow(Row), GetWorksheetCol(Col));
    if (cell <> nil) then begin
-      parser := TsNumFormatParser.Create(Workbook, cell^.NumberFormatStr);
-      try
-        decs := parser.Decimals;
-        if (Sender = AcIncDecimals) then
-          Parser.Decimals := decs+1;
-        if (Sender = AcDecDecimals) and (decs > 0) then
-          Parser.Decimals := decs-1;
-        cell^.NumberFormatStr := parser.FormatString[nfdDefault];
-      finally
-        parser.Free;
-      end;
-      Invalidate;
+      Worksheet.GetNumberFormatAttributes(cell, decs, currSym);
+      if (Sender = AcIncDecimals) then
+        Worksheet.WriteDecimals(cell, decs+1)
+      else
+      if (Sender = AcDecDecimals) and (decs > 0) then
+        Worksheet.WriteDecimals(cell, decs-1);
    end;
  end;
 end;
@@ -485,12 +480,14 @@ end;

 procedure TForm1.AcNumFormatExecute(Sender: TObject);
 const
-  DATETIME_CUSTOM: array[0..4] of string = ('', 'dm', 'my', 'ms', 'msz');
+  DATETIME_CUSTOM: array[0..4] of string = ('', 'dd/mmm', 'mmm/yy', 'nn:ss', 'nn:ss.zzz');
 var
  nf: TsNumberFormat;
  c, r: Cardinal;
  cell: PCell;
  fmt: String;
+  decs: Byte;
+  cs: String;
 begin
  if TAction(Sender).Checked then
    nf := TsNumberFormat((TAction(Sender).Tag - NUMFMT_TAG) div 10)
@@ -506,6 +503,7 @@ begin
    c := GetWorksheetCol(Col);
    r := GetWorksheetRow(Row);
    cell := Worksheet.GetCell(r, c);
+    Worksheet.GetNumberFormatAttributes(cell, decs, cs);
    case cell^.ContentType of
      cctNumber, cctDateTime:
        if IsDateTimeFormat(nf) then begin
@@ -516,14 +514,14 @@ begin
        end else
        if IsCurrencyFormat(nf) then begin
          if IsDateTimeFormat(cell^.NumberFormat) then
-            Worksheet.WriteCurrency(cell, cell^.DateTimeValue, nf, fmt)
+            Worksheet.WriteCurrency(cell, cell^.DateTimeValue, nf, decs, cs)
          else
-            Worksheet.WriteCurrency(cell, cell^.Numbervalue, nf, fmt);
+            Worksheet.WriteCurrency(cell, cell^.Numbervalue, nf, decs, cs);
        end else begin
          if IsDateTimeFormat(cell^.NumberFormat) then
-            Worksheet.WriteNumber(cell, cell^.DateTimeValue, nf, fmt)
+            Worksheet.WriteNumber(cell, cell^.DateTimeValue, nf, decs)
          else
-            Worksheet.WriteNumber(cell, cell^.NumberValue, nf, fmt)
+            Worksheet.WriteNumber(cell, cell^.NumberValue, nf, decs)
        end;
      else
        Worksheet.WriteNumberformat(cell, nf, fmt);
--- a/components/fpspreadsheet/fpsnumformatparser.pas
+++ b/components/fpspreadsheet/fpsnumformatparser.pas
@@ -1650,12 +1650,30 @@ end;

 procedure TsNumFormatParser.SetDecimals(AValue: Byte);
 var
-  i,j: Integer;
+  i, j, n: Integer;
 begin
-  for j := 0 to High(FSections) do
-    for i := 0 to High(FSections[j].Elements) do
-      if FSections[j].Elements[i].Token = nftDecs then
-        FSections[j].Elements[i].IntValue := AValue;
+  for j := 0 to High(FSections) do begin
+    i := 0;
+    n := Length(FSections[j].Elements);
+    while (i < n) do begin
+      case FSections[j].Elements[i].Token of
+        nftDigit:
+          // no decimals so far --> add decimal separator and decimals element
+          if i = n-1 then begin
+            AddElement(nftDecSep, '.');
+            AddElement(nftDecs, AValue);
+            exit;
+          end;
+        nftDecs:
+          begin
+            // decimals are already used, just replace value of decimal places
+            FSections[j].Elements[i].IntValue := AValue;
+            exit;
+          end;
+      end;
+      inc(i);
+    end;
+  end;
 end;

 end.
--- a/components/fpspreadsheet/fpspreadsheet.pas
+++ b/components/fpspreadsheet/fpspreadsheet.pas
@@ -441,6 +441,10 @@ type
    function  ReadUsedFormatting(ARow, ACol: Cardinal): TsUsedFormattingFields;
    function  ReadBackgroundColor(ARow, ACol: Cardinal): TsColor;

+    { Reading of cell attributes }
+    function GetNumberFormatAttributes(ACell: PCell; out ADecimals: Byte;
+      out ACurrencySymbol: String): Boolean;
+
    { Writing of values }
    procedure WriteBlank(ARow, ACol: Cardinal);
    procedure WriteBoolValue(ARow, ACol: Cardinal; AValue: Boolean);
@@ -1391,6 +1395,27 @@ begin
  Result := FCells.Count;
 end;

+function TsWorksheet.GetNumberFormatAttributes(ACell: PCell; out ADecimals: byte;
+  out ACurrencySymbol: String): Boolean;
+var
+  parser: TsNumFormatParser;
+begin
+  Result := false;
+  if ACell <> nil then begin
+    parser := TsNumFormatParser.Create(FWorkbook, ACell^.NumberFormatStr);
+    try
+      if parser.Status = psOK then begin
+        ADecimals := parser.Decimals;
+        ACurrencySymbol := parser.CurrencySymbol;
+        Result := true;
+      end;
+    finally
+      parser.Free;
+    end;
+  end;
+end;
+
+
 {@@
  Returns the first Cell.