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

fpspreadsheet: Beginning to extend to number format parser for xml strings (for ods). Not finished, yet.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3170 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-06-15 22:27:46 +00:00
parent bba6d27241
commit 144f4dd25b
2 changed files with 156 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
components/fpspreadsheet/fpsnumformatparser.pas
View File

@ -25,10 +25,9 @@ const
{ TsNumFormatParser }
type
TsNumFormatDialect = (nfdDefault, nfdExcel, nfdOther);
TsNumFormatDialect = (nfdDefault, nfdExcel);
// nfdDefault is the dialect used by fpc,
// nfdExcel is the dialect used by Excel
// nfdOther is used when writing xml for ods files. Separate implementation needed.
TsCompareOperation = (coNotUsed,
coEqual, coNotEqual, coLess, coGreater, coLessEqual, coGreaterEqual
@ -69,13 +68,11 @@ type
TsNumFormatParser = class
private
FCreateMethod: Byte;
FWorkbook: TsWorkbook;
FToken: Char;
FCurrent: PChar;
FStart: PChar;
FEnd: PChar;
FCurrSection: Integer;
FSections: TsNumFormatSections;
FStatus: Integer;
function GetCurrencySymbol: String;
function GetDecimals: byte;
@ -86,6 +83,9 @@ type
procedure SetDecimals(AValue: Byte);
protected
FWorkbook: TsWorkbook;
FSections: TsNumFormatSections;
{ Administration while scanning }
procedure AddElement(AToken: TsNumFormatToken; AText: String); overload;
procedure AddElement(AToken: TsNumFormatToken; AIntValue: Integer); overload;
@ -275,13 +275,11 @@ end;
{ Creates a formatstring for all sections.
Note: this implementation is only valid for the fpc and Excel dialects of
format string. Needs to be overridden for xml. }
format string. }
function TsNumFormatParser.BuildFormatString(ADialect: TsNumFormatDialect): String;
var
i: Integer;
begin
if ADialect = nfdOther then
raise Exception.Create('nfdOther cannot be used in TsNumFormatParser.BuildFormatString');
if Length(FSections) > 0 then begin
Result := BuildFormatStringFromSection(0, ADialect);
for i := 1 to High(FSections) do
@ -291,8 +289,7 @@ begin
end;
{ Creates a format string for the given section. This implementation covers
the formatstring dialects of fpc (nfdDefault) and Excel (nfdExcel).
Needs to be overridden for xml. }
the formatstring dialects of fpc (nfdDefault) and Excel (nfdExcel). }
function TsNumFormatParser.BuildFormatStringFromSection(ASection: Integer;
ADialect: TsNumFormatDialect): String;
var
@ -301,9 +298,6 @@ var
begin
Result := '';
if ADialect = nfdOther then
raise Exception.Create('nfdOther cannot be used in TsNumFormatParser.BuildFormatString');
if (ASection < 0) and (ASection >= GetParsedSectionCount) then
exit;
for i := 0 to High(FSections[ASection].Elements) do begin

151
components/fpspreadsheet/fpsopendocument.pas
View File

@ -39,7 +39,7 @@ uses
fpspreadsheet,
laz2_xmlread, laz2_DOM,
AVL_Tree, math, dateutils,
fpsutils;
fpsutils, fpsNumFormatParser;
type
TDateMode=(
@ -49,12 +49,22 @@ type
);
{ TsSpreadOpenDocNumFormatList }
TsSpreadOpenDocNumFormatList = class(TsCustomNumFormatList)
protected
procedure AddBuiltinFormats; override;
public
end;
{ TsSpreadOpenDocNumFormatParser }
TsSpreadOpenDocNumFormatParser = class(TsNumFormatParser)
protected
function BuildXMLAsStringFromSection(ASection: Integer; AIndent: String;
AFormatNo: Integer): String;
public
function BuildXMLAsString(AIndent: String; AFormatNo: Integer): String;
end;
{ TsSpreadOpenDocReader }
TsSpreadOpenDocReader = class(TsCustomSpreadReader)
@ -117,6 +127,7 @@ type
// Routines to write parts of files
function WriteCellStylesXMLAsString: string;
function WriteColStylesXMLAsString: String;
function WriteNumFormatsXMLAsString: String;
function WriteRowStylesXMLAsString: String;
function WriteColumnsXMLAsString(ASheet: TsWorksheet): String;
@ -290,6 +301,105 @@ begin
end;
{ TsSpreadOpenDocNumFormatParser }
function TsSpreadOpenDocNumFormatParser.BuildXMLAsString(AIndent: String;
AFormatNo: Integer): String;
var
i, ns: Integer;
begin
Result := '';
for i := Length(FSections)-1 downto 0 do
Result := Result + BuildXMLAsStringFromSection(i, AIndent, AFormatNo);
end;
function TsSpreadOpenDocNumFormatParser.BuildXMLAsStringFromSection(
ASection: Integer; AIndent: String; AFormatNo: Integer): String;
var
nf : TsNumberFormat;
decs: Byte;
next: Integer;
sGrouping: String;
sColor: String;
sStyleMap: String;
ns: Integer;
fmtName: String;
clr: TsColorvalue;
begin
Result := '';
sGrouping := '';
sColor := '';
sStyleMap := '';
fmtName := Format('N%d', [AFormatNo]);
ns := Length(FSections);
if (ns > 1) then begin
if (ASection = ns - 1) then
case ns of
2: sStyleMap := AIndent +
' <style:map ' +
'style:apply-style-name="' + fmtName + 'P0" ' +
'style:condition="value()>=0" />' + LineEnding; // >= 0
3: sStyleMap := AIndent +
' <style:map '+
'style:apply-style-name="' + fmtName + 'P0" ' + // > 0
'style:condition="value()>0" />' + LineEnding + AIndent +
' <style:map '+
'style:apply-style-name="' + fmtName + 'P1" ' + // < 0
'style:condition="value()<0" />' + LineEnding;
else
raise Exception.Create('At most 3 format sections allowed.');
end
else
fmtName := fmtName + 'P' + IntToStr(ASection);
end;
with FSections[ASection] do begin
next := 0;
if IsTokenAt(nftColor, ASection, 0) then begin
clr := FWorkbook.GetPaletteColor(Elements[0].IntValue);
sColor := AIndent + '<style:text-properties fo:color="' + ColorToHTMLColorStr(clr) + '" />' + LineEnding;
next := 1;
end;
if IsNumberAt(ASection, next, nf, decs, next) then begin
if nf = nfFixedTh then
sGrouping := 'number:grouping="true" ';
// nfFixed, nfFixedTh
if (next = Length(Elements)) then begin
Result := AIndent +
'<number:number-style style:name="' + fmtName + '">' + LineEnding +
sColor + AIndent +
' <number:number ' +
'number:min-integer-digits="1" ' + sGrouping +
'number:decimal-places="' + IntToStr(decs) +
'" />' + LineEnding +
sStylemap + AIndent +
'</number:number-style>' + LineEnding;
exit;
end;
end;
// nfPercentage
if IsTokenAt(nftPercent, ASection, next) and (next+1 = Length(Elements))
then begin
Result := AIndent +
'<number:percentage-style style:name="' + fmtName + '">' + LineEnding +
sColor + AIndent +
' <number:number ' +
'number:min-integer-digits="1" ' + sGrouping +
'number:decimal-places="' + IntToStr(decs) +
'" />' + LineEnding + AIndent +
' <number:text>%</number:text>' + LineEnding +
sStyleMap + AIndent +
'</number:percentage-style>' + LineEnding;
exit;
end;
end;
// ... more to follow...
end;
{ TsSpreadOpenDocReader }
constructor TsSpreadOpenDocReader.Create(AWorkbook: TsWorkbook);
@ -1905,11 +2015,14 @@ var
lCellStylesCode: string;
lColStylesCode: String;
lRowStylesCode: String;
lNumFmtCode: String;
begin
ListAllColumnStyles;
ListAllRowStyles;
ListAllFormattingStyles;
lNumFmtCode := WriteNumFormatsXMLAsString;
lColStylesCode := WriteColStylesXMLAsString;
if lColStylesCode = '' then lColStylesCode :=
' <style:style style:name="co1" style:family="table-column">' + LineEnding +
@ -1956,6 +2069,7 @@ begin
// Automatic styles
' <office:automatic-styles>' + LineEnding +
lNumFmtCode +
lColStylesCode +
lRowStylesCode +
' <style:style style:name="ta1" style:family="table" style:master-page-name="Default">' + LineEnding +
@ -2138,6 +2252,41 @@ begin
end;
end;
function TsSpreadOpenDocWriter.WriteNumFormatsXMLAsString: String;
var
i: Integer;
numFmtXML: String;
parser: TsSpreadOpenDocNumFormatParser;
begin
{
<number:number-style style:name="N2">
<number:number number:decimal-places="2" number:min-integer-digits="1" />
</number:number-style>
' <number:number-style style:name="N2">
<number:number number:min-integer-digits="1" number:grouping="true" number:decimal-places="2"/>
</number:number-style>
' <number:number-style style:name="N2">
<number:number number:decimal-places="2" number:min-integer-digits="1" />
</number:number-style>
}
Result := '';
ListAllNumFormats;
for i:=0 to FNumFormatList.Count-1 do begin
parser := TsSpreadOpenDocNumFormatParser.Create(Workbook, FNumFormatList.Items[i].FormatString);
try
numFmtXML := parser.BuildXMLAsString(' ', 1000+i); //120+i); // Don't know where the user numbers start...
if numFmtXML <> '' then
Result := Result + numFmtXML;
finally
parser.Free;
end;
end;
end;
function TsSpreadOpenDocWriter.WriteRowsAndCellsXMLAsString(ASheet: TsWorksheet): String;
var
r, rr: Cardinal; // row index in sheet