You've already forked lazarus-ccr
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:
@ -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.
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
@ -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;
|
||||||
|
@ -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:
|
||||||
|
@ -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);
|
||||||
|
@ -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;
|
||||||
|
@ -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>
|
||||||
|
@ -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
|
||||||
|
|
||||||
|
Reference in New Issue
Block a user