From 95347f5d5ac8735988b0c9c1122fa72799da7b72 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Fri, 13 Jun 2014 07:59:42 +0000 Subject: [PATCH] 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 --- .../examples/fpsgrid/mainform.lfm | 48 +++++++++---------- .../examples/fpsgrid/mainform.pas | 34 +++++++------ .../fpspreadsheet/fpsnumformatparser.pas | 28 +++++++++-- components/fpspreadsheet/fpspreadsheet.pas | 25 ++++++++++ 4 files changed, 88 insertions(+), 47 deletions(-) diff --git a/components/fpspreadsheet/examples/fpsgrid/mainform.lfm b/components/fpspreadsheet/examples/fpsgrid/mainform.lfm index 6c2b22ad9..4479e3c72 100644 --- 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' diff --git a/components/fpspreadsheet/examples/fpsgrid/mainform.pas b/components/fpspreadsheet/examples/fpsgrid/mainform.pas index c43ab9079..a947f8976 100644 --- 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); diff --git a/components/fpspreadsheet/fpsnumformatparser.pas b/components/fpspreadsheet/fpsnumformatparser.pas index d0b3e6822..e93788cee 100644 --- 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. diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index b11783180..dafde82a5 100755 --- 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.