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