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

FPSpreadsheet: Fix detection issues with incorrect html tags

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7952 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-12-30 22:19:47 +00:00
parent b66f416f71
commit 438e967c42
1 changed files with 11 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
components/fpspreadsheet/source/common/fpshtmlutils.pas
View File

@ -624,6 +624,7 @@ type
FPointSeparatorSettings: TFormatSettings; FPointSeparatorSettings: TFormatSettings;
FPreserveSpaces: Boolean; FPreserveSpaces: Boolean;
FPrefix: String; FPrefix: String;
FHandled: Boolean;
function AddFont(AFont: TsFont): Integer; function AddFont(AFont: TsFont): Integer;
procedure AddRichTextParam(AFont: TsFont; AHyperlinkIndex: Integer = -1); procedure AddRichTextParam(AFont: TsFont; AHyperlinkIndex: Integer = -1);
procedure ProcessFontRestore; procedure ProcessFontRestore;
@ -714,6 +715,7 @@ begin
FRichTextParams[n].FontIndex := fntIndex; FRichTextParams[n].FontIndex := fntIndex;
FRichTextParams[n].HyperlinkIndex := AHyperlinkIndex; FRichTextParams[n].HyperlinkIndex := AHyperlinkIndex;
end; end;
FHandled := true;
end; end;
procedure TsHTMLAnalyzer.ProcessFontRestore; procedure TsHTMLAnalyzer.ProcessFontRestore;
@ -831,6 +833,7 @@ end;
procedure TsHTMLAnalyzer.TagFoundHandler(NoCaseTag, ActualTag: String); procedure TsHTMLAnalyzer.TagFoundHandler(NoCaseTag, ActualTag: String);
begin begin
FHandled := false;
case NoCaseTag[2] of case NoCaseTag[2] of
'B': case NoCaseTag of 'B': case NoCaseTag of
'<B>' : begin '<B>' : begin
@ -860,7 +863,7 @@ begin
FFontStack.Push(AddFont(FCurrFont)); FFontStack.Push(AddFont(FCurrFont));
FAttrList.Parse(ActualTag); FAttrList.Parse(ActualTag);
ReadFont(FCurrFont); ReadFont(FCurrFont);
AddRichTextparam(FCurrFont); AddRichTextParam(FCurrFont);
end; end;
'I': case NoCaseTag of 'I': case NoCaseTag of
'<I>' : begin '<I>' : begin
@ -912,9 +915,9 @@ begin
(NoCaseTag = '</SUB>') or (NoCaseTag = '</SUP>') then ProcessFontRestore; (NoCaseTag = '</SUB>') or (NoCaseTag = '</SUP>') then ProcessFontRestore;
'U': if (NoCaseTag = '</U>') then ProcessFontRestore; 'U': if (NoCaseTag = '</U>') then ProcessFontRestore;
end; end;
else
FPlainText := FPlainText + ActualTag;
end; end;
if not FHandled then
FPlainText := FPlainText + ActualTag;
end; end;
procedure TsHTMLAnalyzer.TextFoundHandler(AText: String); procedure TsHTMLAnalyzer.TextFoundHandler(AText: String);
@ -947,6 +950,8 @@ end;
procedure HTMLToRichText(AWorkbook: TsBasicWorkbook; AFont: TsFont; procedure HTMLToRichText(AWorkbook: TsBasicWorkbook; AFont: TsFont;
const AHTMLText: String; out APlainText: String; const AHTMLText: String; out APlainText: String;
out ARichTextParams: TsRichTextParams; APrefix: String = ''); out ARichTextParams: TsRichTextParams; APrefix: String = '');
const
TERMINATION = '<end>';
var var
analyzer: TsHTMLAnalyzer; analyzer: TsHTMLAnalyzer;
j: Integer; j: Integer;
@ -954,12 +959,14 @@ var
nrtp: Integer; nrtp: Integer;
begin begin
ARichTextParams := nil; ARichTextParams := nil;
analyzer := TsHTMLAnalyzer.Create(AWorkbook as TsWorkbook, AFont, AHTMLText + '<end>'); analyzer := TsHTMLAnalyzer.Create(AWorkbook as TsWorkbook, AFont, AHTMLText + TERMINATION);
try try
analyzer.PreserveSpaces := true; analyzer.PreserveSpaces := true;
analyzer.Prefix := APrefix; analyzer.Prefix := APrefix;
analyzer.Exec; analyzer.Exec;
APlainText := analyzer.PlainText; APlainText := analyzer.PlainText;
if pos(TERMINATION, APlainText) = Length(APlainText) - Length(TERMINATION) + 1 then
Setlength(APlainText, Length(APlainText) - Length(TERMINATION));
// HTML text has an error --> take the input text literally // HTML text has an error --> take the input text literally
if (AHtmlText <> '') and (APlainText = '') then if (AHtmlText <> '') and (APlainText = '') then