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

fpspreadsheet: Write font attributes to ods file (except for font name).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3148 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-06-06 11:16:23 +00:00
parent d7ee2a84d8
commit ebf3fce852
2 changed files with 40 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpr
View File

@ -35,6 +35,7 @@ begin
// Add some formatting
MyWorksheet.WriteUsedFormatting(0, 0, [uffBold]);
MyWorksheet.WriteFontColor(0, 1, scRed);
// Creates a new worksheet
MyWorksheet := MyWorkbook.AddWorksheet('My Worksheet 2');

39
components/fpspreadsheet/fpsopendocument.pas
View File

@ -125,6 +125,7 @@ type
function WriteBackgroundColorStyleXMLAsString(const AFormat: TCell): String;
function WriteBorderStyleXMLAsString(const AFormat: TCell): String;
function WriteFontStyleXMLAsString(const AFormat: TCell): String;
function WriteHorAlignmentStyleXMLAsString(const AFormat: TCell): String;
function WriteTextRotationStyleXMLAsString(const AFormat: TCell): String;
function WriteVertAlignmentStyleXMLAsString(const AFormat: TCell): String;
@ -1972,6 +1973,11 @@ begin
Result := Result +
' <style:text-properties fo:font-weight="bold" style:font-weight-asian="bold" style:font-weight-complex="bold"/>' + LineEnding;
s := WriteFontStyleXMLAsString(FFormattingStyles[i]);
if s <> '' then
Result := Result +
' <style:text-properties '+ s + '/>' + LineEnding;
// style:table-cell-properties
s := WriteBorderStyleXMLAsString(FFormattingStyles[i]) +
WriteBackgroundColorStyleXMLAsString(FFormattingStyles[i]) +
@ -2430,6 +2436,39 @@ begin
Result := Result + 'fo:border-top="none" ';
end;
function TsSpreadOpenDocWriter.WriteFontStyleXMLAsString(const AFormat: TCell): String;
var
fnt: TsFont;
defFnt: TsFont;
begin
Result := '';
fnt := Workbook.GetFont(AFormat.FontIndex);
defFnt := Workbook.GetFont(0); // Defaultfont
if fnt.FontName <> defFnt.FontName then
Result := Result + Format('style:font-name="%s" ', [fnt.FontName]);
if fnt.Size <> defFnt.Size then
Result := Result + Format('fo:font-size="%.1fpt" style:font-size-asian="%.1fpt" style:font-size-complex="%.1fpt" ',
[fnt.Size, fnt.Size, fnt.Size], FPointSeparatorSettings);
if fssBold in fnt.Style then
Result := Result + 'fo:font-weight="bold" style:font-weight-asian="bold" style:font-weight-complex="bold" ';
if fssItalic in fnt.Style then
Result := Result + 'fo:font-style="italic" style:font-style-asian="italic" style:font-style-complex="italic" ';
if fssUnderline in fnt.Style then
Result := Result + 'style:text-underline-style="solid" style:text-underline-width="auto" style:text-underline-color="font-color" ';
if fssStrikeout in fnt.Style then
Result := Result + 'style:text-line-through-style="solid" ';
if fnt.Color <> defFnt.Color then
Result := Result + Format('fo:color="%s" ', [Workbook.GetPaletteColorAsHTMLStr(fnt.Color)]);
end;
{ Creates an XML string for inclusion of the horizontal alignment into the
written file from the horizontal alignment setting in the format cell.
Is called from WriteStyles (via WriteStylesXMLAsString). }