pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: HTML reader supports <font> and <span> tags

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4259 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-08-09 10:11:04 +00:00
parent b16695f420
commit 6f1b452469
2 changed files with 22 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
components/fpspreadsheet/fpshtml.pas
View File

@ -458,8 +458,9 @@ var
f: Double;
defFntSize: Single;
begin
// style tags
idx := FAttrList.IndexOfName('font-family');
idx := FAttrList.IndexOfName('font-family'); // style tag
if idx = -1 then
idx := FAttrList.IndexOfName('face'); // html tag
if idx > -1 then begin
L := TStringList.Create;
try
@ -472,6 +473,8 @@ begin
end;
idx := FAttrList.IndexOfName('font-size');
if idx = -1 then
idx := FAttrList.IndexOfName('size');
if idx > -1 then begin
defFntSize := FWorkbook.GetDefaultFont.Size;
s := FAttrList[idx].Value;
@ -710,7 +713,7 @@ begin
ReadHorAlign;
ReadVertAlign;
ReadFont(FCellFont);
if NoCaseTag[3] = 'H' then begin
if NoCaseTag[3] = 'H' then begin // for <TH>
Include(FCellFont.Style, fssBold);
FCurrCellFormat.HorAlignment := haCenter;
Include(FCurrCellFormat.UsedFormattingFields, uffHorAlign);
@ -782,8 +785,19 @@ begin
FCurrFont.Position := fpNormal else
FCurrFont.Position := fpSuperscript;
AddRichTextParam(FCurrFont);
end
else
end else
if (pos('<FONT ', NoCaseTag) = 1) then
begin
FAttrList.Parse(ActualTag);
ReadFont(FCurrFont);
AddRichTextparam(FCurrFont);
end else
if (pos('<SPAN ', NoCaseTag) = 1) then
begin
FAttrList.Parse(ActualTag);
ReadFont(FCurrFont);
AddRichTextParam(FCurrFont);
end else
if ((NoCaseTag = '<BR>') or (pos('<BR ', NoCaseTag) = 1)) then
FCellText := FCellText + LineEnding;
(*

7
components/fpspreadsheet/fpshtmlutils.pas
View File

@ -521,19 +521,18 @@ begin
begin
case AStyle[i] of
':': begin // name-value separator
inc(i); // skip ':'
while (i <= len) and (AStyle[i] = ' ') do inc(i); // skip white space
inc(i); // skip ':' ...
while (i <= len) and (AStyle[i] = ' ') do inc(i); // ... and white space
value := '';
while (i <= len) and (AStyle[i] <> ';') do
begin
value := value + AStyle[i];
inc(i);
end;
// inc(i); // skip final ';'
Add(TsHTMLAttr.Create(lowercase(trim(nam)), UnquoteStr(trim(value))));
nam := '';
end;
' ': ;
' ': ; // skip white space
else nam := nam + AStyle[i];
end;
inc(i);