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

fpspreadsheet: Beginning to apply .ods formatting styles to cells

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3103 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-05-26 22:27:07 +00:00
parent 85e2de8340
commit 97ded8dfab
4 changed files with 317 additions and 96 deletions
Download Patch File Download Diff File Expand all files Collapse all files

134
components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpi
View File

@ -139,8 +139,8 @@
<UnitName Value="fpspreadsheet"/>
<EditorIndex Value="5"/>
<WindowIndex Value="0"/>
<TopLine Value="1369"/>
<CursorPos X="23" Y="1395"/>
<TopLine Value="317"/>
<CursorPos X="3" Y="336"/>
<UsageCount Value="100"/>
<Bookmarks Count="1">
<Item0 X="68" Y="3718" ID="1"/>
@ -150,11 +150,10 @@
<Unit3>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<UnitName Value="fpspreadsheetgrid"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="9"/>
<WindowIndex Value="0"/>
<TopLine Value="2415"/>
<CursorPos X="43" Y="2431"/>
<TopLine Value="115"/>
<CursorPos X="15" Y="132"/>
<UsageCount Value="100"/>
<Loaded Value="True"/>
</Unit3>
@ -218,10 +217,11 @@
<Unit11>
<Filename Value="..\..\fpsopendocument.pas"/>
<UnitName Value="fpsopendocument"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="6"/>
<WindowIndex Value="0"/>
<TopLine Value="719"/>
<CursorPos X="31" Y="734"/>
<TopLine Value="729"/>
<CursorPos X="38" Y="745"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit11>
@ -622,123 +622,123 @@
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="mainform.pas"/>
<Caret Line="661" Column="3" TopLine="654"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position1>
<Position2>
<Filename Value="mainform.pas"/>
<Caret Line="542" Column="56" TopLine="540"/>
<Caret Line="83" Column="19" TopLine="53"/>
</Position2>
<Position3>
<Filename Value="mainform.pas"/>
<Caret Line="728" Column="1" TopLine="704"/>
<Caret Line="229" Column="29" TopLine="199"/>
</Position3>
<Position4>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1316" Column="1" TopLine="1285"/>
<Filename Value="mainform.pas"/>
<Caret Line="540" Column="32" TopLine="509"/>
</Position4>
<Position5>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="394" Column="34" TopLine="394"/>
<Filename Value="mainform.pas"/>
<Caret Line="511" Column="29" TopLine="511"/>
</Position5>
<Position6>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Filename Value="mainform.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position6>
<Position7>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="501" Column="18" TopLine="470"/>
</Position7>
<Position8>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1430" Column="28" TopLine="1430"/>
</Position8>
<Position9>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position9>
<Position10>
<Filename Value="mainform.pas"/>
<Caret Line="704" Column="21" TopLine="704"/>
</Position10>
<Position11>
<Filename Value="mainform.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position11>
<Position12>
<Filename Value="mainform.pas"/>
<Caret Line="83" Column="19" TopLine="53"/>
</Position12>
<Position13>
</Position7>
<Position8>
<Filename Value="mainform.pas"/>
<Caret Line="229" Column="29" TopLine="199"/>
</Position13>
<Position14>
</Position8>
<Position9>
<Filename Value="mainform.pas"/>
<Caret Line="540" Column="32" TopLine="509"/>
</Position9>
<Position10>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1141" Column="28" TopLine="1111"/>
</Position10>
<Position11>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1142" Column="1" TopLine="1106"/>
</Position11>
<Position12>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1427" Column="3" TopLine="1408"/>
</Position12>
<Position13>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="533" Column="22" TopLine="523"/>
</Position13>
<Position14>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="404" Column="28" TopLine="391"/>
</Position14>
<Position15>
<Filename Value="mainform.pas"/>
<Caret Line="511" Column="29" TopLine="511"/>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1361" Column="37" TopLine="1342"/>
</Position15>
<Position16>
<Filename Value="mainform.pas"/>
<Filename Value="..\..\fpsopendocument.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position16>
<Position17>
<Filename Value="mainform.pas"/>
<Caret Line="83" Column="19" TopLine="53"/>
<Filename Value="..\..\fpsopendocument.pas"/>
<Caret Line="728" Column="41" TopLine="703"/>
</Position17>
<Position18>
<Filename Value="mainform.pas"/>
<Caret Line="229" Column="29" TopLine="199"/>
<Filename Value="..\..\xlsxooxml.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position18>
<Position19>
<Filename Value="mainform.pas"/>
<Caret Line="540" Column="32" TopLine="509"/>
<Filename Value="..\..\wikitable.pas"/>
<Caret Line="60" Column="41" TopLine="48"/>
</Position19>
<Position20>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1141" Column="28" TopLine="1111"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="557" Column="42" TopLine="539"/>
</Position20>
<Position21>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1142" Column="1" TopLine="1106"/>
<Filename Value="..\..\fpsopendocument.pas"/>
<Caret Line="480" Column="3" TopLine="457"/>
</Position21>
<Position22>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1427" Column="3" TopLine="1408"/>
<Filename Value="..\..\fpsopendocument.pas"/>
<Caret Line="281" Column="32" TopLine="266"/>
</Position22>
<Position23>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="533" Column="22" TopLine="523"/>
<Filename Value="..\..\fpsopendocument.pas"/>
<Caret Line="287" Column="35" TopLine="269"/>
</Position23>
<Position24>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="404" Column="28" TopLine="391"/>
<Caret Line="655" Column="14" TopLine="638"/>
</Position24>
<Position25>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1361" Column="37" TopLine="1342"/>
<Filename Value="..\..\fpsopendocument.pas"/>
<Caret Line="234" Column="31" TopLine="214"/>
</Position25>
<Position26>
<Filename Value="..\..\fpsopendocument.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
<Caret Line="292" Column="10" TopLine="271"/>
</Position26>
<Position27>
<Filename Value="..\..\fpsopendocument.pas"/>
<Caret Line="728" Column="41" TopLine="703"/>
<Caret Line="291" Column="45" TopLine="272"/>
</Position27>
<Position28>
<Filename Value="..\..\xlsxooxml.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
<Filename Value="..\..\fpsopendocument.pas"/>
<Caret Line="292" Column="15" TopLine="275"/>
</Position28>
<Position29>
<Filename Value="..\..\wikitable.pas"/>
<Caret Line="60" Column="41" TopLine="48"/>
<Filename Value="..\..\fpsopendocument.pas"/>
<Caret Line="231" Column="3" TopLine="212"/>
</Position29>
<Position30>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="557" Column="42" TopLine="539"/>
<Filename Value="..\..\fpsopendocument.pas"/>
<Caret Line="293" Column="58" TopLine="274"/>
</Position30>
</JumpHistory>
</ProjectOptions>

218
components/fpspreadsheet/fpsopendocument.pas
View File

@ -58,8 +58,12 @@ type
TsSpreadOpenDocReader = class(TsCustomSpreadReader)
private
FStyleList: TFPList;
FDateMode: TDateMode;
FWorksheet: TsWorksheet;
// Applies a style to a cell
procedure ApplyStyleToCell(ARow, ACol: Cardinal; AStyleName: String);
// Searches a style by its name in the StyleList
function FindStyleByName(AStyleName: String): integer;
// Gets value for the specified attribute. Returns empty string if attribute
// not found.
function GetAttrValue(ANode : TDOMNode; AAttrName : string) : string;
@ -68,6 +72,7 @@ type
protected
procedure CreateNumFormatList; override;
procedure ReadNumFormats(AStylesNode: TDOMNode);
procedure ReadStyles(AStylesNode: TDOMNode);
{ Record writing methods }
procedure ReadFormula(ARow : Word; ACol : Word; ACellNode: TDOMNode);
procedure ReadLabel(ARow : Word; ACol : Word; ACellNode: TDOMNode);
@ -75,6 +80,8 @@ type
procedure ReadDate(ARow : Word; ACol : Word; ACellNode: TDOMNode);
public
{ General reading methods }
constructor Create(AWorkbook: TsWorkbook); override;
destructor Destroy; override;
procedure ReadFromFile(AFileName: string; AData: TsWorkbook); override;
end;
@ -173,6 +180,22 @@ const
DATEMODE_1900_BASE=2; //StarCalc compatibility, 1900-01-01 in FPC DateTime
DATEMODE_1904_BASE=1462; //1/1/1904 in FPC TDateTime
type
{ Style items relevant to FPSpreadsheet. Stored in the StylesList of the reader. }
TStyleData = class
public
Name: String;
FontIndex: Integer;
NumFormatIndex: Integer;
HorAlignment: TsHorAlignment;
VertAlignment: TsVertAlignment;
WordWrap: Boolean;
TextRotation: TsTextRotation;
Borders: TsCellBorders;
BorderStyles: TsCellBorderStyles;
BackgroundColor: TsColor;
end;
{ TsSpreadOpenDocNumFormatList }
@ -181,8 +204,100 @@ begin
// there are no built-in number formats which are silently assumed to exist.
end;
{ TsSpreadOpenDocReader }
constructor TsSpreadOpenDocReader.Create(AWorkbook: TsWorkbook);
begin
inherited Create(AWorkbook);
FStyleList := TFPList.Create;
// Initial base date in case it won't be read from file
FDateMode := dm1899;
end;
destructor TsSpreadOpenDocReader.Destroy;
var
j: integer;
begin
for j := FStyleList.Count-1 downto 0 do TObject(FStyleList[j]).Free;
FStyleList.Free;
inherited Destroy;
end;
{ Applies the style data referred to by the style name to the specified cell }
procedure TsSpreadOpenDocReader.ApplyStyleToCell(ARow, ACol: Cardinal;
AStyleName: String);
var
cell: PCell;
styleData: TStyleData;
styleIndex: Integer;
numFmtData: TsNumFormatData;
begin
cell := FWorksheet.GetCell(ARow, ACol);
if Assigned(cell) then begin
styleIndex := FindStyleByName(AStyleName);
if styleIndex = -1 then
exit;
styleData := TStyleData(FStyleList[styleIndex]);
// Font
{
if style.FontIndex = 1 then
Include(cell^.UsedFormattingFields, uffBold)
else
if XFData.FontIndex > 1 then
Include(cell^.UsedFormattingFields, uffFont);
cell^.FontIndex := styleData.FontIndex;
}
// Alignment
cell^.HorAlignment := styleData.HorAlignment;
cell^.VertAlignment := styleData.VertAlignment;
// Word wrap
if styleData.WordWrap then
Include(cell^.UsedFormattingFields, uffWordWrap)
else
Exclude(cell^.UsedFormattingFields, uffWordWrap);
// Text rotation
if styleData.TextRotation > trHorizontal then
Include(cell^.UsedFormattingFields, uffTextRotation)
else
Exclude(cell^.UsedFormattingFields, uffTextRotation);
cell^.TextRotation := styledata.TextRotation;
// Borders
cell^.BorderStyles := styleData.BorderStyles;
if styleData.Borders <> [] then begin
Include(cell^.UsedFormattingFields, uffBorder);
cell^.Border := styleData.Borders;
end else
Exclude(cell^.UsedFormattingFields, uffBorder);
// Background color
if styleData.BackgroundColor <> 0 then begin
Include(cell^.UsedFormattingFields, uffBackgroundColor);
cell^.BackgroundColor := styleData.BackgroundColor;
end;
// Number format
if styleData.NumFormatIndex > -1 then
if cell^.ContentType = cctNumber then begin
numFmtData := NumFormatList[styleData.NumFormatIndex];
if numFmtData <> nil then begin
Include(cell^.UsedFormattingFields, uffNumberFormat);
cell^.NumberFormat := numFmtData.NumFormat;
cell^.NumberFormatStr := numFmtData.FormatString;
cell^.Decimals := numFmtData.Decimals;
cell^.CurrencySymbol := numFmtData.CurrencySymbol;
end;
end;
end;
end;
{ Creates the correct version of the number format list
suited for ODS file formats. }
procedure TsSpreadOpenDocReader.CreateNumFormatList;
@ -191,6 +306,15 @@ begin
FNumFormatList := TsSpreadOpenDocNumFormatList.Create(Workbook);
end;
function TsSpreadOpenDocReader.FindStyleByName(AStyleName: String): Integer;
begin
for Result:=0 to FStyleList.Count-1 do begin
if TStyleData(FStyleList[Result]).Name = AStyleName then
exit;
end;
Result := -1;
end;
function TsSpreadOpenDocReader.GetAttrValue(ANode : TDOMNode; AAttrName : string) : string;
var
i : integer;
@ -245,10 +369,10 @@ var
RowsCount, ColsCount : integer;
begin
//unzip content.xml into AFileName path
FilePath:=GetTempDir(false);
UnZip:=TUnZipper.Create;
UnZip.OutputPath:=FilePath;
FileList:=TStringList.Create;
FilePath := GetTempDir(false);
UnZip := TUnZipper.Create;
UnZip.OutputPath := FilePath;
FileList := TStringList.Create;
FileList.Add('styles.xml');
FileList.Add('content.xml');
try
@ -266,6 +390,7 @@ begin
StylesNode := Doc.DocumentElement.FindNode('office:styles');
ReadNumFormats(StylesNode);
ReadStyles(StylesNode);
//process the content.xml file
ReadXMLFile(Doc, FilePath+'content.xml');
@ -273,6 +398,7 @@ begin
StylesNode := Doc.DocumentElement.FindNode('office:automatic-styles');
ReadNumFormats(StylesNode);
ReadStyles(StylesNode);
BodyNode := Doc.DocumentElement.FindNode('office:body');
if not Assigned(BodyNode) then Exit;
@ -348,10 +474,11 @@ var
FSettings: TFormatSettings;
Value, Str: String;
lNumber: Double;
styleName: String;
begin
FSettings := DefaultFormatSettings;
FSettings.DecimalSeparator:='.';
Value:=GetAttrValue(ACellNode,'office:value');
Value := GetAttrValue(ACellNode,'office:value');
if UpperCase(Value)='1.#INF' then
begin
FWorkSheet.WriteNumber(Arow,ACol,1.0/0.0);
@ -363,6 +490,9 @@ begin
lNumber := StrToFloat(Str,FSettings);
FWorkSheet.WriteNumber(ARow,ACol,lNumber);
end;
styleName := GetAttrValue(ACellNode, 'table:style-name');
ApplyStyleToCell(ARow, ACol, stylename);
end;
procedure TsSpreadOpenDocReader.ReadDate(ARow: Word; ACol : Word; ACellNode : TDOMNode);
@ -596,6 +726,82 @@ begin
end;
end;
procedure TsSpreadOpenDocReader.ReadStyles(AStylesNode: TDOMNode);
var
style: TStyleData;
styleNode: TDOMNode;
styleChildNode: TDOMNode;
family: String;
styleName: String;
styleIndex: Integer;
numFmtName: String;
numFmtIndex: Integer;
numFmtIndexDefault: Integer;
wrap: Boolean;
borders: TsCellBorders;
s: String;
begin
if not Assigned(AStylesNode) then
exit;
numFmtIndexDefault := NumFormatList.FindByName('N0');
styleNode := AStylesNode.FirstChild;
while Assigned(styleNode) do begin
if styleNode.NodeName = 'style:style' then begin
family := GetAttrValue(styleNode, 'style:family');
if family = 'table-cell' then begin
styleName := GetAttrValue(styleNode, 'style:name');
numFmtName := GetAttrValue(styleNode, 'style:data-style-name');
numFmtIndex := -1;
if numFmtName <> '' then numFmtIndex := NumFormatList.FindByName(numFmtName);
if numFmtIndex = -1 then numFmtIndex := numFmtIndexDefault;
borders := [];
wrap := false;
styleChildNode := styleNode.FirstChild;
while Assigned(styleChildNode) do begin
if styleChildNode.NodeName = 'style:table-cell-properties' then begin
// Borders
s := GetAttrValue(styleChildNode, 'fo:border-top');
if (s <> '') and (s <> 'none') then Include(borders, cbNorth);
s := GetAttrValue(styleChildNode, 'fo:border-right');
if (s <> '') and (s <> 'none') then Include(borders, cbEast);
s := GetAttrValue(styleChildNode, 'fo:border-bottom');
if (s <> '') and (s <> 'none') then Include(borders, cbSouth);
s := GetAttrValue(styleChildNode, 'fo:border-left');
if (s <> '') and (s <> 'none') then Include(borders, cbWest);
// Text wrap
s := GetAttrValue(styleChildNode, 'fo:wrap-option');
wrap := (s='wrap');
end else
if styleChildNode.NodeName = 'style:paragraph-properties' then begin
//
end;
styleChildNode := styleChildNode.NextSibling;
end;
style := TStyleData.Create;
style.Name := stylename;
style.FontIndex := 0;
style.NumFormatIndex := numFmtIndex;
style.HorAlignment := haDefault;
style.VertAlignment := vaDefault;
style.WordWrap := wrap;
style.TextRotation := trHorizontal;
style.Borders := borders;
style.BorderStyles := DEFAULT_BORDERSTYLES;
style.BackgroundColor := scNotDefined;
styleIndex := FStyleList.Add(style);
end;
end;
styleNode := styleNode.NextSibling;
end;
end;
{ TsSpreadOpenDocWriter }

55
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -615,8 +615,9 @@ type
procedure Delete(AIndex: Integer);
function Find(ANumFormat: TsNumberFormat; AFormatString: String;
ADecimals: Byte; ACurrencySymbol: String): Integer; overload;
function Find(AFormatIndex: Integer): Integer; overload;
function Find(AFormatString: String): Integer; overload;
function FindByIndex(AFormatIndex: Integer): Integer;
function FindByName(AFormatName: String): Integer;
function FindFormatOf(AFormatCell: PCell): integer; virtual;
function FormatStringForWriting(AIndex: Integer): String; virtual;
procedure Sort;
@ -3007,11 +3008,11 @@ function TsCustomNumFormatList.AddFormat(AFormatName, AFormatString: String;
ANumFormat: TsNumberFormat; ADecimals: Byte = 0;
ACurrencySymbol: String = ''): Integer;
begin
if AFormatString = '' then begin
if (AFormatString = '') and (ANumFormat <> nfGeneral) then begin
Result := 0;
exit;
end;
Result := AddFormat(FNextFormatIndex, '', AFormatString, ANumFormat,
Result := AddFormat(FNextFormatIndex, AFormatName, AFormatString, ANumFormat,
ADecimals, ACurrencySymbol);
inc(FNextFormatIndex);
end;
@ -3071,7 +3072,7 @@ var
i: Integer;
nf: TsNumberFormat;
begin
i := Find(AFormatIndex);
i := FindByIndex(AFormatIndex);
if i > 0 then begin
lFormatData := Items[i];
fmt := lFormatData.FormatString;
@ -3131,7 +3132,7 @@ var
decs: Byte;
currsym: String;
begin
if Find(AFormatIndex) > -1 then
if FindByIndex(AFormatIndex) > -1 then
exit;
// Analyze & convert the format string, extract infos for internal formatting
@ -3224,20 +3225,6 @@ begin
Result := -1;
end;
{ Finds the item with the given format index and returns its index in
the format list. }
function TsCustomNumFormatList.Find(AFormatIndex: Integer): integer;
var
item: TsNumFormatData;
begin
for Result := 0 to Count-1 do begin
item := Items[Result];
if item.Index = AFormatIndex then
exit;
end;
Result := -1;
end;
{ Finds the item with the given format string and returns its index in the
format list. }
function TsCustomNumFormatList.Find(AFormatString: String): integer;
@ -3254,6 +3241,36 @@ begin
Result := -1;
end;
{ Finds the item with the given format index and returns its index in
the format list.
Is used by BIFF file formats. }
function TsCustomNumFormatList.FindByIndex(AFormatIndex: Integer): integer;
var
item: TsNumFormatData;
begin
for Result := 0 to Count-1 do begin
item := Items[Result];
if item.Index = AFormatIndex then
exit;
end;
Result := -1;
end;
{ Finds the item with the given format name and returns its index in
the format list.
To be used by XML file formats. }
function TsCustomNumFormatList.FindByName(AFormatName: String): integer;
var
item: TsNumFormatData;
begin
for Result := 0 to Count-1 do begin
item := Items[Result];
if item.Name = AFormatName then
exit;
end;
Result := -1;
end;
{ Determines whether the format attributed to the given cell is already
contained in the list and returns its list index. }
function TsCustomNumFormatList.FindFormatOf(AFormatCell: PCell): integer;

6
components/fpspreadsheet/xlscommon.pas
View File

@ -762,8 +762,6 @@ end;
{ TsSpreadBIFFReader }
constructor TsSpreadBIFFReader.Create(AWorkbook: TsWorkbook);
var
i: Integer;
begin
inherited Create(AWorkbook);
FXFList := TFPList.Create;
@ -914,7 +912,7 @@ var
begin
Result := nil;
lXFData := TXFListData(FXFList.Items[AXFIndex]);
i := NumFormatList.Find(lXFData.FormatIndex);
i := NumFormatList.FindByIndex(lXFData.FormatIndex);
if i <> -1 then Result := NumFormatList[i];
end;
@ -1773,7 +1771,7 @@ var
item: TsNumFormatData;
begin
ListAllNumFormats;
i := NumFormatList.Find(NumFormatList.FirstFormatIndexInFile);
i := NumFormatList.FindByIndex(NumFormatList.FirstFormatIndexInFile);
if i > -1 then
while i < NumFormatList.Count do begin
item := NumFormatList[i];