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

fpspreadsheet: Fix changing of decimal places for currency format in fpsgrid demo.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3162 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-06-13 10:03:29 +00:00
parent e94ee856a7
commit 0abb220530
4 changed files with 112 additions and 44 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -463,6 +463,10 @@ begin
exit;
cell := Worksheet.FindCell(GetWorksheetRow(Row), GetWorksheetCol(Col));
if (cell <> nil) then begin
if cell^.NumberFormat = nfGeneral then begin
Worksheet.WriteNumberFormat(cell, nfFixed, '0.00');
exit;
end;
Worksheet.GetNumberFormatAttributes(cell, decs, currSym);
if (Sender = AcIncDecimals) then
Worksheet.WriteDecimals(cell, decs+1)
@ -507,6 +511,7 @@ begin
r := GetWorksheetRow(Row);
cell := Worksheet.GetCell(r, c);
Worksheet.GetNumberFormatAttributes(cell, decs, cs);
if cs = '' then cs := '?';
case cell^.ContentType of
cctNumber, cctDateTime:
if isDateTimeFmt then begin

77
components/fpspreadsheet/fpsnumformatparser.pas
View File

@ -91,6 +91,10 @@ type
procedure AddElement(AToken: TsNumFormatToken; AIntValue: Integer); overload;
procedure AddElement(AToken: TsNumFormatToken; AFloatValue: Double); overload;
procedure AddSection;
procedure DeleteElement(ASection, AIndex: Integer);
procedure InsertElement(ASection, AIndex: Integer; AToken: TsNumFormatToken; AText: String); overload;
procedure InsertElement(ASection, AIndex: Integer; AToken: TsNumFormatToken; AIntValue: Integer); overload;
procedure InsertElement(ASection, AIndex: Integer; AToken: TsNumFormatToken; AFloatValue: Double); overload;
function NextToken: Char;
function PrevToken: Char;
@ -634,6 +638,55 @@ begin
end;
*)
procedure TsNumFormatParser.DeleteElement(ASection, AIndex: Integer);
var
i, n: Integer;
begin
n := Length(FSections[ASection].Elements);
for i:= AIndex+1 to n-1 do
FSections[ASection].Elements[i-1] := FSections[ASection].Elements[i];
SetLength(FSections[ASection].Elements, n-1);
end;
procedure TsNumFormatParser.InsertElement(ASection, AIndex: Integer;
AToken: TsNumFormatToken; AText: String);
var
i, n: Integer;
begin
n := Length(FSections[ASection].Elements);
SetLength(FSections[ASection].Elements, n+1);
for i:= n-1 downto AIndex+1 do
FSections[ASection].Elements[i+1] := FSections[ASection].Elements[i];
FSections[ASection].Elements[AIndex+1].Token := AToken;
FSections[ASection].Elements[AIndex+1].TextValue := AText;
end;
procedure TsNumFormatParser.InsertElement(ASection, AIndex: Integer;
AToken: TsNumFormatToken; AIntValue: Integer);
var
i, n: Integer;
begin
n := Length(FSections[ASection].Elements);
SetLength(FSections[ASection].Elements, n+1);
for i:= n-1 downto AIndex+1 do
FSections[ASection].Elements[i+1] := FSections[ASection].Elements[i];
FSections[ASection].Elements[AIndex+1].Token := AToken;
FSections[ASection].Elements[AIndex+1].IntValue := AIntValue;
end;
procedure TsNumFormatParser.InsertElement(ASection, AIndex: Integer;
AToken: TsNumFormatToken; AFloatValue: Double);
var
i, n: Integer;
begin
n := Length(FSections[ASection].Elements);
SetLength(FSections[ASection].Elements, n+1);
for i:= n-1 downto AIndex+1 do
FSections[ASection].Elements[i+1] := FSections[ASection].Elements[i];
FSections[ASection].Elements[AIndex+1].Token := AToken;
FSections[ASection].Elements[AIndex+1].FloatValue := AFloatValue;
end;
function TsNumFormatParser.GetFormatString(ADialect: TsNumFormatDialect): String;
var
i: Integer;
@ -1653,25 +1706,31 @@ var
i, j, n: Integer;
begin
for j := 0 to High(FSections) do begin
i := 0;
n := Length(FSections[j].Elements);
while (i < n) do begin
i := n-1;
while (i > -1) 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;
if (AValue > 0) then begin
// Don't use "AddElements" because nfCurrency etc have elements after the number.
InsertElement(j, i, nftDecSep, '.');
InsertElement(j, i+1, nftDecs, AValue);
break;
end;
nftDecs:
begin
if AValue > 0 then begin
// decimals are already used, just replace value of decimal places
FSections[j].Elements[i].IntValue := AValue;
exit;
break;
end else begin
// No decimals any more: delete decs and decsep elements
DeleteElement(j, i);
DeleteElement(j, i-1);
break;
end;
end;
inc(i);
dec(i);
end;
end;
end;

32
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -1399,14 +1399,22 @@ function TsWorksheet.GetNumberFormatAttributes(ACell: PCell; out ADecimals: byte
out ACurrencySymbol: String): Boolean;
var
parser: TsNumFormatParser;
nf: TsNumberFormat;
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;
nf := parser.NumFormat;
if (nf = nfGeneral) or IsDateTimeFormat(nf) then begin
ADecimals := 2;
ACurrencySymbol := '?';
end
else begin
ADecimals := parser.Decimals;
ACurrencySymbol := parser.CurrencySymbol;
end;
Result := true;
end;
finally
@ -2053,14 +2061,14 @@ begin
if ANegCurrFormat = -1 then
ANegCurrFormat := Workbook.FormatSettings.NegCurrFormat;
if ACurrencySymbol = '?' then
ACurrencySymbol := Workbook.FormatSettings.CurrencyString;
ACurrencySymbol := AnsiToUTF8(Workbook.FormatSettings.CurrencyString);
fmt := BuildCurrencyFormatString(
nfdDefault,
AFormat,
Workbook.FormatSettings,
ADecimals,
APosCurrFormat, ANegCurrFormat,
AFormat in [nfCurrencyRed, nfAccountingRed],
AFormat in [nfAccounting, nfAccountingRed],
ACurrencySymbol);
WriteCurrency(ACell, AValue, AFormat, fmt);
@ -3836,20 +3844,6 @@ begin
// Iterate through all cells and collect the individual styles
for i := 0 to Workbook.GetWorksheetCount - 1 do
IterateThroughCells(nil, Workbook.GetWorksheetByIndex(i).Cells, ListAllFormattingStylesCallback);
(*
// Convert the numberformats of the collected styles to be compatible with the destination file
for i:=0 to High(FFormattingStyles) do
if (FFormattingStyles[i].NumberFormatStr <> '') and
(FFormattingStyles[i].NumberFormat <> nfCustom) // don't touch custom formatstrings!
then
FNumFormatList.ConvertBeforeWriting(
FFormattingStyles[i].NumberFormatStr,
FFormattingStyles[i].NumberFormat,
FFormattingStyles[i].Decimals,
FFormattingStyles[i].CurrencySymbol
);
*)
end;
{@@

42
components/fpspreadsheet/fpsutils.pas
View File

@ -12,7 +12,7 @@ unit fpsutils;
interface
uses
Classes, SysUtils, StrUtils, fpspreadsheet;
Classes, SysUtils, StrUtils, fpspreadsheet, fpsNumFormatParser;
// Exported types
type
@ -72,9 +72,9 @@ function IsCurrencyFormat(AFormat: TsNumberFormat): Boolean;
function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean; overload;
//function IsDateTimeFormat(AFormatStr: String): Boolean; overload;
function BuildCurrencyFormatString(const AFormatSettings: TFormatSettings;
ADecimals, APosCurrFormat, ANegCurrFormat: Integer;
ANegativeValuesRed, AAccountingStyle: Boolean; ACurrencySymbol: String = '?'): String;
function BuildCurrencyFormatString(ADialect: TsNumFormatDialect;
ANumberFormat: TsNumberFormat; const AFormatSettings: TFormatSettings;
ADecimals, APosCurrFormat, ANegCurrFormat: Integer; ACurrencySymbol: String): String;
function BuildDateTimeFormatString(ANumberFormat: TsNumberFormat;
const AFormatSettings: TFormatSettings; AFormatString: String = ''): String;
function BuildNumberFormatString(ANumberFormat: TsNumberFormat;
@ -624,9 +624,9 @@ end;
negative values) to apply a red font color.
This code has to be removed by StripAccountingSymbols before applying to
FormatFloat. }
function BuildCurrencyFormatString(const AFormatSettings: TFormatSettings;
ADecimals, APosCurrFormat, ANegCurrFormat: Integer; ANegativeValuesRed: Boolean;
AAccountingStyle: Boolean; ACurrencySymbol: String = '?'): String;
function BuildCurrencyFormatString(ADialect: TsNumFormatDialect;
ANumberFormat: TsNumberFormat; const AFormatSettings: TFormatSettings;
ADecimals, APosCurrFormat, ANegCurrFormat: Integer; ACurrencySymbol: String): String;
const
POS_FMT: array[0..3, boolean] of string = (
// Parameter 0 is "value", parameter 1 is "currency symbol"
@ -658,6 +658,8 @@ var
decs: String;
cf, ncf: Byte;
p, n: String;
accStyle: Boolean;
negRed: Boolean;
begin
cf := IfThen(APosCurrFormat < 0, AFormatSettings.CurrencyFormat, APosCurrFormat);
ncf := IfThen(ANegCurrFormat < 0, AFormatSettings.NegCurrFormat, ANegCurrFormat);
@ -668,10 +670,13 @@ begin
decs := DupeString('0', ADecimals);
if ADecimals > 0 then decs := '.' + decs;
p := POS_FMT[cf, AAccountingStyle];
n := NEG_FMT[ncf, AAccountingStyle];
accStyle := ANumberFormat in [nfAccounting, nfAccountingRed];
negRed := ANumberFormat in [nfCurrencyRed, nfAccountingRed];
p := POS_FMT[cf, accStyle];
n := NEG_FMT[ncf, accStyle];
// add extra space for the sign of the number for perfect alignment in Excel
if AAccountingStyle then
if accStyle then
case ncf of
0, 14: p := p + '_)';
3, 11: p := p + '_-';
@ -681,17 +686,22 @@ begin
if ACurrencySymbol <> '' then begin
Result := Format(p, ['#,##0' + decs, ACurrencySymbol]) + ';'
+ IfThen(ANegativeValuesRed, '[red]', '') + Format(n, ['#,##0' + decs, ACurrencySymbol]) + ';'
+ Format(p, [IfThen(AAccountingStyle, '-', '0'+decs), ACurrencySymbol]);
+ IfThen(negRed and (ADialect = nfdExcel), '[red]', '')
+ Format(n, ['#,##0' + decs, ACurrencySymbol]) + ';'
+ Format(p, [IfThen(accStyle, '-', '0'+decs), ACurrencySymbol]);
end
else begin
Result := '#,##0' + decs;
if negRed and (ADialect = nfdExcel) then
Result := Result +';[red]'
else
Result := Result +';';
case ncf of
0, 14, 15 : Result := Result + ';(#,##0' + decs + ')';
1, 2, 5, 6, 8, 9, 12: Result := Result + ';-#,##0' + decs;
else Result := Result + ';#,##0' + decs + '-';
0, 14, 15 : Result := Result + '(#,##0' + decs + ')';
1, 2, 5, 6, 8, 9, 12: Result := Result + '-#,##0' + decs;
else Result := Result + '#,##0' + decs + '-';
end;
Result := Result + ';' + IfThen(AAccountingStyle, '-', '0'+decs);
Result := Result + ';' + IfThen(accStyle, '-', '0'+decs);
end;
end;