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

fpspreadsheet: optimize workbook font infrastructure to avoid that missing font 4 dictated by Excel. Remove UsedFormattingField uffBold (obsolete since supporting fonts).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4015 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-03-11 22:28:07 +00:00
parent 24b49277c1
commit c7c8d73179
21 changed files with 185 additions and 329 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
components/fpspreadsheet/examples/csvdemo/csvwrite.lpr
View File

@@ -44,7 +44,7 @@ begin
MyWorksheet.TopPaneHeight := 3;
// Write some number cells
MyWorksheet.WriteUsedFormatting(0, 0, [uffBold, uffNumberFormat]);
MyWorksheet.WriteFont(0, 0, BOLD_FONTINDEX);
MyWorksheet.WriteNumber(0, 1, 2.0);
MyWorksheet.WriteNumber(0, 2, 3.0);
MyWorksheet.WriteNumber(0, 3, 4.0);

2
components/fpspreadsheet/examples/excel2demo/excel2write.lpr
View File

@@ -46,7 +46,7 @@ begin
// Write some number cells
MyWorksheet.WriteNumber(0, 0, 1.0);
MyWorksheet.WriteUsedFormatting(0, 0, [uffBold, uffNumberFormat]);
MyWorksheet.WriteFontStyle(0, 0, [fssBold]);
MyWorksheet.WriteNumber(0, 1, 2.0);
MyWorksheet.WriteNumber(0, 2, 3.0);
MyWorksheet.WriteNumber(0, 3, 4.0);

2
components/fpspreadsheet/examples/excel8demo/excel8write.lpr
View File

@@ -384,7 +384,7 @@ begin
MyWorksheet.WriteUTF8Text(0, 2, Str_Third);
MyWorksheet.WriteUTF8Text(0, 3, Str_Fourth);
MyWorksheet.WriteTextRotation(0, 0, rt90DegreeClockwiseRotation);
MyWorksheet.WriteUsedFormatting(0, 1, [uffBold]);
MyWorksheet.WriteFontStyle(0, 1, [fssBold]);
// Save the spreadsheet to a file
MyWorkbook.WriteToFile(MyDir + 'test.xls', sfExcel8, true);

8
components/fpspreadsheet/examples/ooxmldemo/ooxmlwrite.lpr
View File

@@ -55,13 +55,13 @@ begin
// Test for Bold
MyCell := MyWorksheet.GetCell(2, 0);
MyCell^.UsedFormattingFields := [uffBold];
MyCell^.FontIndex := BOLD_FONTINDEX;
MyCell := MyWorksheet.GetCell(2, 1);
MyCell^.UsedFormattingFields := [uffBold];
MyCell^.FontIndex := BOLD_FONTINDEX;
MyCell := MyWorksheet.GetCell(2, 2);
MyCell^.UsedFormattingFields := [uffBold];
MyCell^.FontIndex := BOLD_FONTINDEX;
MyCell := MyWorksheet.GetCell(2, 3);
MyCell^.UsedFormattingFields := [uffBold];
MyCell^.FontIndex := BOLD_FONTINDEX;
// Background and text color
MyWorksheet.WriteUTF8Text(4, 0, 'white on red');

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

@@ -48,7 +48,7 @@ begin
MyWorksheet.WriteDateTime(5, 0, now);
// Add some formatting
MyWorksheet.WriteUsedFormatting(0, 0, [uffBold]);
MyWorksheet.WriteFontStyle(0, 0, [fssBold]);
MyWorksheet.WriteFont(0, 1, 'Times New Roman', 16, [], scRed);
// Show number formats

24
components/fpspreadsheet/examples/other/demo_expression_parser.pas
View File

@@ -28,21 +28,19 @@ begin
worksheet.WriteNumber(0, 0, 1); // A1
worksheet.WriteNumber(0, 1, 2.5); // B1
{
worksheet.WriteUTF8Text(0, 0, 'Hallo'); // A1
worksheet.WriteUTF8Text(0, 1, 'World'); // B1
}
//cell := worksheet.WriteFormula(1, 0, '=4+5'); // A2
//cell := worksheet.WriteFormula(1, 0, 'AND(TRUE(), TRUE(), TRUE())');
//cell := worksheet.WriteFormula(1, 0, 'SIN(A1+B1)');
//cell := worksheet.WriteFormula(1, 0, '=TRUE()');
//cell := worksheet.WriteFormula(1, 0, '=1-(4/2)^2*2-1'); // A2
//cell := Worksheet.WriteFormula(1, 0, 'datedif(today(),Date(2014,1,1),"D")');
//cell := Worksheet.WriteFormula(1, 0, 'Day(Date(2014, 1, 12))');
//cell := Worksheet.WriteFormula(1, 0, 'SUM(1,2,3)');
//cell := Worksheet.WriteFormula(1, 0, 'CELL("address",A1)');
// cell := Worksheet.WriteFormula(1, 0, 'REPT("Hallo", 3)');
cell := Worksheet.WriteFormula(1, 0, '#REF!');
cell := worksheet.WriteFormula(1, 0, '=4+5'); // A2
cell := worksheet.WriteFormula(2, 0, 'AND(TRUE(), TRUE(), TRUE())');
cell := worksheet.WriteFormula(3, 0, 'SIN(A1+B1)');
cell := worksheet.WriteFormula(4, 0, '=TRUE()');
cell := worksheet.WriteFormula(5, 0, '=1-(4/2)^2*2-1'); // A2
cell := Worksheet.WriteFormula(6, 0, 'datedif(today(),Date(2014,1,1),"D")');
cell := Worksheet.WriteFormula(7, 0, 'Day(Date(2014, 1, 12))');
cell := Worksheet.WriteFormula(8, 0, 'SUM(1,2,3)');
cell := Worksheet.WriteFormula(9, 0, 'CELL("address",A1)');
cell := Worksheet.WriteFormula(10, 0, 'REPT("Hallo", 3)');
cell := Worksheet.WriteFormula(11, 0, '#REF!');
WriteLn('A1: ', worksheet.ReadAsUTF8Text(0, 0));
WriteLn('B1: ', worksheet.ReadAsUTF8Text(0, 1));

8
components/fpspreadsheet/fpsactions.pas
View File

@@ -821,9 +821,6 @@ begin
end;
fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
if (uffBold in fmt^.UsedFormattingFields) then
Checked := (FFontStyle = fssBold)
else
if (uffFont in fmt^.UsedFormattingFields) then
begin
fnt := Workbook.GetFont(fmt^.FontIndex);
@@ -1416,9 +1413,10 @@ begin
sfnt := Workbook.GetDefaultFont
else begin
fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
{
if (uffBold in fmt^.UsedFormattingFields) then
sfnt := Workbook.GetFont(1)
else
sfnt := Workbook.GetFont(BOLD_FONTINDEX)
else}
if (uffFont in fmt^.UsedFormattingFields) then
sfnt := Workbook.GetFont(fmt^.FontIndex)
else

8
components/fpspreadsheet/fpsopendocument.pas
View File

@@ -2394,9 +2394,11 @@ begin
fmt.FontIndex := ReadFont(styleChildNode, HYPERLINK_FONTINDEX)
else
fmt.FontIndex := ReadFont(styleChildNode);
if fmt.FontIndex = 1 then
{
if fmt.FontIndex = BOLD_FONTINDEX then
Include(fmt.UsedFormattingFields, uffBold)
else if fmt.FontIndex > 1 then
else }
if fmt.FontIndex > 0 then
Include(fmt.UsedFormattingFields, uffFont);
end else
if nodeName = 'style:table-cell-properties' then
@@ -2981,9 +2983,11 @@ begin
'style:parent-style-name="Default" '+ nfs + '>');
// style:text-properties
{
if (uffBold in fmt.UsedFormattingFields) then
AppendToStream(AStream,
'<style:text-properties fo:font-weight="bold" style:font-weight-asian="bold" style:font-weight-complex="bold"/>');
}
s := WriteFontStyleXMLAsString(fmt);
if s <> '' then

70
components/fpspreadsheet/fpspreadsheet.pas
View File

@@ -638,10 +638,10 @@ type
function AddFont(const AFontName: String; ASize: Single;
AStyle: TsFontStyles; AColor: TsColor): Integer; overload;
function AddFont(const AFont: TsFont): Integer; overload;
procedure CopyFontList(ASource: TFPList);
procedure DeleteFont(AFontIndex: Integer);
function FindFont(const AFontName: String; ASize: Single;
AStyle: TsFontStyles; AColor: TsColor): Integer;
function GetBuiltinFontCount: Integer;
function GetDefaultFont: TsFont;
function GetDefaultFontSize: Single;
function GetFont(AIndex: Integer): TsFont;
@@ -2887,10 +2887,12 @@ begin
if ACell <> nil then
begin
fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
{
if (uffBold in fmt^.UsedFormattingFields) then
Result := Workbook.GetFont(1)
Result := Workbook.GetFont(BOLD_FONTINDEX)
else
Result := Workbook.GetFont(fmt^.FontIndex);
}
Result := Workbook.GetFont(fmt^.FontIndex);
end;
if Result = nil then
Result := Workbook.GetDefaultFont;
@@ -6078,6 +6080,9 @@ end;
-------------------------------------------------------------------------------}
procedure TsWorkbook.PrepareBeforeReading;
begin
// Initializes fonts
InitFonts;
// Clear error log
FLog.Clear;
@@ -6995,14 +7000,16 @@ begin
if fmt = nil then
exit;
{
if (uffBold in fmt^.UsedFormattingFields) then
Result := Format('%s; bold', [Result]);
}
if (uffFont in fmt^.UsedFormattingFields) then
Result := Format('%s; Font%d', [Result, fmt^.FontIndex]);
if (uffBackground in fmt^.UsedFormattingFields) then begin
Result := Format('%s; Bg %s', [GetColorName(fmt^.Background.BgColor)]);
Result := Format('%s; Fg %s', [GetColorName(fmt^.Background.FgColor)]);
Result := Format('%s; Pattern %s', [GetEnumName(TypeInfo(TsFillStyle), ord(fmt^.Background.Style))]);
Result := Format('%s; Bg %s', [Result, GetColorName(fmt^.Background.BgColor)]);
Result := Format('%s; Fg %s', [Result, GetColorName(fmt^.Background.FgColor)]);
Result := Format('%s; Pattern %s', [Result, GetEnumName(TypeInfo(TsFillStyle), ord(fmt^.Background.Style))]);
end;
if (uffHorAlign in fmt^.UsedFormattingfields) then
Result := Format('%s; %s', [Result, GetEnumName(TypeInfo(TsHorAlignment), ord(fmt^.HorAlignment))]);
@@ -7075,30 +7082,9 @@ end;
-------------------------------------------------------------------------------}
function TsWorkbook.AddFont(const AFont: TsFont): Integer;
begin
// Font index 4 does not exist in BIFF. Avoid that a real font gets this index.
if FFontList.Count = 4 then
FFontList.Add(nil);
result := FFontList.Add(AFont);
end;
{@@ ----------------------------------------------------------------------------
Copies a font list to the workbook's font list
@param ASource Font list to be copied
-------------------------------------------------------------------------------}
procedure TsWorkbook.CopyFontList(ASource: TFPList);
var
fnt: TsFont;
i: Integer;
begin
RemoveAllFonts;
for i:=0 to ASource.Count-1 do
begin
fnt := TsFont(ASource.Items[i]);
AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
end;
end;
{@@ ----------------------------------------------------------------------------
Deletes a font.
Use with caution because this will screw up the font assignment to cells.
@@ -7150,12 +7136,9 @@ end;
Initializes the font list by adding 5 fonts:
0: default font
1: like default font, but bold
2: like default font, but italic
3: like default font, but underlined
4: empty (due to a restriction of Excel)
5: like default font, but bold and italic
6: like default font, but blue and underlined (for hyperlinks)
1: like default font, but blue and underlined (for hyperlinks)
2: like default font, but bold
3: like default font, but italic
-------------------------------------------------------------------------------}
procedure TsWorkbook.InitFonts;
var
@@ -7173,14 +7156,10 @@ begin
RemoveAllFonts;
// Build new font list
SetDefaultFont(fntName, fntSize); // Default font (FONT0)
AddFont(fntName, fntSize, [fssBold], scBlack); // FONT1 for uffBold
AddFont(fntName, fntSize, [fssItalic], scBlack); // FONT2 (Italic)
AddFont(fntName, fntSize, [fssUnderline], scBlack); // FONT3 (fUnderline)
// FONT4 which does not exist in BIFF is added automatically with nil as place-holder
AddFont(fntName, fntSize, [fssBold, fssItalic], scBlack); // FONT5 (bold & italic)
AddFont(fntName, fntSize, [fssUnderline], scBlue); // FONT6 (blue & underlined)
SetDefaultFont(fntName, fntSize); // FONT0: Default font
AddFont(fntName, fntSize, [fssUnderline], scBlue); // FONT1: Hyperlink font = blue & underlined
AddFont(fntName, fntSize, [fssBold], scBlack); // FONT2: Bold font
AddFont(fntName, fntSize, [fssItalic], scBlack); // FONT3: Italic font (not used directly)
FBuiltinFontCount := FFontList.Count;
end;
@@ -7240,6 +7219,15 @@ begin
end;
end;
{@@ ----------------------------------------------------------------------------
Returns the count of built-in fonts (default font, hyperlink font, bold font
by default).
-------------------------------------------------------------------------------}
function TsWorkbook.GetBuiltinFontCount: Integer;
begin
Result := FBuiltinFontCount;
end;
{@@ ----------------------------------------------------------------------------
Returns the default font. This is the first font (index 0) in the font list
-------------------------------------------------------------------------------}

24
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@@ -2503,30 +2503,6 @@ begin
Convert_sFont_to_Font(fnt, FCellFont);
Result := FCellFont;
end;
{
if (Workbook <> nil) and (Worksheet <> nil) then
begin
cell := Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol));
if (cell <> nil) then
begin
if (uffBold in cell^.UsedFormattingFields) then
fnt := Workbook.GetFont(1)
else
if (uffFont in cell^.UsedFormattingFields) then
fnt := Workbook.GetFont(cell^.FontIndex)
else
fnt := Workbook.GetDefaultFont;
Convert_sFont_to_Font(fnt, FCellFont);
Result := FCellFont;
end;
end;
if Result = nil then
begin
fnt := Workbook.GetDefaultFont;
Convert_sFont_to_Font(fnt, FCellFont);
Result := FCellFont;
end;
}
end;
{@@ ----------------------------------------------------------------------------

95
components/fpspreadsheet/fpsreaderwriter.pas
View File

@@ -32,6 +32,8 @@ type
protected
{@@ list of format records collected from the file }
FCellFormatList: TsCellFormatList;
{@@ List of fonts collected from the file }
FFontList: TFPList;
{@@ Temporary cell for virtual mode}
FVirtualCell: TCell;
{@@ Stores if the reader is in virtual mode }
@@ -190,6 +192,8 @@ end;
constructor TsCustomSpreadReader.Create(AWorkbook: TsWorkbook);
begin
inherited Create(AWorkbook);
// Font list
FFontList := TFPList.Create;
// Number formats
CreateNumFormatList;
// Virtual mode
@@ -202,7 +206,13 @@ end;
error log list.
-------------------------------------------------------------------------------}
destructor TsCustomSpreadReader.Destroy;
var
j: Integer;
begin
for j:=FFontList.Count-1 downto 0 do
if FFontList[j] <> nil then TObject(FFontList[j]).Free;
FreeAndNil(FFontList);
FreeAndNil(FNumFormatList);
FreeAndNil(FCellFormatList);
inherited Destroy;
@@ -455,92 +465,7 @@ begin
if ALastRow >= Limitations.MaxRowCount then
ALastRow := Limitations.MaxRowCount-1;
end;
(*
{@@ ----------------------------------------------------------------------------
A generic method to iterate through all cells in a worksheet and call a callback
routine for each cell.
@param AStream The output stream, passed to the callback routine.
@param ACells List of cells to be iterated
@param ACallback Callback routine; it requires as arguments a pointer to the
cell as well as the destination stream.
-------------------------------------------------------------------------------}
procedure TsCustomSpreadWriter.IterateThroughCells(AStream: TStream;
ACells: TsCells; ACallback: TCellsCallback);
var
cell: PCell;
node: TAVLTreeNode;
begin
node := ACells.FindLowest;
while Assigned(node) do begin
ACallback(PCell(node.Data), AStream);
node := ACells.FindSuccessor(node);
end;
{
ACells.PushCurrent;
try
cell := ACells.GetFirstCell;
while Assigned(cell) do
begin
ACallback(cell, AStream);
cell := ACells.GetNextCell;
end;
finally
ACells.PopCurrent;
end;
}
end;
{@@ ----------------------------------------------------------------------------
A generic method to iterate through all comments in a worksheet and call a
callback routine for each comment.
@param AStream The output stream, passed to the callback routine.
@param AComments List of comments to be iterated
@param ACallback Callback routine; it requires as arguments a pointer to the
comment record as well as the destination stream.
-------------------------------------------------------------------------------}
procedure TsCustomSpreadWriter.IterateThroughComments(AStream: TStream;
AComments: TsComments; ACallback: TCommentsCallback);
var
index: Integer;
comment: PsComment;
begin
index := 0;
for comment in AComments do
begin
ACallback(comment, index, AStream);
inc(index);
end;
end;
{@@ ----------------------------------------------------------------------------
A generic method to iterate through all hyperlinks in a worksheet and call a
callback routine for each hyperlink.
@param AStream The output stream, passed to the callback routine.
@param AHyperlinks List of hyperlinks to be iterated
@param ACallback Callback routine; it requires as arguments a pointer to
the hyperlink record as well as the destination stream.
-------------------------------------------------------------------------------}
procedure TsCustomSpreadWriter.IterateThroughHyperlinks(AStream: TStream;
AHyperlinks: TsHyperlinks; ACallback: THyperlinksCallback);
var
hyperlink: PsHyperlink;
begin
AHyperlinks.PushCurrent;
try
hyperlink := PsHyperlink(AHyperlinks.GetFirst);
while Assigned(hyperlink) do
begin
ACallback(hyperlink, AStream);
hyperlink := PsHyperlink(AHyperlinks.GetNext);
end;
finally
AHyperlinks.PopCurrent;
end;
end;
*)
{@@ ----------------------------------------------------------------------------
Iterates through all cells and collects the number formats in
FNumFormatList (without duplicates).

8
components/fpspreadsheet/fpstypes.pas
View File

@@ -43,7 +43,11 @@ const
{@@ Index of the default font in workbook's font list }
DEFAULT_FONTINDEX = 0;
{@@ Index of the hyperlink font in workbook's font list }
HYPERLINK_FONTINDEX = 6;
HYPERLINK_FONTINDEX = 1;
{@@ Index of bold default font in workbook's font list }
BOLD_FONTINDEX = 2;
{@@ Index of italic default font in workbook's font list - not used directly }
INTALIC_FONTINDEX = 3;
{@@ Takes account of effect of cell margins on row height by adding this
value to the nominal row height. Note that this is an empirical value
@@ -181,7 +185,7 @@ type
);
{@@ List of possible formatting fields }
TsUsedFormattingField = (uffTextRotation, uffFont, uffBold, uffBorder,
TsUsedFormattingField = (uffTextRotation, uffFont, {uffBold, }uffBorder,
uffBackground, uffNumberFormat, uffWordWrap, uffHorAlign, uffVertAlign
);
{ NOTE: "uffBackgroundColor" of older versions replaced by "uffBackground" }

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

@@ -33,36 +33,36 @@ type
// Set up expected values:
procedure SetUp; override;
procedure TearDown; override;
procedure TestWriteReadBold(AFormat: TsSpreadsheetFormat);
// procedure TestWriteReadBold(AFormat: TsSpreadsheetFormat);
procedure TestWriteReadFont(AFormat: TsSpreadsheetFormat; AFontName: String);
published
// BIFF2 test cases
procedure TestWriteRead_BIFF2_Bold;
// procedure TestWriteRead_BIFF2_Bold;
procedure TestWriteRead_BIFF2_Font_Arial;
procedure TestWriteRead_BIFF2_Font_TimesNewRoman;
procedure TestWriteRead_BIFF2_Font_CourierNew;
// BIFF5 test cases
procedure TestWriteRead_BIFF5_Bold;
// procedure TestWriteRead_BIFF5_Bold;
procedure TestWriteRead_BIFF5_Font_Arial;
procedure TestWriteRead_BIFF5_Font_TimesNewRoman;
procedure TestWriteRead_BIFF5_Font_CourierNew;
// BIFF8 test cases
procedure TestWriteRead_BIFF8_Bold;
// 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_Bold;
procedure TestWriteRead_ODS_Font_Arial;
procedure TestWriteRead_ODS_Font_TimesNewRoman;
procedure TestWriteRead_ODS_Font_CourierNew;
// OOXML test cases
procedure TestWriteRead_OOXML_Bold;
// procedure TestWriteRead_OOXML_Bold;
procedure TestWriteRead_OOXML_Font_Arial;
procedure TestWriteRead_OOXML_Font_TimesNewRoman;
procedure TestWriteRead_OOXML_Font_CourierNew;
@@ -129,7 +129,7 @@ procedure TSpreadWriteReadFontTests.TearDown;
begin
inherited TearDown;
end;
(*
procedure TSpreadWriteReadFontTests.TestWriteReadBold(AFormat: TsSpreadsheetFormat);
var
MyWorksheet: TsWorksheet;
@@ -208,7 +208,7 @@ begin
MyWorkbook.Free;
DeleteFile(TempFile);
end;
end;
end; *)
procedure TSpreadWriteReadFontTests.TestWriteReadFont(AFormat: TsSpreadsheetFormat;
AFontName: String);
@@ -224,11 +224,6 @@ var
expectedValue: String;
counter: Integer;
begin
{// Not needed: use workbook.writetofile with overwrite=true
if fileexists(TempFile) then
DeleteFile(TempFile);
}
MyWorkbook := TsWorkbook.Create;
try
MyWorkSheet:= MyWorkBook.AddWorksheet(FontSheet);
@@ -254,7 +249,7 @@ begin
'Test unsaved font style, cell ' + CellNotation(MyWorksheet,0,0));
end;
end;
TempFile:=NewTempFile;
TempFile := NewTempFile;
MyWorkBook.WriteToFile(TempFile, AFormat, true);
finally
MyWorkbook.Free;
@@ -296,12 +291,12 @@ begin
end;
{ BIFF2 }
{
procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF2_Bold;
begin
TestWriteReadBold(sfExcel2);
end;
}
procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF2_Font_Arial;
begin
TestWriteReadFont(sfExcel2, 'Arial');
@@ -318,11 +313,12 @@ begin
end;
{ BIFF5 }
{
procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF5_Bold;
begin
TestWriteReadBold(sfExcel5);
end;
}
procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF5_Font_Arial;
begin
TestWriteReadFont(sfExcel5, 'Arial');
@@ -339,11 +335,12 @@ begin
end;
{ BIFF8 }
{
procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF8_Bold;
begin
TestWriteReadBold(sfExcel8);
end;
}
procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF8_Font_Arial;
begin
TestWriteReadFont(sfExcel8, 'Arial');
@@ -360,11 +357,12 @@ begin
end;
{ ODS }
{
procedure TSpreadWriteReadFontTests.TestWriteRead_ODS_Bold;
begin
TestWriteReadBold(sfOpenDocument);
end;
}
procedure TSpreadWriteReadFontTests.TestWriteRead_ODS_Font_Arial;
begin
TestWriteReadFont(sfOpenDocument, 'Arial');
@@ -381,11 +379,12 @@ begin
end;
{ OOXML }
{
procedure TSpreadWriteReadFontTests.TestWriteRead_OOXML_Bold;
begin
TestWriteReadBold(sfOOXML);
end;
}
procedure TSpreadWriteReadFontTests.TestWriteRead_OOXML_Font_Arial;
begin
TestWriteReadFont(sfOOXML, 'Arial');

18
components/fpspreadsheet/tests/rpnformulaunit.pas
View File

@@ -51,7 +51,7 @@ begin
'=SUM(A1, B1)' becomes Format('=SUM(A1%s B1)', [ls]) }
Worksheet.WriteUTF8Text(0, 0, SBaseCells);
Worksheet.WriteUsedFormatting(0, 0, [uffBold]);
Worksheet.WriteFont(0, 0, BOLD_FONTINDEX);
Worksheet.WriteNumber(0,1, cellB1);
Worksheet.WriteNumber(0,2, cellC1);
@@ -62,15 +62,15 @@ begin
Row := 2;
Worksheet.WriteUTF8Text(Row, 1, 'read value');
Worksheet.WriteUsedFormatting(Row, 1, [uffBold]);
Worksheet.WriteFont(Row, 1, BOLD_FONTINDEX);
Worksheet.WriteUTF8Text(Row, 2, 'expected value');
Worksheet.WriteUsedFormatting(Row, 2, [uffBold]);
Worksheet.WriteFont(Row, 2, BOLD_FONTINDEX);
{ ---------- }
inc(Row);
Worksheet.WriteUTF8Text(Row, 0, 'Constants');
Worksheet.WriteUsedFormatting(Row, 0, [uffBold]);
Worksheet.WriteFont(Row, 0, BOLD_FONTINDEX);
// Numbers
inc(Row);
@@ -103,7 +103,7 @@ begin
inc(Row);
inc(Row);
Worksheet.WriteUTF8Text(Row, 0, 'Cell references - please check formula in editing line');
Worksheet.WriteUsedFormatting(Row, 0, [uffBold]);
Worksheet.WriteFont(Row, 0, BOLD_FONTINDEX);
// Absolute col and row references
inc(Row);
@@ -183,7 +183,7 @@ begin
inc(Row);
inc(Row);
Worksheet.WriteUTF8Text(Row, 0, 'Basic operations');
Worksheet.WriteUsedFormatting(Row, 0, [uffBold]);
Worksheet.WriteFont(Row, 0, BOLD_FONTINDEX);
// Add two cells
inc(Row);
@@ -481,7 +481,7 @@ begin
inc(Row);
inc(Row);
Worksheet.WriteUTF8Text(Row, 0, 'Logical functions');
Worksheet.WriteUsedFormatting(Row, 0, [uffBold]);
Worksheet.WriteFont(Row, 0, BOLD_FONTINDEX);
// TRUE()
inc(Row);
@@ -650,7 +650,7 @@ begin
inc(Row);
inc(Row);
Worksheet.WriteUTF8Text(Row, 0, 'Math functions');
Worksheet.WriteUsedFormatting(Row, 0, [uffBold]);
Worksheet.WriteFont(Row, 0, BOLD_FONTINDEX);
// absolute of positive number
inc(Row);
@@ -928,7 +928,7 @@ begin
inc(Row);
inc(Row);
Worksheet.WriteUTF8Text(Row, 0, 'Rounding');
Worksheet.WriteUsedFormatting(Row, 0, [uffBold]);
Worksheet.WriteFont(Row, 0, BOLD_FONTINDEX);
// Round positive number to 1 decimal =ROUND($F$1, 1)
inc(Row);

2
components/fpspreadsheet/tests/spreadtestgui.lpi
View File

@@ -82,6 +82,7 @@
<Unit9>
<Filename Value="fonttests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fonttests"/>
</Unit9>
<Unit10>
<Filename Value="optiontests.pas"/>
@@ -94,6 +95,7 @@
<Unit12>
<Filename Value="rpnformulaunit.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="rpnFormulaUnit"/>
</Unit12>
<Unit13>
<Filename Value="formulatests.pas"/>

4
components/fpspreadsheet/wikitable.pas
View File

@@ -487,9 +487,9 @@ begin
if fssItalic in lFont.Style then lCurStr := '<i>' + lCurStr + '</i>';
if fssUnderline in lFont.Style then lCurStr := '<u>' + lCurStr + '</u>';
if fssStrikeout in lFont.Style then lCurStr := '<s>' + lCurStr + '</s>';
end else
end;{ else
if uffBold in lCurUsedFormatting then
lCurStr := '<b>' + lCurStr + '</b>';
lCurStr := '<b>' + lCurStr + '</b>';}
// Background color
if uffBackground in lCurUsedFormatting then

67
components/fpspreadsheet/xlsbiff2.pas
View File

@@ -505,8 +505,8 @@ begin
AStream.ReadBuffer(lFontName[1], Len);
FFont.FontName := lFontName;
{ Add font to workbook's font list }
FWorkbook.AddFont(FFont);
{ Add font to internal font list }
FFontList.Add(FFont);
end;
procedure TsSpreadBIFF2Reader.ReadFontColor(AStream: TStream);
@@ -530,12 +530,6 @@ var
RecordType: Word;
CurStreamPos: Int64;
begin
// Clear existing fonts. They will be replaced by those from the file.
FWorkbook.RemoveAllFonts;
{ Store some data about the workbook that other routines need }
//WorkBookEncoding := AData.Encoding;
BIFF2EOF := False;
{ In BIFF2 files there is only one worksheet, let's create it }
@@ -972,6 +966,7 @@ var
b: Byte;
nfdata: TsNumFormatData;
i: Integer;
fnt: TsFont;
begin
// Read entire xf record into buffer
InitFormatRecord(fmt);
@@ -981,10 +976,18 @@ begin
AStream.ReadBuffer(rec.FontIndex, SizeOf(rec) - 2*SizeOf(word));
// Font index
fmt.FontIndex := rec.FontIndex;
if fmt.FontIndex = 1 then
i := rec.FontIndex;
if i > 4 then dec(i); // Watch out for the nasty missing font #4...
fnt := TsFont(FFontList[i]);
fmt.FontIndex := Workbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
if fmt.FontIndex = -1 then
fmt.FontIndex := Workbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
{
if fmt.FontIndex = BOLD_FONTINDEX then
Include(fmt.UsedFormattingFields, uffBold)
else if fmt.FontIndex > 1 then
else
}
if fmt.FontIndex > 1 then
Include(fmt.UsedFormattingFields, uffFont);
// Number format index
@@ -1433,11 +1436,16 @@ begin
rec.FontIndex := 0;
if (AFormatRecord <> nil) then
begin
{
if (uffBold in AFormatRecord^.UsedFormattingFields) then
rec.FontIndex := 1
rec.FontIndex := BOLD_FONTINDEX
else
}
if (uffFont in AFormatRecord^.UsedFormattingFields) then
begin
rec.FontIndex := AFormatRecord^.FontIndex;
if rec.FontIndex >= 4 then inc(rec.FontIndex); // Font #4 does not exist in BIFF
end;
end;
{ Not used byte }
@@ -1699,32 +1707,7 @@ begin
AStream.WriteByte(Lo(AIdentifier));
Result := 1;
end;
(*
{@@ ----------------------------------------------------------------------------
This method is intended to write a link to the cell containing the shared
formula used by the cell. But since BIFF2 does not support shared formulas
the writer must copy the shared formula and adapt the relative
references.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.WriteRPNSharedFormulaLink(AStream: TStream;
ACell: PCell; var RPNLength: Word);
var
formula: TsRPNFormula;
begin
// Create RPN formula from the shared formula base's string formula
formula := FWorksheet.BuildRPNFormula(ACell);
// Don't use ACell^.SharedFormulaBase here because this lookup is made
// by the worksheet automatically.
// Write adapted copy of shared formula to stream.
WriteRPNTokenArray(AStream, ACell, formula, false, RPNLength);
// false --> "do not convert cell addresses to relative offsets", because
// biff2 does not support shared formulas!
// Clean up
SetLength(formula, 0);
end;
*)
{@@ ----------------------------------------------------------------------------
Writes the size of the RPN token array. Called from WriteRPNFormula.
Overrides xlscommon.
@@ -1734,16 +1717,6 @@ procedure TsSpreadBIFF2Writer.WriteRPNTokenArraySize(AStream: TStream;
begin
AStream.WriteByte(ASize);
end;
(*
{@@ ----------------------------------------------------------------------------
Is intended to write the token array of a shared formula stored in ACell.
But since BIFF2 does not support shared formulas this method must not do
anything.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.WriteSharedFormula(AStream: TStream; ACell: PCell);
begin
Unused(AStream, ACell);
end; *)
{@@ ----------------------------------------------------------------------------
Writes an Excel 2 STRING record which immediately follows a FORMULA record

27
components/fpspreadsheet/xlsbiff5.pas
View File

@@ -343,9 +343,6 @@ var
RecordType: Word;
CurStreamPos: Int64;
begin
// Clear existing fonts. They will be replaced by those from the file.
FWorkbook.RemoveAllFonts;
while (not SectionEOF) do
begin
{ Read the record header }
@@ -604,6 +601,7 @@ var
dw: DWord;
fill: Word;
fs: TsFillStyle;
fnt: TsFont;
begin
InitFormatRecord(fmt);
fmt.ID := FCellFormatList.Count;
@@ -613,10 +611,13 @@ begin
AStream.ReadBuffer(rec.FontIndex, SizeOf(rec) - 2*SizeOf(Word));
// Font index
fmt.FontIndex := WordLEToN(rec.FontIndex);
if fmt.FontIndex = 1 then
Include(fmt.UsedFormattingFields, uffBold)
else if fmt.FontIndex > 1 then
i := WordLEToN(rec.FontIndex);
if i > 4 then dec(i); // Watch out for the nasty missing font #4...
fnt := TsFont(FFontList[i]);
fmt.FontIndex := Workbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
if fmt.FontIndex = -1 then
fmt.FontIndex := Workbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
if fmt.FontIndex > 1 then
Include(fmt.UsedFormattingFields, uffFont);
// Number format index
@@ -835,8 +836,10 @@ begin
AStream.ReadBuffer(fontname[1], Len);
font.FontName := ConvertEncoding(fontname, FCodePage, encodingUTF8);
{ Add font to workbook's font list }
FWorkbook.AddFont(font);
{ Add font to internal font list. Will be copied to workbook's font list later
as the font index in the internal list may be different from the index in
the workbook's list. }
FFontList.Add(font);
end;
// Read the FORMAT record for formatting numerical data
@@ -1455,11 +1458,11 @@ begin
{ Index to font record }
rec.FontIndex := 0;
if (AFormatRecord <> nil) then begin
if (uffBold in AFormatRecord^.UsedFormattingFields) then
rec.FontIndex := 1
else
if (uffFont in AFormatRecord^.UsedFormattingFields) then
begin
rec.FontIndex := AFormatRecord^.FontIndex;
if rec.FontIndex >= 4 then inc(rec.FontIndex); // FONT4 does not exist in BIFF
end;
end;
rec.FontIndex := WordToLE(rec.FontIndex);

31
components/fpspreadsheet/xlsbiff8.pas
View File

@@ -627,8 +627,6 @@ var
RecordType: Word;
CurStreamPos: Int64;
begin
// Clear existing fonts. They will be replaced by those from the file.
FWorkbook.RemoveAllFonts;
if Assigned(FSharedStringTable) then FreeAndNil(FSharedStringTable);
while (not SectionEOF) do begin
@@ -1185,6 +1183,7 @@ procedure TsSpreadBIFF8Reader.ReadXF(const AStream: TStream);
else Result := lsDashed;
end;
end;
var
rec: TBIFF8_XFRecord;
fmt: TsCellFormat;
@@ -1195,6 +1194,7 @@ var
nfidx: Integer;
nfdata: TsNumFormatData;
i: Integer;
fnt: TsFont;
begin
InitFormatRecord(fmt);
fmt.ID := FCellFormatList.Count;
@@ -1204,10 +1204,13 @@ begin
AStream.ReadBuffer(rec.FontIndex, SizeOf(rec) - 2*SizeOf(word));
// Font index
fmt.FontIndex := WordLEToN(rec.FontIndex);
if fmt.FontIndex = 1 then
Include(fmt.UsedFormattingFields, uffBold)
else if fmt.FontIndex > 1 then
i := WordLEToN(rec.FontIndex);
if i > 4 then dec(i); // Watch out for the nasty missing font #4...
fnt := TsFont(FFontList[i]);
fmt.FontIndex := Workbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
if fmt.FontIndex = -1 then
fmt.FontIndex := Workbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
if fmt.FontIndex > 1 then
Include(fmt.UsedFormattingFields, uffFont);
// Number format index
@@ -1335,7 +1338,7 @@ begin
end;
end;
// Add the XF to the list
// Add the XF to the internal cell format list
FCellFormatList.Add(fmt);
end;
@@ -1395,8 +1398,10 @@ begin
Len := AStream.ReadByte();
font.FontName := ReadString(AStream, Len);
{ Add font to workbook's font list }
FWorkbook.AddFont(font);
{ Add font to internal font list; will be transferred to workbook later because
the font index in the internal list (= index in file) is not the same as the
index the font will have in the workbook's fontlist! }
FFontList.Add(font);
end;
// Read the (number) FORMAT record for formatting numerical data
@@ -2828,7 +2833,7 @@ end;
Writes an Excel 8 XF record (cell format)
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteXF(AStream: TStream;
AFormatRecord: PsCellFormat; XFType_Prot: Byte = 0);
AFormatRecord: PsCellFormat; XFType_Prot: Byte = 0);
var
rec: TBIFF8_XFRecord;
j: Integer;
@@ -2843,11 +2848,11 @@ begin
{ Index to font record }
rec.FontIndex := 0;
if (AFormatRecord <> nil) then begin
if (uffBold in AFormatRecord^.UsedFormattingFields) then
rec.FontIndex := 1
else
if (uffFont in AFormatRecord^.UsedFormattingFields) then
begin
rec.FontIndex := AFormatRecord^.FontIndex;
if rec.FontIndex >= 4 then inc(rec.FontIndex); // Font #4 does not exist in BIFF
end;
end;
rec.FontIndex := WordToLE(rec.FontIndex);

2
components/fpspreadsheet/xlscommon.pas
View File

@@ -702,7 +702,7 @@ begin
if i > -1 then
begin
fmt := FCellFormatList.Items[i];
ACell^.FormatIndex := FWorkbook.AddCellFormat(fmt^);
ACell^.FormatIndex := FWorkbook.AddCellFormat(fmt^); // Adds a copy of fmt to workbook
end else
ACell^.FormatIndex := 0;
end;

71
components/fpspreadsheet/xlsxooxml.pas
View File

@@ -67,7 +67,6 @@ type
FBorderList: TFPList;
FHyperlinkList: TFPList;
FThemeColors: array of TsColorValue;
// FSharedFormulas: TStringList;
FWrittenByFPS: Boolean;
procedure ApplyCellFormatting(ACell: PCell; XfIndex: Integer);
procedure ApplyHyperlinks(AWorksheet: TsWorksheet);
@@ -463,7 +462,6 @@ begin
// Set up the default palette in order to have the default color names correct.
Workbook.UseDefaultPalette;
// FSharedFormulas := TStringList.Create;
FSharedStrings := TStringList.Create;
FFillList := TFPList.Create;
FBorderList := TFPList.Create;
@@ -489,8 +487,8 @@ begin
FHyperlinkList.Free;
FSharedStrings.Free;
// FSharedFormulas.Free;
// FCellFormatList is destroyed by ancestor
// FCellFormatList and FFontList are destroyed by ancestor
inherited Destroy;
end;
@@ -725,23 +723,6 @@ begin
for r := rng.Row1 to rng.Row2 do
for c := rng.Col1 to rng.Col2 do
FWorksheet.CopyFormula(cell, r, c);
(*
s := GetAttrValue(datanode, 'si');
if s <> '' then
FSharedFormulas.AddObject(addr, {%H-}Pointer(PtrInt(StrToInt(s))));
FWorksheet.WriteFormula(cell, formulaStr);
cell^.SharedFormulaBase := cell;
AWorksheet.WriteSharedFormula(s, formulaStr);
end else
begin
s := GetAttrValue(datanode, 'si');
if s <> '' then
begin
s := FSharedFormulas[FSharedFormulas.IndexOfObject({%H-}Pointer(PtrInt(StrToInt(s))))];
cell^.SharedFormulaBase := FWorksheet.FindCell(s);
end;
*)
end;
end
else
@@ -818,6 +799,7 @@ var
numFmtData: TsNumFormatData;
fillData: TFillListData;
borderData: TBorderListData;
fnt: TsFont;
begin
node := ANode.FirstChild;
while Assigned(node) do
@@ -851,10 +833,15 @@ begin
s2 := GetAttrValue(node, 'applyFont');
if (s1 <> '') and (s2 <> '0') then
begin
fmt.FontIndex := StrToInt(s1);
if fmt.FontIndex = 1 then
fnt := TsFont(FFontList.Items[StrToInt(s1)]);
fmt.FontIndex := Workbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
if fmt.FontIndex = -1 then
fmt.FontIndex := Workbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
{
if fmt.FontIndex = BOLD_FONTINDEX then
Include(fmt.UsedFormattingFields, uffBold)
else if fmt.FontIndex > 1 then
else }
if fmt.FontIndex > 0 then
Include(fmt.UsedFormattingFields, uffFont);
end;
@@ -1174,7 +1161,6 @@ var
fntColor: TsColor;
nodename: String;
s: String;
isNilFont: Boolean;
begin
fnt := Workbook.GetDefaultFont;
if fnt <> nil then begin
@@ -1190,7 +1176,6 @@ begin
end;
node := ANode.FirstChild;
isNilFont := node = nil;
while node <> nil do begin
nodename := node.NodeName;
if nodename = 'name' then begin
@@ -1228,32 +1213,24 @@ begin
node := node.NextSibling;
end;
{ We must not check for duplicate fonts here because then we cannot reconstruct
the correct font id later }
if not isNilFont then // the font #4 (nil) is added automatically --> skip it here
FWorkbook.AddFont(fntName, fntSize, fntStyles, fntColor);
fnt := TsFont.Create;
fnt.FontName := fntName;
fnt.Size := fntSize;
fnt.Style := fntStyles;
fnt.Color := fntColor;
FFontList.Add(fnt);
end;
procedure TsSpreadOOXMLReader.ReadFonts(ANode: TDOMNode);
var
node: TDOMNode;
begin
// Clear existing fonts. They will be replaced by those from the file.
FWorkbook.RemoveAllFonts;
node := ANode.FirstChild;
while node <> nil do begin
ReadFont(node);
node := node.NextSibling;
end;
{ A problem is caused by the font #4 which is missing in BIFF file versions.
FPSpreadsheet writes a nil value to this position in order to keep compatibility
with other file formats. Other applications, however, have a valid font at
this index. Therefore, we delete the font #4 if the file was not written
by FPSpreadsheet. }
if not FWrittenByFPS then
FWorkbook.DeleteFont(4);
end;
procedure TsSpreadOOXMLReader.ReadHyperlinks(ANode: TDOMNode);
@@ -2219,11 +2196,13 @@ begin
'<fonts count="%d">', [Workbook.GetFontCount]));
for i:=0 to Workbook.GetFontCount-1 do begin
font := Workbook.GetFont(i);
if font = nil then
{
if font = 4 then
// if font = nil then
AppendToStream(AStream, '<font />')
// Font #4 is missing in fpspreadsheet due to BIFF compatibility. We write
// an empty node to keep the numbers in sync with the stored font index.
else begin
else begin}
s := Format('<sz val="%g" /><name val="%s" />', [font.Size, font.FontName], FPointSeparatorSettings);
if (fssBold in font.Style) then
s := s + '<b />';
@@ -2243,7 +2222,7 @@ begin
end;
AppendToStream(AStream,
'<font>', s, '</font>');
end;
// end;
end;
AppendToStream(AStream,
'</fonts>');
@@ -2585,8 +2564,10 @@ begin
{ Font }
fontId := 0;
{
if (uffBold in fmt^.UsedFormattingFields) then
fontID := 1;
fontID := BOLD_FONTINDEX;
}
if (uffFont in fmt^.UsedFormattingFields) then
fontID := fmt^.FontIndex;
s := s + Format('fontId="%d" ', [fontId]);