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

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4261 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/fpshtml.pas

@@ -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]);
+           '1': ProcessFontSizeAndStyle(16, [fssBold]);     // <H1>
-           '2': ProcessFontSizeAndStyle(14, [fssBold]);
+           '2': ProcessFontSizeAndStyle(14, [fssBold]);     // <H2>
-           '3': ProcessFontSizeAndStyle(12, [fssBold]);
+           '3': ProcessFontSizeAndStyle(12, [fssBold]);     // <H3>
-           '4': ProcessFontSizeAndStyle(12, [fssItalic]);
+           '4': ProcessFontSizeAndStyle(12, [fssItalic]);   // <H4>
-           '5': ProcessFontSizeAndStyle(10, [fssBold]);
+           '5': ProcessFontSizeAndStyle(10, [fssBold]);     // <H5>
-           '6': ProcessFontSizeAndStyle(10, [fssItalic]);
+           '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;

components/fpspreadsheet/fpspreadsheetgrid.pas

@@ -1991,7 +1991,8 @@ begin
         begin
           // merged cells
           FDrawingCell := Worksheet.FindMergeBase(cell);
-          Worksheet.FindMergedRange(FDrawingCell, sr1, sc1, sr2, sc2);
+          if Worksheet.FindMergedRange(FDrawingCell, sr1, sc1, sr2, sc2) then
+          begin
             gr := GetGridRow(sr1);
             if Worksheet.HasComment(FDrawingCell) then
               commentcell_rct := CellRect(GetGridCol(sc2), gr)
@@ -2003,6 +2004,7 @@ begin
             gcNext := gc + (sc2 - sc1) + 1;
           end;
         end;
+      end;
 
       ColRowToOffset(true, true, gc, rct.Left, tmp);
       ColRowToOffset(true, true, gcNext-1, tmp, rct.Right);

components/fpspreadsheet/fpsvisualutils.pas

@@ -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;
+    lineChar: utf8String;
-    s: 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);
 
-      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);
+                 inc(charpos);
-               end;
                  break;
                end;
+             end;
         #10: begin
                inc(p);
-               inc(charPos);
+               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
-               dw := Math.IfThen(ARotation = rtStacked, fontHeight, ACanvas.TextWidth(s));
+               // 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
-                 if spaceFound then
+                   // The line exeeds the max line width.
+                   // There are two cases:
+                   if NumSpaces > 0 then
                    begin
-                   p := pEOL;
+                     // (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;
-                   NumSpaces := savedSpaces;
+                     ARtpFontIndex := savedRtpFontIndex;
-                   ARtpFontIndex := savedRtpIndex;
-                 end else
-                 begin
-                   ALineWidth := ALineWidth - dw;
-                   if ALineWidth = 0 then
-                     inc(p);
                    end;
+                   // (b) This is the only word in the line --> we break at the
+                   // current cursor position.
+                   EOL := true;
                    break;
                  end;
-             end;
+                 inc(p);
-      end;
-
-      inc(p, charLen);
                  inc(charPos);
                end;
+               if EOL then break;
+             end;
+      end;
+    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;