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

fpspreadsheet: Add font writing support to ods. Add font ods test cases. Passed.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3151 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-06-06 13:09:14 +00:00
parent 20567b639c
commit 712e0f9f27
4 changed files with 113 additions and 34 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

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

48
components/fpspreadsheet/fpsopendocument.pas
View File

@ -125,6 +125,8 @@ type
function WriteBackgroundColorStyleXMLAsString(const AFormat: TCell): String;
function WriteBorderStyleXMLAsString(const AFormat: TCell): String;
function WriteDefaultFontXMLAsString: String;
function WriteFontNamesXMLAsString: String;
function WriteFontStyleXMLAsString(const AFormat: TCell): String;
function WriteHorAlignmentStyleXMLAsString(const AFormat: TCell): String;
function WriteTextRotationStyleXMLAsString(const AFormat: TCell): String;
@ -1811,11 +1813,12 @@ begin
'" xmlns:text="' + SCHEMAS_XMLNS_TEXT +
'" xmlns:v="' + SCHEMAS_XMLNS_V + '">' + LineEnding +
'<office:font-face-decls>' + LineEnding +
' <style:font-face style:name="Arial" svg:font-family="Arial" />' + LineEnding +
' '+WriteFontNamesXMLAsString + LineEnding +
// ' <style:font-face style:name="Arial" svg:font-family="Arial" />' + LineEnding +
'</office:font-face-decls>' + LineEnding +
'<office:styles>' + LineEnding +
' <style:style style:name="Default" style:family="table-cell">' + LineEnding +
' <style:text-properties fo:font-size="10" style:font-name="Arial" />' + LineEnding +
' ' + WriteDefaultFontXMLAsString + LineEnding +
' </style:style>' + LineEnding +
'</office:styles>' + LineEnding +
'<office:automatic-styles>' + LineEnding +
@ -1891,7 +1894,8 @@ begin
// Fonts
' <office:font-face-decls>' + LineEnding +
' <style:font-face style:name="Arial" svg:font-family="Arial" xmlns:v="urn:schemas-microsoft-com:vml" />' + LineEnding +
' ' + WriteFontNamesXMLAsString + LineEnding +
// ' <style:font-face style:name="Arial" svg:font-family="Arial" xmlns:v="urn:schemas-microsoft-com:vml" />' + LineEnding +
' </office:font-face-decls>' + LineEnding +
// Automatic styles
@ -2436,6 +2440,41 @@ begin
Result := Result + 'fo:border-top="none" ';
end;
function TsSpreadOpenDocWriter.WriteDefaultFontXMLAsString: String;
var
fnt: TsFont;
begin
fnt := Workbook.GetFont(0);
Result := Format(
'<style:text-properties style:font-name="%s" fo:font-size="%.1f" />',
[fnt.FontName, fnt.Size], FPointSeparatorSettings
);
end;
function TsSpreadOpenDocWriter.WriteFontNamesXMLAsString: String;
var
L: TStringList;
fnt: TsFont;
i: Integer;
begin
Result := '';
L := TStringList.Create;
try
for i:=0 to Workbook.GetFontCount-1 do begin
fnt := Workbook.GetFont(i);
if (fnt <> nil) and (L.IndexOf(fnt.FontName) = -1) then
L.Add(fnt.FontName);
end;
for i:=0 to L.Count-1 do
Result := Format(
'<style:font-face style:name="%s" svg:font-family="%s" />',
[ L[i], L[i] ]
);
finally
L.Free;
end;
end;
function TsSpreadOpenDocWriter.WriteFontStyleXMLAsString(const AFormat: TCell): String;
var
fnt: TsFont;
@ -2443,6 +2482,9 @@ var
begin
Result := '';
if not (uffFont in AFormat.UsedFormattingFields) then
exit;
fnt := Workbook.GetFont(AFormat.FontIndex);
defFnt := Workbook.GetFont(0); // Defaultfont

9
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -565,6 +565,7 @@ type
procedure CopyFontList(ASource: TFPList);
function FindFont(const AFontName: String; ASize: Single;
AStyle: TsFontStyles; AColor: TsColor): Integer;
function GetDefaultFont: TsFont;
function GetDefaultFontSize: Single;
function GetFont(AIndex: Integer): TsFont;
function GetFontCount: Integer;
@ -2955,6 +2956,14 @@ begin
end;
end;
{@@
Returns the default font. This is the first font (index 0) in the font list
}
function TsWorkbook.GetDefaultFont: TsFont;
begin
Result := GetFont(0);
end;
{@@
Returns the point size of the default font
}

76
components/fpspreadsheet/tests/fonttests.pas
View File

@ -38,22 +38,28 @@ type
published
// BIFF2 test cases
procedure TestWriteReadBold_BIFF2;
procedure TestWriteReadFont_BIFF2_Arial;
procedure TestWriteReadFont_BIFF2_TimesNewRoman;
procedure TestWriteReadFont_BIFF2_CourierNew;
procedure TestWriteRead_BIFF2_Bold;
procedure TestWriteRead_BIFF2_Font_Arial;
procedure TestWriteRead_BIFF2_Font_TimesNewRoman;
procedure TestWriteRead_BIFF2_Font_CourierNew;
// BIFF5 test cases
procedure TestWriteReadBold_BIFF5;
procedure TestWriteReadFont_BIFF5_Arial;
procedure TestWriteReadFont_BIFF5_TimesNewRoman;
procedure TestWriteReadFont_BIFF5_CourierNew;
procedure TestWriteRead_BIFF5_Bold;
procedure TestWriteRead_BIFF5_Font_Arial;
procedure TestWriteRead_BIFF5_Font_TimesNewRoman;
procedure TestWriteRead_BIFF5_Font_CourierNew;
// BIFF8 test cases
procedure TestWriteReadBold_BIFF8;
procedure TestWriteReadFont_BIFF8_Arial;
procedure TestWriteReadFont_BIFF8_TimesNewRoman;
procedure TestWriteReadFont_BIFF8_CourierNew;
procedure TestWriteRead_BIFF8_Bold;
procedure TestWriteRead_BIFF8_Font_Arial;
procedure TestWriteRead_BIFF8_Font_TimesNewRoman;
procedure TestWriteRead_BIFF8_Font_CourierNew;
// ODS test cases
procedure TestWriteRead_ODS_Bold;
procedure TestWriteRead_ODS_Font_Arial;
procedure TestWriteRead_ODS_Font_TimesNewRoman;
procedure TestWriteRead_ODS_Font_CourierNew;
end;
implementation
@ -190,21 +196,26 @@ begin
DeleteFile(TempFile);
end;
procedure TSpreadWriteReadFontTests.TestWriteReadBold_BIFF2;
procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF2_Bold;
begin
TestWriteReadBold(sfExcel2);
end;
procedure TSpreadWriteReadFontTests.TestWriteReadBold_BIFF5;
procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF5_Bold;
begin
TestWriteReadBold(sfExcel5);
end;
procedure TSpreadWriteReadFontTests.TestWriteReadBold_BIFF8;
procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF8_Bold;
begin
TestWriteReadBold(sfExcel8);
end;
procedure TSpreadWriteReadFontTests.TestWriteRead_ODS_Bold;
begin
TestWriteReadBold(sfOpenDocument);
end;
procedure TSpreadWriteReadFontTests.TestWriteReadFont(AFormat: TsSpreadsheetFormat;
AFontName: String);
var
@ -282,54 +293,71 @@ begin
end;
{ BIFF2 }
procedure TSpreadWriteReadFontTests.TestWriteReadFont_BIFF2_Arial;
procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF2_Font_Arial;
begin
TestWriteReadFont(sfExcel2, 'Arial');
end;
procedure TSpreadWriteReadFontTests.TestWriteReadFont_BIFF2_TimesNewRoman;
procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF2_Font_TimesNewRoman;
begin
TestWriteReadFont(sfExcel2, 'Times New Roman');
end;
procedure TSpreadWriteReadFontTests.TestWriteReadFont_BIFF2_CourierNew;
procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF2_Font_CourierNew;
begin
TestWriteReadFont(sfExcel2, 'Courier New');
end;
{ BIFF5 }
procedure TSpreadWriteReadFontTests.TestWriteReadFont_BIFF5_Arial;
procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF5_Font_Arial;
begin
TestWriteReadFont(sfExcel5, 'Arial');
end;
procedure TSpreadWriteReadFontTests.TestWriteReadFont_BIFF5_TimesNewRoman;
procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF5_Font_TimesNewRoman;
begin
TestWriteReadFont(sfExcel5, 'Times New Roman');
end;
procedure TSpreadWriteReadFontTests.TestWriteReadFont_BIFF5_CourierNew;
procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF5_Font_CourierNew;
begin
TestWriteReadFont(sfExcel5, 'Courier New');
end;
{ BIFF8 }
procedure TSpreadWriteReadFontTests.TestWriteReadFont_BIFF8_Arial;
procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF8_Font_Arial;
begin
TestWriteReadFont(sfExcel8, 'Arial');
end;
procedure TSpreadWriteReadFontTests.TestWriteReadFont_BIFF8_TimesNewRoman;
procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF8_Font_TimesNewRoman;
begin
TestWriteReadFont(sfExcel8, 'Times New Roman');
end;
procedure TSpreadWriteReadFontTests.TestWriteReadFont_BIFF8_CourierNew;
procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF8_Font_CourierNew;
begin
TestWriteReadFont(sfExcel8, 'Courier New');
end;
{ ODS }
procedure TSpreadWriteReadFontTests.TestWriteRead_ODS_Font_Arial;
begin
TestWriteReadFont(sfOpenDocument, 'Arial');
end;
procedure TSpreadWriteReadFontTests.TestWriteRead_ODS_Font_TimesNewRoman;
begin
TestWriteReadFont(sfOpenDocument, 'Times New Roman');
end;
procedure TSpreadWriteReadFontTests.TestWriteRead_ODS_Font_CourierNew;
begin
TestWriteReadFont(sfOpenDocument, 'Courier New');
end;
initialization
RegisterTest(TSpreadWriteReadFontTests);