fpspreadsheet: Fix crash of unit test application in case of missing length unit in HTMLLengthStrToPts. Rearrange code for ods font reading.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3147 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
parent
036383d658
commit
d7ee2a84d8
@ -88,6 +88,7 @@ type
|
|||||||
procedure ReadColumnStyle(AStyleNode: TDOMNode);
|
procedure ReadColumnStyle(AStyleNode: TDOMNode);
|
||||||
// Figures out the base year for times in this file (dates are unambiguous)
|
// Figures out the base year for times in this file (dates are unambiguous)
|
||||||
procedure ReadDateMode(SpreadSheetNode: TDOMNode);
|
procedure ReadDateMode(SpreadSheetNode: TDOMNode);
|
||||||
|
function ReadFont(ANode: TDOMnode; IsDefaultFont: Boolean): Integer;
|
||||||
procedure ReadRowsAndCells(ATableNode: TDOMNode);
|
procedure ReadRowsAndCells(ATableNode: TDOMNode);
|
||||||
procedure ReadRowStyle(AStyleNode: TDOMNode);
|
procedure ReadRowStyle(AStyleNode: TDOMNode);
|
||||||
protected
|
protected
|
||||||
@ -720,6 +721,60 @@ 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, adds the font to the workbooks FontList
|
||||||
|
(if not yet contained), and returns the index in the font list.
|
||||||
|
If "IsDefaultFont" is true the first FontList entry (DefaultFont) is replaced. }
|
||||||
|
function TsSpreadOpenDocReader.ReadFont(ANode: TDOMnode;
|
||||||
|
IsDefaultFont: Boolean): Integer;
|
||||||
|
var
|
||||||
|
fntName: String;
|
||||||
|
fntSize: Single;
|
||||||
|
fntStyles: TsFontStyles;
|
||||||
|
fntColor: TsColor;
|
||||||
|
s: String;
|
||||||
|
begin
|
||||||
|
if ANode = nil then begin
|
||||||
|
Result := 0;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
fntName := GetAttrValue(ANode, 'style:font-name');
|
||||||
|
if fntName = '' then
|
||||||
|
fntName := FWorkbook.GetFont(0).FontName;
|
||||||
|
|
||||||
|
s := GetAttrValue(ANode, 'fo:font-size');
|
||||||
|
if s <> '' then
|
||||||
|
fntSize := HTMLLengthStrToPts(s)
|
||||||
|
else
|
||||||
|
fntSize := FWorkbook.GetDefaultFontSize;
|
||||||
|
|
||||||
|
fntStyles := [];
|
||||||
|
if GetAttrValue(ANode, 'fo:font-style') = 'italic' then
|
||||||
|
Include(fntStyles, fssItalic);
|
||||||
|
if GetAttrValue(ANode, 'fo:font-weight') = 'bold' then
|
||||||
|
Include(fntStyles, fssBold);
|
||||||
|
if GetAttrValue(ANode, 'style:text-underline-style') <> '' then
|
||||||
|
Include(fntStyles, fssUnderline);
|
||||||
|
if GetAttrValue(ANode, 'style:text-strike-through-style') <> '' then
|
||||||
|
Include(fntStyles, fssStrikeout);
|
||||||
|
|
||||||
|
s := GetAttrValue(ANode, 'fo:color');
|
||||||
|
if s <> '' then
|
||||||
|
fntColor := FWorkbook.AddColorToPalette(HTMLColorStrToColor(s))
|
||||||
|
else
|
||||||
|
fntColor := FWorkbook.GetFont(0).Color;
|
||||||
|
|
||||||
|
if IsDefaultFont then begin
|
||||||
|
FWorkbook.SetDefaultFont(fntName, fntSize);
|
||||||
|
Result := 0;
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
Result := FWorkbook.FindFont(fntName, fntSize, fntStyles, fntColor);
|
||||||
|
if Result = -1 then
|
||||||
|
Result := FWorkbook.AddFont(fntName, fntSize, fntStyles, fntColor);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TsSpreadOpenDocReader.ReadFromFile(AFileName: string; AData: TsWorkbook);
|
procedure TsSpreadOpenDocReader.ReadFromFile(AFileName: string; AData: TsWorkbook);
|
||||||
var
|
var
|
||||||
Doc : TXMLDocument;
|
Doc : TXMLDocument;
|
||||||
@ -1431,56 +1486,6 @@ var
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function ReadFont(ANode: TDOMnode; IsDefaultFont: Boolean): Integer;
|
|
||||||
var
|
|
||||||
fntName: String;
|
|
||||||
fntSize: Single;
|
|
||||||
fntStyles: TsFontStyles;
|
|
||||||
fntColor: TsColor;
|
|
||||||
s: String;
|
|
||||||
begin
|
|
||||||
if ANode = nil then begin
|
|
||||||
Result := 0;
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
|
|
||||||
fntName := GetAttrValue(ANode, 'style:font-name');
|
|
||||||
if fntName = '' then
|
|
||||||
fntName := FWorkbook.GetFont(0).FontName;
|
|
||||||
|
|
||||||
s := GetAttrValue(ANode, 'fo:font-size');
|
|
||||||
if s <> '' then
|
|
||||||
fntSize := HTMLLengthStrToPts(s)
|
|
||||||
else
|
|
||||||
fntSize := FWorkbook.GetDefaultFontSize;
|
|
||||||
|
|
||||||
fntStyles := [];
|
|
||||||
if GetAttrValue(ANode, 'fo:font-style') = 'italic' then
|
|
||||||
Include(fntStyles, fssItalic);
|
|
||||||
if GetAttrValue(ANode, 'fo:font-weight') = 'bold' then
|
|
||||||
Include(fntStyles, fssBold);
|
|
||||||
if GetAttrValue(ANode, 'style:text-underline-style') <> '' then
|
|
||||||
Include(fntStyles, fssUnderline);
|
|
||||||
if GetAttrValue(ANode, 'style:text-strike-through-style') <> '' then
|
|
||||||
Include(fntStyles, fssStrikeout);
|
|
||||||
|
|
||||||
s := GetAttrValue(ANode, 'fo:color');
|
|
||||||
if s <> '' then
|
|
||||||
fntColor := FWorkbook.AddColorToPalette(HTMLColorStrToColor(s))
|
|
||||||
else
|
|
||||||
fntColor := FWorkbook.GetFont(0).Color;
|
|
||||||
|
|
||||||
if IsDefaultFont then begin
|
|
||||||
FWorkbook.SetDefaultFont(fntName, fntSize);
|
|
||||||
Result := 0;
|
|
||||||
end
|
|
||||||
else begin
|
|
||||||
Result := FWorkbook.FindFont(fntName, fntSize, fntStyles, fntColor);
|
|
||||||
if Result = -1 then
|
|
||||||
Result := FWorkbook.AddFont(fntName, fntSize, fntStyles, fntColor);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if not Assigned(AStylesNode) then
|
if not Assigned(AStylesNode) then
|
||||||
exit;
|
exit;
|
||||||
|
@ -1454,10 +1454,18 @@ var
|
|||||||
x: Double;
|
x: Double;
|
||||||
res: Word;
|
res: Word;
|
||||||
begin
|
begin
|
||||||
|
if (Length(AValue) > 1) and (AValue[Length(AValue)] in ['a'..'z', 'A'..'Z']) then begin
|
||||||
units := lowercase(Copy(AValue, Length(AValue)-1, 2));
|
units := lowercase(Copy(AValue, Length(AValue)-1, 2));
|
||||||
val(copy(AValue, 1, Length(AValue)-2), x, res);
|
val(copy(AValue, 1, Length(AValue)-2), x, res);
|
||||||
// No hasseling with the decimal point...
|
// No hasseling with the decimal point...
|
||||||
if units = 'pt' then
|
end else begin
|
||||||
|
units := '';
|
||||||
|
val(AValue, x, res);
|
||||||
|
end;
|
||||||
|
if res <> 0 then
|
||||||
|
raise Exception.CreateFmt('No valid number or units (%s)', [AValue]);
|
||||||
|
|
||||||
|
if (units = 'pt') or (units = '') then
|
||||||
Result := x
|
Result := x
|
||||||
else
|
else
|
||||||
if units = 'in' then
|
if units = 'in' then
|
||||||
|
Loading…
Reference in New Issue
Block a user