paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fpspreadsheet: Fix regression in previous commit (usage of nil in WriteCellCallback). Write font list to styles.xml.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3310 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2014-07-11 22:43:00 +00:00
parent e6e961d51f
commit 36658107bc
2 changed files with 36 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/fpspreadsheet/xlsbiff8.pas
View File

@ -673,7 +673,7 @@ end;
{******************************************************************* {*******************************************************************
* TsSpreadBIFF8Writer.WriteFonts () * TsSpreadBIFF8Writer.WriteFonts ()
* *
* DESCRIPTION: Writes the Excel 8 FONT records neede for the * DESCRIPTION: Writes the Excel 8 FONT records needed for the
* used fonts in the workbook. * used fonts in the workbook.
* *
*******************************************************************} *******************************************************************}

43
components/fpspreadsheet/xlsxooxml.pas
View File

@ -69,6 +69,7 @@ type
procedure DestroyStreams; procedure DestroyStreams;
procedure ResetStreams; procedure ResetStreams;
function GetStyleIndex(ACell: PCell): Cardinal; function GetStyleIndex(ACell: PCell): Cardinal;
procedure WriteFonts(AStream: TStream);
protected protected
{ Streams with the contents of files } { Streams with the contents of files }
FSContentTypes: TStream; FSContentTypes: TStream;
@ -148,6 +149,36 @@ const
{ TsSpreadOOXMLWriter } { TsSpreadOOXMLWriter }
procedure TsSpreadOOXMLWriter.WriteFonts(AStream: TStream);
var
i: Integer;
font: TsFont;
bold, italic, underline, strikeout, color: String;
rgb: TsColorValue;
begin
AppendToStream(FSStyles, Format(
'<fonts count="%d">', [Workbook.GetFontCount]));
for i:=0 to Workbook.GetFontCount-1 do begin
font := Workbook.GetFont(i);
if font <> nil then begin
if (fssBold in font.Style) then bold := '<b />' else bold := '';
if (fssItalic in font.Style) then italic := '<i />' else italic := '';
if (fssUnderline in font.Style) then underline := '<u />' else underline := '';
if (fssStrikeout in font.Style) then strikeout := '<strike />' else strikeout := '';
if font.Color <> scBlack then begin
rgb := Workbook.GetPaletteColor(font.Color);
color := Format('<color rgb="%s" />', [ColorToHTMLColorStr(rgb)])
end else
color := '';
AppendToStream(AStream, Format(
'<font><sz val="%g" />%s<name val="%s" />%s%s%s%s</font>', [
font.Size, color, font.FontName, bold, italic, underline, strikeout]));
end;
end;
AppendToStream(AStream,
'</fonts>');
end;
procedure TsSpreadOOXMLWriter.WriteGlobalFiles; procedure TsSpreadOOXMLWriter.WriteGlobalFiles;
var var
i: Integer; i: Integer;
@ -191,13 +222,9 @@ begin
XML_Header); XML_Header);
AppendToStream(FSStyles, Format( AppendToStream(FSStyles, Format(
'<styleSheet xmlns="%s">', [SCHEMAS_SPREADML])); '<styleSheet xmlns="%s">', [SCHEMAS_SPREADML]));
AppendToStream(FSStyles,
'<fonts count="2">'); WriteFonts(FSStyles);
AppendToStream(FSStyles,
'<font><sz val="10" /><name val="Arial" /></font>',
'<font><sz val="10" /><name val="Arial" /><b val="true"/></font>');
AppendToStream(FSStyles,
'</fonts>');
AppendToStream(FSStyles, AppendToStream(FSStyles,
'<fills count="2">'); '<fills count="2">');
AppendToStream(FSStyles, AppendToStream(FSStyles,
@ -437,7 +464,7 @@ begin
LCell.Col := c; LCell.Col := c;
AVLNode := CurSheet.Cells.Find(@LCell); AVLNode := CurSheet.Cells.Find(@LCell);
if Assigned(AVLNode) then if Assigned(AVLNode) then
WriteCellCallback(PCell(AVLNode.Data), nil) WriteCellCallback(PCell(AVLNode.Data), FSSheets[FCurSheetNum])
else begin else begin
CellPosText := CurSheet.CellPosToText(r, c); CellPosText := CurSheet.CellPosToText(r, c);
AppendToStream(FSSheets[FCurSheetNum], Format( AppendToStream(FSSheets[FCurSheetNum], Format(