pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Fix usage of decimal places in fpsgrid demo.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3158 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-06-13 07:59:42 +00:00
parent 8aee090396
commit 95347f5d5a
4 changed files with 88 additions and 47 deletions
Download Patch File Download Diff File Expand all files Collapse all files

48
components/fpspreadsheet/examples/fpsgrid/mainform.lfm
View File

@@ -4,7 +4,7 @@ object Form1: TForm1
Top = 248 Top = 248
Width = 884 Width = 884
Caption = 'fpsGrid' Caption = 'fpsGrid'
ClientHeight = 629 ClientHeight = 624
ClientWidth = 884 ClientWidth = 884
Menu = MainMenu Menu = MainMenu
OnActivate = FormActivate OnActivate = FormActivate
@@ -14,7 +14,7 @@ object Form1: TForm1
object Panel1: TPanel object Panel1: TPanel
Left = 0 Left = 0
Height = 85 Height = 85
Top = 544 Top = 539
Width = 884 Width = 884
Align = alBottom Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
@@ -23,9 +23,9 @@ object Form1: TForm1
TabOrder = 0 TabOrder = 0
object CbShowHeaders: TCheckBox object CbShowHeaders: TCheckBox
Left = 8 Left = 8
Height = 19 Height = 24
Top = 8 Top = 8
Width = 93 Width = 116
Caption = 'Show headers' Caption = 'Show headers'
Checked = True Checked = True
OnClick = CbShowHeadersClick OnClick = CbShowHeadersClick
@@ -34,9 +34,9 @@ object Form1: TForm1
end end
object CbShowGridLines: TCheckBox object CbShowGridLines: TCheckBox
Left = 8 Left = 8
Height = 19 Height = 24
Top = 32 Top = 32
Width = 100 Width = 125
Caption = 'Show grid lines' Caption = 'Show grid lines'
Checked = True Checked = True
OnClick = CbShowGridLinesClick OnClick = CbShowGridLinesClick
@@ -45,7 +45,7 @@ object Form1: TForm1
end end
object EdFrozenCols: TSpinEdit object EdFrozenCols: TSpinEdit
Left = 389 Left = 389
Height = 23 Height = 28
Top = 8 Top = 8
Width = 52 Width = 52
OnChange = EdFrozenColsChange OnChange = EdFrozenColsChange
@@ -53,7 +53,7 @@ object Form1: TForm1
end end
object EdFrozenRows: TSpinEdit object EdFrozenRows: TSpinEdit
Left = 389 Left = 389
Height = 23 Height = 28
Top = 39 Top = 39
Width = 52 Width = 52
OnChange = EdFrozenRowsChange OnChange = EdFrozenRowsChange
@@ -61,37 +61,37 @@ object Form1: TForm1
end end
object Label1: TLabel object Label1: TLabel
Left = 304 Left = 304
Height = 15 Height = 20
Top = 13 Top = 13
Width = 62 Width = 77
Caption = 'Frozen cols:' Caption = 'Frozen cols:'
FocusControl = EdFrozenCols FocusControl = EdFrozenCols
ParentColor = False ParentColor = False
end end
object Label2: TLabel object Label2: TLabel
Left = 304 Left = 304
Height = 15 Height = 20
Top = 40 Top = 40
Width = 66 Width = 82
Caption = 'Frozen rows:' Caption = 'Frozen rows:'
FocusControl = EdFrozenRows FocusControl = EdFrozenRows
ParentColor = False ParentColor = False
end end
object CbReadFormulas: TCheckBox object CbReadFormulas: TCheckBox
Left = 8 Left = 8
Height = 19 Height = 24
Top = 56 Top = 56
Width = 96 Width = 120
Caption = 'Read formulas' Caption = 'Read formulas'
OnChange = CbReadFormulasChange OnChange = CbReadFormulasChange
TabOrder = 4 TabOrder = 4
end end
object CbHeaderStyle: TComboBox object CbHeaderStyle: TComboBox
Left = 152 Left = 152
Height = 23 Height = 28
Top = 8 Top = 8
Width = 116 Width = 116
ItemHeight = 15 ItemHeight = 20
ItemIndex = 2 ItemIndex = 2
Items.Strings = ( Items.Strings = (
'Lazarus' 'Lazarus'
@@ -106,7 +106,7 @@ object Form1: TForm1
end end
object PageControl1: TPageControl object PageControl1: TPageControl
Left = 0 Left = 0
Height = 465 Height = 460
Top = 79 Top = 79
Width = 884 Width = 884
ActivePage = TabSheet1 ActivePage = TabSheet1
@@ -116,11 +116,11 @@ object Form1: TForm1
OnChange = PageControl1Change OnChange = PageControl1Change
object TabSheet1: TTabSheet object TabSheet1: TTabSheet
Caption = 'Sheet1' Caption = 'Sheet1'
ClientHeight = 437 ClientHeight = 427
ClientWidth = 876 ClientWidth = 876
object WorksheetGrid: TsWorksheetGrid object WorksheetGrid: TsWorksheetGrid
Left = 0 Left = 0
Height = 437 Height = 427
Top = 0 Top = 0
Width = 876 Width = 876
FrozenCols = 0 FrozenCols = 0
@@ -136,7 +136,7 @@ object Form1: TForm1
TitleStyle = tsNative TitleStyle = tsNative
OnSelection = WorksheetGridSelection OnSelection = WorksheetGridSelection
ColWidths = ( ColWidths = (
42 56
64 64
64 64
64 64
@@ -244,19 +244,19 @@ object Form1: TForm1
end end
object FontComboBox: TComboBox object FontComboBox: TComboBox
Left = 52 Left = 52
Height = 23 Height = 28
Top = 2 Top = 2
Width = 127 Width = 127
ItemHeight = 15 ItemHeight = 20
OnSelect = FontComboBoxSelect OnSelect = FontComboBoxSelect
TabOrder = 0 TabOrder = 0
end end
object FontSizeComboBox: TComboBox object FontSizeComboBox: TComboBox
Left = 179 Left = 179
Height = 23 Height = 28
Top = 2 Top = 2
Width = 48 Width = 48
ItemHeight = 15 ItemHeight = 20
Items.Strings = ( Items.Strings = (
'8' '8'
'9' '9'

34
components/fpspreadsheet/examples/fpsgrid/mainform.pas
View File

@@ -455,25 +455,20 @@ procedure TForm1.AcIncDecDecimalsExecute(Sender: TObject);
var var
cell: PCell; cell: PCell;
decs: Byte; decs: Byte;
parser: TsNumFormatParser; currsym: String;
begin begin
currsym := Sender.ClassName;
with WorksheetGrid do begin with WorksheetGrid do begin
if Workbook = nil then if Workbook = nil then
exit; exit;
cell := Worksheet.FindCell(GetWorksheetRow(Row), GetWorksheetCol(Col)); cell := Worksheet.FindCell(GetWorksheetRow(Row), GetWorksheetCol(Col));
if (cell <> nil) then begin if (cell <> nil) then begin
parser := TsNumFormatParser.Create(Workbook, cell^.NumberFormatStr); Worksheet.GetNumberFormatAttributes(cell, decs, currSym);
try if (Sender = AcIncDecimals) then
decs := parser.Decimals; Worksheet.WriteDecimals(cell, decs+1)
if (Sender = AcIncDecimals) then else
Parser.Decimals := decs+1; if (Sender = AcDecDecimals) and (decs > 0) then
if (Sender = AcDecDecimals) and (decs > 0) then Worksheet.WriteDecimals(cell, decs-1);
Parser.Decimals := decs-1;
cell^.NumberFormatStr := parser.FormatString[nfdDefault];
finally
parser.Free;
end;
Invalidate;
end; end;
end; end;
end; end;
@@ -485,12 +480,14 @@ end;
procedure TForm1.AcNumFormatExecute(Sender: TObject); procedure TForm1.AcNumFormatExecute(Sender: TObject);
const 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 var
nf: TsNumberFormat; nf: TsNumberFormat;
c, r: Cardinal; c, r: Cardinal;
cell: PCell; cell: PCell;
fmt: String; fmt: String;
decs: Byte;
cs: String;
begin begin
if TAction(Sender).Checked then if TAction(Sender).Checked then
nf := TsNumberFormat((TAction(Sender).Tag - NUMFMT_TAG) div 10) nf := TsNumberFormat((TAction(Sender).Tag - NUMFMT_TAG) div 10)
@@ -506,6 +503,7 @@ begin
c := GetWorksheetCol(Col); c := GetWorksheetCol(Col);
r := GetWorksheetRow(Row); r := GetWorksheetRow(Row);
cell := Worksheet.GetCell(r, c); cell := Worksheet.GetCell(r, c);
Worksheet.GetNumberFormatAttributes(cell, decs, cs);
case cell^.ContentType of case cell^.ContentType of
cctNumber, cctDateTime: cctNumber, cctDateTime:
if IsDateTimeFormat(nf) then begin if IsDateTimeFormat(nf) then begin
@@ -516,14 +514,14 @@ begin
end else end else
if IsCurrencyFormat(nf) then begin if IsCurrencyFormat(nf) then begin
if IsDateTimeFormat(cell^.NumberFormat) then if IsDateTimeFormat(cell^.NumberFormat) then
Worksheet.WriteCurrency(cell, cell^.DateTimeValue, nf, fmt) Worksheet.WriteCurrency(cell, cell^.DateTimeValue, nf, decs, cs)
else else
Worksheet.WriteCurrency(cell, cell^.Numbervalue, nf, fmt); Worksheet.WriteCurrency(cell, cell^.Numbervalue, nf, decs, cs);
end else begin end else begin
if IsDateTimeFormat(cell^.NumberFormat) then if IsDateTimeFormat(cell^.NumberFormat) then
Worksheet.WriteNumber(cell, cell^.DateTimeValue, nf, fmt) Worksheet.WriteNumber(cell, cell^.DateTimeValue, nf, decs)
else else
Worksheet.WriteNumber(cell, cell^.NumberValue, nf, fmt) Worksheet.WriteNumber(cell, cell^.NumberValue, nf, decs)
end; end;
else else
Worksheet.WriteNumberformat(cell, nf, fmt); Worksheet.WriteNumberformat(cell, nf, fmt);

28
components/fpspreadsheet/fpsnumformatparser.pas
View File

@@ -1650,12 +1650,30 @@ end;
procedure TsNumFormatParser.SetDecimals(AValue: Byte); procedure TsNumFormatParser.SetDecimals(AValue: Byte);
var var
i,j: Integer; i, j, n: Integer;
begin begin
for j := 0 to High(FSections) do for j := 0 to High(FSections) do begin
for i := 0 to High(FSections[j].Elements) do i := 0;
if FSections[j].Elements[i].Token = nftDecs then n := Length(FSections[j].Elements);
FSections[j].Elements[i].IntValue := AValue; 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;
end. end.

25
components/fpspreadsheet/fpspreadsheet.pas
View File

@@ -441,6 +441,10 @@ type
function ReadUsedFormatting(ARow, ACol: Cardinal): TsUsedFormattingFields; function ReadUsedFormatting(ARow, ACol: Cardinal): TsUsedFormattingFields;
function ReadBackgroundColor(ARow, ACol: Cardinal): TsColor; function ReadBackgroundColor(ARow, ACol: Cardinal): TsColor;
{ Reading of cell attributes }
function GetNumberFormatAttributes(ACell: PCell; out ADecimals: Byte;
out ACurrencySymbol: String): Boolean;
{ Writing of values } { Writing of values }
procedure WriteBlank(ARow, ACol: Cardinal); procedure WriteBlank(ARow, ACol: Cardinal);
procedure WriteBoolValue(ARow, ACol: Cardinal; AValue: Boolean); procedure WriteBoolValue(ARow, ACol: Cardinal; AValue: Boolean);
@@ -1391,6 +1395,27 @@ begin
Result := FCells.Count; Result := FCells.Count;
end; 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. Returns the first Cell.