fpspreadsheet: Fix reading error in ods related to rich-text fonts

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4309 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-08-31 21:32:59 +00:00
parent 9720221878
commit 9bcaed5b25
8 changed files with 315 additions and 31 deletions

View File

@ -201,6 +201,9 @@ type
function Pop: Integer; function Pop: Integer;
end; end;
function FindFontInList(AFontList: TFPList; AFontName: String; ASize: Single;
AStyle: TsFontStyles; AColor: TsColor; APos: TsFontPosition): Integer;
implementation implementation
uses uses
@ -1324,5 +1327,30 @@ begin
end; end;
end; end;
{******************************************************************************}
{ Utilities }
{******************************************************************************}
function FindFontInList(AFontList: TFPList; AFontName: String; ASize: Single;
AStyle: TsFontStyles; AColor: TsColor; APos: TsFontPosition): Integer;
const
EPS = 1e-3;
var
fnt: TsFont;
begin
for Result := 0 to AFontList.Count-1 do
begin
fnt := TsFont(AFontList.Items[Result]);
if (fnt <> nil) and
SameText(AFontName, fnt.FontName) and
SameValue(ASize, fnt.Size, EPS) and // careful when comparing floating point numbers
(AStyle = fnt.Style) and
(AColor = fnt.Color) and
(APos = fnt.Position)
then
exit;
end;
Result := -1;
end;
end. end.

View File

@ -994,7 +994,7 @@ begin
begin begin
Result := Result + '<font'; Result := Result + '<font';
if cfFontName in FChangedParams[i] then if cfFontName in FChangedParams[i] then
Result := Result + ' face="' + FFonts[i].FontName + '"'; Result := Result + ' face="' + UnquoteStr(FFonts[i].FontName) + '"';
if cfFontSize in FChangedParams[i] then if cfFontSize in FChangedParams[i] then
Result := Result + ' size="' + Format('%.gpt', [FFonts[i].Size], FPointSeparatorSettings) + '"'; Result := Result + ' size="' + Format('%.gpt', [FFonts[i].Size], FPointSeparatorSettings) + '"';
if cfFontColor in FChangedParams[i] then if cfFontColor in FChangedParams[i] then

View File

@ -91,6 +91,8 @@ type
FHeaderFooterFontList: TObjectList; FHeaderFooterFontList: TObjectList;
FActiveSheet: String; FActiveSheet: String;
FDateMode: TDateMode; FDateMode: TDateMode;
FFontFaces: TStringList;
FRichTextFontList: TFPList;
procedure ApplyColWidths; procedure ApplyColWidths;
function ApplyStyleToCell(ACell: PCell; AStyleName: String): Boolean; function ApplyStyleToCell(ACell: PCell; AStyleName: String): Boolean;
function ExtractBoolFromNode(ANode: TDOMNode): Boolean; function ExtractBoolFromNode(ANode: TDOMNode): Boolean;
@ -104,7 +106,11 @@ type
procedure ReadColumns(ATableNode: TDOMNode); procedure ReadColumns(ATableNode: TDOMNode);
procedure ReadColumnStyle(AStyleNode: TDOMNode); procedure ReadColumnStyle(AStyleNode: TDOMNode);
procedure ReadDateMode(SpreadSheetNode: TDOMNode); procedure ReadDateMode(SpreadSheetNode: TDOMNode);
function ReadFont(ANode: TDOMnode; APreferredIndex: Integer = -1): Integer; procedure ReadFont(ANode: TDOMNode; var AFontName: String;
var AFontSize: Single; var AFontStyle: TsFontStyles; var AFontColor: TsColor;
var AFontPosition: TsFontPosition);
// function ReadFont(ANode: TDOMnode; APreferredIndex: Integer = -1): Integer;
procedure ReadFontFaces(ANode: TDOMNode);
procedure ReadHeaderFooterFont(ANode: TDOMNode; var AFontName: String; procedure ReadHeaderFooterFont(ANode: TDOMNode; var AFontName: String;
var AFontSize: Double; var AFontStyle: TsHeaderFooterFontStyles; var AFontSize: Double; var AFontStyle: TsHeaderFooterFontStyles;
var AFontColor: TsColor); var AFontColor: TsColor);
@ -887,6 +893,8 @@ begin
FPageLayoutList := TFPList.Create; FPageLayoutList := TFPList.Create;
FMasterPageList := TFPList.Create; FMasterPageList := TFPList.Create;
FHeaderFooterFontList := TObjectList.Create; // frees objects FHeaderFooterFontList := TObjectList.Create; // frees objects
FFontFaces := TStringList.Create;
FRichTextFontList := TFPList.Create;
// Initial base date in case it won't be read from file // Initial base date in case it won't be read from file
FDateMode := dm1899; FDateMode := dm1899;
@ -896,6 +904,11 @@ destructor TsSpreadOpenDocReader.Destroy;
var var
j: integer; j: integer;
begin begin
FFontFaces.Free;
for j := FRichTextFontList.Count-1 downto 0 do TObject(FRichTextFontList[j]).Free;
FreeAndNil(FRichTextFontList);
for j := FColumnList.Count-1 downto 0 do TObject(FColumnList[j]).Free; for j := FColumnList.Count-1 downto 0 do TObject(FColumnList[j]).Free;
FColumnList.Free; FColumnList.Free;
@ -1722,6 +1735,68 @@ begin
raise Exception.CreateFmt('Spreadsheet file corrupt: cannot handle null-date format %s', [NullDateSetting]); raise Exception.CreateFmt('Spreadsheet file corrupt: cannot handle null-date format %s', [NullDateSetting]);
end; end;
{ Reads font data from an xml node and returns the font elements. }
procedure TsSpreadOpenDocReader.ReadFont(ANode: TDOMNode; var AFontName: String;
var AFontSize: Single; var AFontStyle: TsFontStyles; var AFontColor: TsColor;
var AFontPosition: TsFontPosition);
var
stylename, s: String;
i, p: Integer;
begin
if ANode = nil then
exit;
stylename := GetAttrValue(ANode, 'style:font-name');
if stylename <> '' then
// Look for the true font name in the FFontFaces list. The items in
// FFontfaces are "style name"|"font name" pairs.
for i:=0 to FFontFaces.Count-1 do
begin
p := pos('|', FFontFaces[i]);
if p > 0 then begin
s := copy(FFontfaces[i], 1, p-1); // The first part is the style name
if s = styleName then
begin
AFontName := copy(FFontfaces[i], p+1, MaxInt);
// the second part is the font name
break;
end;
end;
end;
// In all other case, leave the AFontName of the input untouched.
s := GetAttrValue(ANode, 'fo:font-size');
if s <> '' then
AFontSize := HTMLLengthStrToPts(s);
if GetAttrValue(ANode, 'fo:font-style') = 'italic' then
Include(AFontStyle, fssItalic);
if GetAttrValue(ANode, 'fo:font-weight') = 'bold' then
Include(AFontStyle, fssBold);
s := GetAttrValue(ANode, 'style:text-underline-style');
if not ((s = '') or (s = 'none')) then
Include(AFontStyle, fssUnderline);
s := GetAttrValue(ANode, 'style:text-line-through-style');
if s = '' then s := GetAttrValue(ANode, 'style:text-line-through-type');
if not ((s = '') or (s = 'none')) then
Include(AFontStyle, fssStrikeout);
s := GetAttrValue(ANode, 'style:text-position');
if Length(s) >= 3 then
begin
if (s[3] = 'b') or (s[1] = '-') then
AFontPosition := fpSubscript
else
AFontPosition := fpSuperscript;
end;
s := GetAttrValue(ANode, 'fo:color');
if s <> '' then
AFontColor := HTMLColorStrToColor(s);
end;
(*
{ Reads font data from an xml node, adds the font to the workbooks FontList { Reads font data from an xml node, adds the font to the workbooks FontList
(if not yet contained), and returns the index in the font list. (if not yet contained), and returns the index in the font list.
If the font is a special font (such as DefaultFont, or HyperlinkFont) then If the font is a special font (such as DefaultFont, or HyperlinkFont) then
@ -1736,6 +1811,7 @@ var
fntColor: TsColor; fntColor: TsColor;
fntPosition: TsFontPosition; fntPosition: TsFontPosition;
s: String; s: String;
i: Integer;
p: Integer; p: Integer;
begin begin
if ANode = nil then if ANode = nil then
@ -1746,7 +1822,22 @@ begin
fntName := GetAttrValue(ANode, 'style:font-name'); fntName := GetAttrValue(ANode, 'style:font-name');
if fntName = '' then if fntName = '' then
fntName := FWorkbook.GetFont(0).FontName; fntName := FWorkbook.GetDefaultFont.FontName
else
// Look for the true font name in the FFontFaces list. The items in
// FFontfaces are "style name"|"font name" pairs.
for i:=0 to FFontFaces.Count-1 do
begin
p := pos('|', FFontFaces[i]);
if p > 0 then begin
s := copy(FFontfaces[i], 1, p-1);
if s = fntName then
begin
fntName := copy(FFontfaces[i], p+1, MaxInt);
break;
end;
end;
end;
s := GetAttrValue(ANode, 'fo:font-size'); s := GetAttrValue(ANode, 'fo:font-size');
if s <> '' then if s <> '' then
@ -1799,6 +1890,31 @@ begin
Result := FWorkbook.AddFont(fntName, fntSize, fntStyles, fntColor, fntPosition); Result := FWorkbook.AddFont(fntName, fntSize, fntStyles, fntColor, fntPosition);
end; end;
end; end;
*)
{ Collects the fontnames associated with a style-name in the list FFontfaces.
stylenames and fontnames are packed into a single string using | as a
separator. }
procedure TsSpreadOpenDocReader.ReadFontFaces(ANode: TDOMNode);
var
faceNode: TDOMNode;
nodename: String;
stylename: String;
fontfamily: String;
begin
faceNode := ANode.FirstChild;
while Assigned(faceNode) do
begin
nodename := faceNode.NodeName;
if nodename = 'style:font-face' then
begin
stylename := GetAttrValue(faceNode, 'style:name');
fontfamily := GetAttrValue(faceNode, 'svg:font-family');
if FFontFaces.IndexOf(stylename + '|' + fontfamily) = -1 then
FFontFaces.Add(stylename + '|' + fontfamily);
end;
faceNode := faceNode.NextSibling;
end;
end;
procedure TsSpreadOpenDocReader.ReadFormula(ARow, ACol: Cardinal; procedure TsSpreadOpenDocReader.ReadFormula(ARow, ACol: Cardinal;
ACellNode : TDOMNode); ACellNode : TDOMNode);
@ -1958,6 +2074,8 @@ begin
ReadXMLFile(Doc, FilePath+'styles.xml'); ReadXMLFile(Doc, FilePath+'styles.xml');
DeleteFile(FilePath+'styles.xml'); DeleteFile(FilePath+'styles.xml');
ReadFontFaces(Doc.DocumentElement.FindNode('office:font-face-decls'));
StylesNode := Doc.DocumentElement.FindNode('office:styles'); StylesNode := Doc.DocumentElement.FindNode('office:styles');
ReadNumFormats(StylesNode); ReadNumFormats(StylesNode);
ReadStyles(StylesNode); ReadStyles(StylesNode);
@ -1974,6 +2092,7 @@ begin
ReadXMLFile(Doc, FilePath+'content.xml'); ReadXMLFile(Doc, FilePath+'content.xml');
DeleteFile(FilePath+'content.xml'); DeleteFile(FilePath+'content.xml');
ReadFontFaces(Doc.DocumentElement.FindNode('office:font-face-decls'));
StylesNode := Doc.DocumentElement.FindNode('office:automatic-styles'); StylesNode := Doc.DocumentElement.FindNode('office:automatic-styles');
ReadNumFormats(StylesNode); ReadNumFormats(StylesNode);
ReadStyles(StylesNode); ReadStyles(StylesNode);
@ -2062,6 +2181,8 @@ begin
XMLStream.Free; XMLStream.Free;
end; end;
ReadFontFaces(Doc.DocumentElement.FindNode('office:font-face-decls'));
StylesNode := Doc.DocumentElement.FindNode('office:styles'); StylesNode := Doc.DocumentElement.FindNode('office:styles');
ReadNumFormats(StylesNode); ReadNumFormats(StylesNode);
ReadStyles(StylesNode); ReadStyles(StylesNode);
@ -2078,6 +2199,7 @@ begin
XMLStream.Free; XMLStream.Free;
end; end;
ReadFontFaces(Doc.DocumentElement.FindNode('office:font-face-decls'));
StylesNode := Doc.DocumentElement.FindNode('office:automatic-styles'); StylesNode := Doc.DocumentElement.FindNode('office:automatic-styles');
ReadNumFormats(StylesNode); ReadNumFormats(StylesNode);
ReadStyles(StylesNode); ReadStyles(StylesNode);
@ -2213,9 +2335,11 @@ var
nodeName: String; nodeName: String;
cell: PCell; cell: PCell;
hyperlink: string; hyperlink: string;
fmt: TsCellFormat;
rtParams: TsRichTextParams; rtParams: TsRichTextParams;
idx: Integer; idx: Integer;
rtFntIndex, fntIndex: Integer;
rtFnt, fnt: TsFont;
fmt: PsCellFormat;
procedure AddToCellText(AText: String); procedure AddToCellText(AText: String);
begin begin
@ -2225,10 +2349,23 @@ var
end; end;
begin begin
{ We were forced to activate PreserveWhiteSpace in the DOMParser in order to // Initalize cell
catch the spaces inserted in formatting texts. However, this adds lots of if FIsVirtualMode then
garbage into the cellText if is is read by means of above statement. Done begin
like below is much better: } InitCell(ARow, ACol, FVirtualCell);
cell := @FVirtualCell;
end else
cell := FWorksheet.AddCell(ARow, ACol);
// Apply style to cell
// We do this already here because we need the cell font for rich-text
styleName := GetAttrValue(ACellNode, 'table:style-name');
ApplyStyleToCell(cell, stylename);
fmt := FWorkbook.GetPointerToCellFormat(cell^.FormatIndex);
fntIndex := fmt^.FontIndex;
fnt := FWorkbook.GetFont(fntIndex);
// Prepare reading of node data
cellText := ''; cellText := '';
hyperlink := ''; hyperlink := '';
SetLength(rtParams, 0); SetLength(rtParams, 0);
@ -2246,7 +2383,16 @@ begin
nodename := subnode.NodeName; nodename := subnode.NodeName;
case nodename of case nodename of
'#text' : '#text' :
begin
if Length(rtParams) > 0 then
begin
SetLength(rtParams, Length(rtParams) + 1);
rtParams[High(rtParams)].FirstIndex := UTF8Length(cellText) + 1;
rtParams[High(rtParams)].FontIndex := fntIndex;
rtParams[High(rtParams)].HyperlinkIndex := -1; // TO DO !!!!
end;
AddToCellText(subnode.TextContent); AddToCellText(subnode.TextContent);
end;
'text:a': // "hyperlink anchor" 'text:a': // "hyperlink anchor"
begin begin
hyperlink := GetAttrValue(subnode, 'xlink:href'); hyperlink := GetAttrValue(subnode, 'xlink:href');
@ -2260,9 +2406,23 @@ begin
idx := FCellFormatList.FindIndexOfName(stylename); idx := FCellFormatList.FindIndexOfName(stylename);
if idx > -1 then if idx > -1 then
begin begin
rtFntIndex := FCellFormatList[idx]^.FontIndex;
rtFnt := TsFont(FRichTextFontList[rtFntIndex]);
// Replace missing font elements by those from the cell font
if rtFnt.FontName = '' then rtFnt.FontName := fnt.FontName;
if rtFnt.Size = -1 then rtFnt.Size := fnt.Size;
if rtFnt.Style = [] then rtFnt.Style := fnt.Style;
if rtFnt.Color = scNone then rtFnt.Color := fnt.Color;
if rtFnt.Position = fpNormal then rtFnt.Position := fnt.Position;
// Find this font in the workbook's font list
rtfntIndex := FWorkbook.FindFont(rtFnt.FontName, rtFnt.Size, rtFnt.Style, rtFnt.Color, rtFnt.Position);
// If not found add to font list
if rtfntIndex = -1 then
rtfntIndex := FWorkbook.AddFont(rtFnt.FontName, rtFnt.Size, rtFnt.Style, rtFnt.Color, rtFnt.Position);
// Use this font index in the rich-text parameter
SetLength(rtParams, Length(rtParams)+1); SetLength(rtParams, Length(rtParams)+1);
rtParams[High(rtParams)].FirstIndex := UTF8Length(cellText) + 1; // 1-based character index rtParams[High(rtParams)].FirstIndex := UTF8Length(cellText) + 1; // 1-based character index
rtParams[High(rtParams)].FontIndex := FCellFormatList[idx]^.FontIndex; rtParams[High(rtParams)].FontIndex := rtFntIndex;
rtParams[High(rtParams)].HyperlinkIndex := -1; // TO DO !!!! rtParams[High(rtParams)].HyperlinkIndex := -1; // TO DO !!!!
end; end;
end; end;
@ -2275,13 +2435,6 @@ begin
childnode := childnode.NextSibling; childnode := childnode.NextSibling;
end; end;
if FIsVirtualMode then
begin
InitCell(ARow, ACol, FVirtualCell);
cell := @FVirtualCell;
end else
cell := FWorksheet.AddCell(ARow, ACol);
FWorkSheet.WriteUTF8Text(cell, cellText, rtParams); FWorkSheet.WriteUTF8Text(cell, cellText, rtParams);
if hyperlink <> '' then if hyperlink <> '' then
begin begin
@ -2294,9 +2447,6 @@ begin
FWorksheet.WriteFont(cell, HYPERLINK_FONTINDEX); FWorksheet.WriteFont(cell, HYPERLINK_FONTINDEX);
end; end;
styleName := GetAttrValue(ACellNode, 'table:style-name');
ApplyStyleToCell(cell, stylename);
if FIsVirtualMode then if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell); Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end; end;
@ -3164,6 +3314,13 @@ var
numFmtIndex: Integer; numFmtIndex: Integer;
numFmtParams: TsNumFormatParams; numFmtParams: TsNumFormatParams;
clr: TsColor; clr: TsColor;
fnt: TsFont;
fntName: String;
fntSize: Single;
fntStyle: TsFontStyles;
fntColor: TsColor;
fntPos: TsFontPosition;
fntIndex: Integer;
s: String; s: String;
idx: Integer; idx: Integer;
@ -3263,7 +3420,37 @@ begin
nodeName := styleNode.NodeName; nodeName := styleNode.NodeName;
if nodeName = 'style:default-style' then if nodeName = 'style:default-style' then
begin begin
ReadFont(styleNode.FindNode('style:text-properties'), DEFAULT_FONTINDEX); family := GetAttrValue(stylenode, 'style:family');
if family = 'table-cell' then begin
InitFormatRecord(fmt);
fmt.Name := 'Default';
fnt := FWorkbook.GetFont(fmt.FontIndex);
fntName := fnt.FontName;
fntSize := fnt.Size;
fntStyle := fnt.Style;
fntColor := fnt.Color;
fntPos := fnt.Position;
styleChildNode := stylenode.FirstChild;
while Assigned(styleChildNode) do begin
nodename := styleChildNode.NodeName;
if nodename = 'style:text-properties' then
ReadFont(
styleNode.FindNode('style:text-properties'),
fntName, fntSize, fntStyle, fntColor, fntPos
)
// fmt.FontIndex := ReadFont(styleNode.FindNode('style:text-properties'), DEFAULT_FONTINDEX)
else
if nodename = 'style:paragraph-properties' then;
// not used;
styleChildNode := styleChildNode.nextSibling;
end;
fmt.FontIndex := FWorkbook.FindFont(fntName, fntSize, fntStyle, fntColor, fntPos);
if fmt.FontIndex = -1 then
fmt.FontIndex := FWorkbook.AddFont(fntname, fntsize, fntstyle, fntColor, fntPos);
if fmt.FontIndex > 0 then
Include(fmt.UsedFormattingFields, uffFont);
FCellFormatList.Add(fmt);
end;
end else end else
if nodeName = 'style:style' then if nodeName = 'style:style' then
begin begin
@ -3293,6 +3480,13 @@ begin
end; end;
fmt.Name := styleName; fmt.Name := styleName;
fnt := FWorkbook.GetFont(fmt.FontIndex);
fntName := fnt.FontName;
fntSize := fnt.Size;
fntStyle := fnt.Style;
fntColor := fnt.Color;
fntPos := fnt.Position;
numFmtIndex := -1; numFmtIndex := -1;
numFmtName := GetAttrValue(styleNode, 'style:data-style-name'); numFmtName := GetAttrValue(styleNode, 'style:data-style-name');
if numFmtName <> '' then numFmtIndex := FindNumFormatByName(numFmtName); if numFmtName <> '' then numFmtIndex := FindNumFormatByName(numFmtName);
@ -3313,15 +3507,28 @@ begin
nodeName := styleChildNode.NodeName; nodeName := styleChildNode.NodeName;
if nodeName = 'style:text-properties' then if nodeName = 'style:text-properties' then
begin begin
ReadFont(styleChildNode, fntName, fntSize, fntStyle, fntColor, fntPos);
if SameText(stylename, 'Default') then if SameText(stylename, 'Default') then
fmt.FontIndex := ReadFont(styleChildNode, DEFAULT_FONTINDEX) begin
else FWorkbook.ReplaceFont(DEFAULT_FONTINDEX, fntName, fntSize, fntStyle, fntColor, fntPos);
fmt.FontIndex := DEFAULT_FONTINDEX;
//fntIndex := ReadFont(styleChildNode, DEFAULT_FONTINDEX)
end else
if SameText(stylename, 'Excel_20_Built-in_20_Hyperlink') then if SameText(stylename, 'Excel_20_Built-in_20_Hyperlink') then
fmt.FontIndex := ReadFont(styleChildNode, HYPERLINK_FONTINDEX) begin
else FWorkbook.ReplaceFont(HYPERLINK_FONTINDEX, fntName, fntSize, fntStyle, fntColor, fntPos);
fmt.FontIndex := ReadFont(styleChildNode); fmt.FontIndex := HYPERLINK_FONTINDEX;
//fntIndex := ReadFont(styleChildNode, HYPERLINK_FONTINDEX)
end else
begin
fmt.FontIndex := FWorkbook.FindFont(fntName, fntSize, fntStyle, fntColor, fntPos);
if fmt.FontIndex = -1 then
fmt.FontIndex := FWorkbook.AddFont(fntName, fntSize, fntStyle, fntColor, fntPos);
end;
if fmt.FontIndex > 0 then if fmt.FontIndex > 0 then
Include(fmt.UsedFormattingFields, uffFont); Include(fmt.UsedFormattingFields, uffFont);
// fntIndex := ReadFont(styleChildNode);
// fnt := FWorkbook.GetFont(fntIndex);
end else end else
if nodeName = 'style:table-cell-properties' then if nodeName = 'style:table-cell-properties' then
begin begin
@ -3442,6 +3649,7 @@ begin
if family = 'text' then if family = 'text' then
begin begin
// "Rich-text formatting run" style // "Rich-text formatting run" style
// Nodes are named "T1", "T2", etc.
styleName := GetAttrValue(styleNode, 'style:name'); styleName := GetAttrValue(styleNode, 'style:name');
styleChildNode := styleNode.FirstChild; styleChildNode := styleNode.FirstChild;
while Assigned(styleChildNode) do while Assigned(styleChildNode) do
@ -3449,12 +3657,38 @@ begin
nodeName := styleChildNode.NodeName; nodeName := styleChildNode.NodeName;
if nodeName = 'style:text-properties' then if nodeName = 'style:text-properties' then
begin begin
// Setup default values which identify font elements to be replaced
// by the cell font value
fntName := '';
fntSize := -1;
fntStyle := [];
fntColor := scNone;
fntPos := fpNormal;
ReadFont(styleChildNode, fntName, fntSize, fntStyle, fntColor, fntPos);
// Does this font already exist in the FRichTextFontList?
fntIndex := FindFontInList(FRichTextFontList, fntName, fntSize, fntStyle, fntColor, fntPos);
// No - add the font to the list.
if fntIndex = -1 then
begin
fnt := TsFont.Create(fntName, fntSize, fntStyle, fntColor, fntPos);
fntIndex := FRichTextFontList.Add(fnt);
end;
// Store this is in a dummy format in the cell format list
InitFormatRecord(fmt); InitFormatRecord(fmt);
fmt.Name := styleName; fmt.Name := styleName;
fmt.FontIndex := ReadFont(styleChildNode); fmt.FontIndex := fntIndex;
Include(fmt.UsedFormattingFields, uffFont);
FCellFormatList.Add(fmt);
{
fmt.FontIndex := FWorkbook.FindFont(fntName, fntSize, fntStyle, fntColor, fntPos);
if fmt.FontIndex = -1 then
fmt.FontIndex := FWorkbook.AddFont(fntName, fntSize, fntStyle, fntColor, fntPos);
// fmt.FontIndex := ReadFont(styleChildNode);
if fmt.FontIndex > 0 then if fmt.FontIndex > 0 then
Include(fmt.UsedFormattingFields, uffFont); Include(fmt.UsedFormattingFields, uffFont);
FCellFormatList.Add(fmt); FCellFormatList.Add(fmt);
}
end; end;
styleChildNode := stylechildNode.NextSibling; styleChildNode := stylechildNode.NextSibling;
end; end;

View File

@ -7627,6 +7627,10 @@ end;
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsWorkbook.FindFont(const AFontName: String; ASize: Single; function TsWorkbook.FindFont(const AFontName: String; ASize: Single;
AStyle: TsFontStyles; AColor: TsColor; APosition: TsFontPosition = fpNormal): Integer; AStyle: TsFontStyles; AColor: TsColor; APosition: TsFontPosition = fpNormal): Integer;
begin
Result := FindFontInList(FFontList, AFontName, ASize, AStyle, AColor, APosition);
end;
{
const const
EPS = 1e-3; EPS = 1e-3;
var var
@ -7646,6 +7650,7 @@ begin
end; end;
Result := -1; Result := -1;
end; end;
}
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Initializes the font list by adding 5 fonts: Initializes the font list by adding 5 fonts:

View File

@ -211,7 +211,7 @@ var
j: Integer; j: Integer;
begin begin
for j:=FFontList.Count-1 downto 0 do for j:=FFontList.Count-1 downto 0 do
if FFontList[j] <> nil then TObject(FFontList[j]).Free; if FFontList[j] <> nil then TObject(FFontList[j]).Free; // font #4 can add a nil!
FreeAndNil(FFontList); FreeAndNil(FFontList);
FreeAndNil(FNumFormatList); FreeAndNil(FNumFormatList);

View File

@ -429,6 +429,8 @@ type
Color: TsColor; Color: TsColor;
{@@ Text position } {@@ Text position }
Position: TsFontPosition; Position: TsFontPosition;
constructor Create(AFontName: String; ASize: Single; AStyle: TsFontStyles;
AColor: TsColor; APosition: TsFontPosition); overload;
procedure CopyOf(AFont: TsFont); procedure CopyOf(AFont: TsFont);
end; end;
@ -712,6 +714,16 @@ const
implementation implementation
constructor TsFont.Create(AFontName: String; ASize: Single; AStyle: TsFontStyles;
AColor: TsColor; APosition: TsFontPosition);
begin
FontName := AFontName;
Size := ASize;
Style := AStyle;
Color := AColor;
Position := APosition;
end;
procedure TsFont.CopyOf(AFont: TsFont); procedure TsFont.CopyOf(AFont: TsFont);
begin begin
FontName := AFont.FontName; FontName := AFont.FontName;

View File

@ -9,6 +9,7 @@
<Version Value="11"/> <Version Value="11"/>
<PathDelim Value="\"/> <PathDelim Value="\"/>
<SearchPaths> <SearchPaths>
<OtherUnitFiles Value="."/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths> </SearchPaths>
<Parsing> <Parsing>
@ -29,7 +30,7 @@
This package is all you need if you don't want graphical components (like grids and charts)."/> This package is all you need if you don't want graphical components (like grids and charts)."/>
<License Value="LGPL with static linking exception. This is the same license as is used in the LCL (Lazarus Component Library)."/> <License Value="LGPL with static linking exception. This is the same license as is used in the LCL (Lazarus Component Library)."/>
<Version Major="1" Minor="7"/> <Version Major="1" Minor="7"/>
<Files Count="37"> <Files Count="38">
<Item1> <Item1>
<Filename Value="fpolestorage.pas"/> <Filename Value="fpolestorage.pas"/>
<UnitName Value="fpolestorage"/> <UnitName Value="fpolestorage"/>
@ -176,8 +177,12 @@ This package is all you need if you don't want graphical components (like grids
</Item36> </Item36>
<Item37> <Item37>
<Filename Value="fpshtmlutils.pas"/> <Filename Value="fpshtmlutils.pas"/>
<UnitName Value="fpshtmlutils"/> <UnitName Value="fpsHTMLUtils"/>
</Item37> </Item37>
<Item38>
<Filename Value="fpscell.pas"/>
<UnitName Value="fpsCell"/>
</Item38>
</Files> </Files>
<RequiredPkgs Count="2"> <RequiredPkgs Count="2">
<Item1> <Item1>

View File

@ -14,7 +14,7 @@ uses
fpolebasic, wikitable, fpsNumFormatParser, fpsfunc, fpsRPN, fpsStrings, fpolebasic, wikitable, fpsNumFormatParser, fpsfunc, fpsRPN, fpsStrings,
fpscsv, fpsCsvDocument, fpspatches, fpsTypes, xlsEscher, fpsReaderWriter, fpscsv, fpsCsvDocument, fpspatches, fpsTypes, xlsEscher, fpsReaderWriter,
fpsNumFormat, fpsclasses, fpsHeaderFooterParser, fpsPalette, fpsHTML, fpsNumFormat, fpsclasses, fpsHeaderFooterParser, fpsPalette, fpsHTML,
fpshtmlutils; fpsHTMLUtils, fpsCell;
implementation implementation