paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

spreadsheet: Fix painting issues for rich-text imported by HTMLReader, not fully solved yet.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4261 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2015-08-09 22:42:20 +00:00
parent baeaf9a230
commit caacb195e4
3 changed files with 120 additions and 93 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
components/fpspreadsheet/fpshtml.pas
View File

@ -385,7 +385,7 @@ begin
ProcessFontStyle(fssBold)
else
if (NoCaseTag = '<BR>') or (NoCaseTag = '<BR/>') or (pos('<BR ', NoCaseTag) = 1) then
FCellText := FCellText + LineEnding;
FCellText := FCellText + #10; //LineEnding;
'D': if (NoCaseTag = '<DEL>') then
ProcessFontStyle(fssStrikeout);
'E': if (NoCaseTag = '<EM>') then
@ -398,12 +398,12 @@ begin
AddRichTextparam(FCurrFont);
end;
'H': case NoCaseTag[3] of
'1': ProcessFontSizeAndStyle(16, [fssBold]);
'2': ProcessFontSizeAndStyle(14, [fssBold]);
'3': ProcessFontSizeAndStyle(12, [fssBold]);
'4': ProcessFontSizeAndStyle(12, [fssItalic]);
'5': ProcessFontSizeAndStyle(10, [fssBold]);
'6': ProcessFontSizeAndStyle(10, [fssItalic]);
'1': ProcessFontSizeAndStyle(16, [fssBold]); // <H1>
'2': ProcessFontSizeAndStyle(14, [fssBold]); // <H2>
'3': ProcessFontSizeAndStyle(12, [fssBold]); // <H3>
'4': ProcessFontSizeAndStyle(12, [fssItalic]); // <H4>
'5': ProcessFontSizeAndStyle(10, [fssBold]); // <H5>
'6': ProcessFontSizeAndStyle(10, [fssItalic]); // <H6>
end;
'I': case NoCaseTag of
'<I>' : ProcessFontStyle(fssItalic);
@ -412,7 +412,7 @@ begin
'P': if (NoCaseTag = '<P>') or (pos('<P ', NoCaseTag) = 1) then
begin
if FCellText <> '' then
FCellText := FCellText + LineEnding;
FCellText := FCellText + #10; //LineEnding;
FFontStack.Push(AddFont(FCurrFont));
FAttrList.Parse(ActualTag);
ReadFont(FCurrFont);
@ -479,7 +479,7 @@ begin
'P': if (NoCaseTag = '</P>') then
begin
ProcessFontRestore;
if FCellText <> '' then FCellText := FCellText + LineEnding;
if FCellText <> '' then FCellText := FCellText + #10; //LineEnding;
end;
'S': if (NoCaseTag = '</SUB>') or (NoCaseTag = '</SUP>') or
(NoCaseTag = '</S>') or (NoCaseTag = '</SPAN>') or
@ -918,38 +918,41 @@ begin
// The next tags are processed only within a <TD> or <TH> context.
ProcessCellTags(NoCaseTag, ActualTag);
(*
{
if (pos('<H', NoCaseTag) = 1) and (NoCaseTag[3] in ['1'..'9']) then
begin
if FInCell then
FInHeader := true;
end else }
else
case NoCaseTag of
'</SPAN>':
if FInCell then FInSpan := false;
'<H1/>', '<H2/>', '<H3/>', '<H4/>', '<H5/>', '<H6/>':
if FinCell then FInHeader := false;
'<TD/>', '<TD />', '<TH/>', '<TH />': // empty cells
if FInCell then
inc(FCurrCol);
end;
*)
end;
procedure TsHTMLReader.TextFoundHandler(AText: String);
// Todo: find correct way to retain spaces
// Example:
// <td>123<b>abc</b> is rendered by browser as 123abc (with abc bold)
// <td>123
// <b>abc</b> is rendered as 123 abc
// The current way is not good.
var
beginsWithLineEnding, endsWithLineEnding: Boolean;
begin
if FInCell then
begin
beginsWithLineEnding := (AText <> '') and (AText[1] in [#13, #10]);
endsWithLineEnding := (AText <> '') and (AText[Length(AText)] in [#13,#10]);
AText := CleanHTMLString(ConvertEncoding(AText, FEncoding, EncodingUTF8));
if AText <> '' then
begin
if FCellText = '' then
FCellText := AText
else
if beginsWithLineEnding then
FCellText := FCellText + ' ' + AText
else
if endsWithLineEnding then
FCelLText := FCelLText + AText + ' '
else
FCellText := FCellText + AText;
{
if FCellText[Length(FCellText)] = #10 then
FCellText := FCellText + AText
else
FCellText := FCellText + ' ' + AText;
}
end;
end;
end;

22
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -1991,16 +1991,18 @@ begin
begin
// merged cells
FDrawingCell := Worksheet.FindMergeBase(cell);
Worksheet.FindMergedRange(FDrawingCell, sr1, sc1, sr2, sc2);
gr := GetGridRow(sr1);
if Worksheet.HasComment(FDrawingCell) then
commentcell_rct := CellRect(GetGridCol(sc2), gr)
else
commentcell_rct := Rect(0,0,0,0);
ColRowToOffSet(False, True, gr, rct.Top, tmp);
ColRowToOffSet(False, True, gr + integer(sr2) - integer(sr1), tmp, rct.Bottom);
gc := GetGridCol(sc1);
gcNext := gc + (sc2 - sc1) + 1;
if Worksheet.FindMergedRange(FDrawingCell, sr1, sc1, sr2, sc2) then
begin
gr := GetGridRow(sr1);
if Worksheet.HasComment(FDrawingCell) then
commentcell_rct := CellRect(GetGridCol(sc2), gr)
else
commentcell_rct := Rect(0,0,0,0);
ColRowToOffSet(False, True, gr, rct.Top, tmp);
ColRowToOffSet(False, True, gr + integer(sr2) - integer(sr1), tmp, rct.Bottom);
gc := GetGridCol(sc1);
gcNext := gc + (sc2 - sc1) + 1;
end;
end;
end;

132
components/fpspreadsheet/fpsvisualutils.pas
View File

@ -270,14 +270,15 @@ var
procedure ScanLine(var P: PChar; var NumSpaces: Integer;
var ARtpFontIndex: Integer; var ALineWidth, ALineHeight: Integer);
var
pEOL: PChar;
pWordStart: PChar;
EOL: Boolean;
savedSpaces: Integer;
savedWidth: Integer;
savedRtpIndex: Integer;
savedCharPos: Integer;
savedRtpFontIndex: Integer;
maxWidth: Integer;
dw: Integer;
spaceFound: Boolean;
s: utf8String;
lineChar: utf8String;
charLen: Integer; // Number of bytes of current utf8 character
begin
NumSpaces := 0;
@ -286,9 +287,6 @@ var
ALineWidth := 0;
savedWidth := 0;
savedSpaces := 0;
savedRtpIndex := ARtpFontIndex;
spaceFound := false;
pEOL := p;
if AWordwrap then
begin
@ -300,67 +298,89 @@ var
else
maxWidth := MaxInt;
while p^ <> #0 do begin
UpdateFont(charPos, ARtpFontIndex, fontHeight, fontPos);
ALineHeight := Max(fontHeight, ALineHeight);
UpdateFont(charPos, ARtpFontIndex, fontHeight, fontPos);
ALineHeight := Max(fontHeight, ALineHeight);
s := UnicodeToUTF8(UTF8CharacterToUnicode(p, charLen));
while p^ <> #0 do begin
case p^ of
' ': begin
spaceFound := true;
pEOL := p;
savedWidth := ALineWidth;
savedSpaces := NumSpaces;
savedRtpIndex := ARtpFontIndex;
dw := Math.IfThen(ARotation = rtStacked, fontHeight, ACanvas.TextWidth(s));
if ALineWidth + dw < MaxWidth then
begin
inc(NumSpaces);
ALineWidth := ALineWidth + dw;
end else
break;
end;
#13: begin
inc(p);
inc(charPos);
inc(charpos);
if p^ = #10 then
begin
inc(p);
inc(charPos);
end;
break;
end;
#10: begin
inc(p);
inc(charPos);
break;
end;
else begin
dw := Math.IfThen(ARotation = rtStacked, fontHeight, ACanvas.TextWidth(s));
ALineWidth := ALineWidth + dw;
if ALineWidth > maxWidth then
begin
if spaceFound then
begin
p := pEOL;
ALineWidth := savedWidth;
NumSpaces := savedSpaces;
ARtpFontIndex := savedRtpIndex;
end else
begin
ALineWidth := ALineWidth - dw;
if ALineWidth = 0 then
inc(p);
end;
inc(charpos);
break;
end;
end;
#10: begin
inc(p);
inc(charpos);
break;
end;
' ': begin
savedWidth := ALineWidth;
savedSpaces := NumSpaces;
// Find next word
while p^ = ' ' do
begin
UpdateFont(charPos, ARtpFontIndex, fontHeight, fontPos);
ALineHeight := Max(fontHeight, ALineHeight);
dw := Math.IfThen(ARotation = rtStacked, fontHeight, ACanvas.TextWidth(' '));
ALineWidth := ALineWidth + dw;
inc(NumSpaces);
inc(p);
inc(charPos);
end;
if ALineWidth >= maxWidth then
begin
ALineWidth := savedWidth;
NumSpaces := savedSpaces;
break;
end;
end;
else begin
// Bere begins a new word. Find end of this word and check if
// it fits into the line.
// Store the data valid for the word start.
pWordStart := p;
savedCharPos := charpos;
savedRtpFontIndex := ARtpFontIndex;
EOL := false;
while (p^ <> #0) and (p^ <> #13) and (p^ <> #10) and (p^ <> ' ') do
begin
UpdateFont(charPos, ARtpFontIndex, fontHeight, fontPos);
ALineHeight := Max(fontHeight, ALineHeight);
lineChar := UnicodeToUTF8(UTF8CharacterToUnicode(p, charLen));
dw := Math.IfThen(ARotation = rtStacked, fontHeight, ACanvas.TextWidth(lineChar));
ALineWidth := ALineWidth + dw;
if ALineWidth > maxWidth then
begin
// The line exeeds the max line width.
// There are two cases:
if NumSpaces > 0 then
begin
// (a) This is not the only word: Go back to where this
// word began. We had stored everything needed!
p := pWordStart;
charpos := savedCharPos;
ALineWidth := savedWidth;
ARtpFontIndex := savedRtpFontIndex;
end;
// (b) This is the only word in the line --> we break at the
// current cursor position.
EOL := true;
break;
end;
inc(p);
inc(charPos);
end;
if EOL then break;
end;
end;
inc(p, charLen);
inc(charPos);
end;
UpdateFont(charPos, ARtpFontIndex, fontHeight, fontPos);
ALineHeight := Max(fontHeight, ALineHeight);
end;
{ Paints the text between the pointers pStart and pEnd.
@ -482,11 +502,13 @@ begin
totalHeight := totalHeight + Height;
linelen := Max(linelen, Width);
p := pEnd;
{
if p^ = ' ' then
while (p^ <> #0) and (p^ = ' ') do begin
inc(p);
inc(charPos);
end;
}
end;
until p^ = #0;