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:
wp_xxyyzz
2014-06-06 09:17:52 +00:00
parent 036383d658
commit d7ee2a84d8
2 changed files with 67 additions and 54 deletions

View File

@ -88,6 +88,7 @@ type
procedure ReadColumnStyle(AStyleNode: TDOMNode);
// Figures out the base year for times in this file (dates are unambiguous)
procedure ReadDateMode(SpreadSheetNode: TDOMNode);
function ReadFont(ANode: TDOMnode; IsDefaultFont: Boolean): Integer;
procedure ReadRowsAndCells(ATableNode: TDOMNode);
procedure ReadRowStyle(AStyleNode: TDOMNode);
protected
@ -720,6 +721,60 @@ begin
raise Exception.CreateFmt('Spreadsheet file corrupt: cannot handle null-date format %s', [NullDateSetting]);
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);
var
Doc : TXMLDocument;
@ -1431,56 +1486,6 @@ var
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
if not Assigned(AStylesNode) then
exit;

View File

@ -1454,10 +1454,18 @@ var
x: Double;
res: Word;
begin
units := lowercase(Copy(AValue, Length(AValue)-1, 2));
val(copy(AValue, 1, Length(AValue)-2), x, res);
// No hasseling with the decimal point...
if units = 'pt' then
if (Length(AValue) > 1) and (AValue[Length(AValue)] in ['a'..'z', 'A'..'Z']) then begin
units := lowercase(Copy(AValue, Length(AValue)-1, 2));
val(copy(AValue, 1, Length(AValue)-2), x, res);
// No hasseling with the decimal point...
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
else
if units = 'in' then