fpspreadsheet: Use HTML conversion to enter rich-text in the visual TsCellEdit control

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

components/fpspreadsheet/fpshtmlutils.pas

@@ -988,47 +988,54 @@ begin
     // NOTE: This is a simple version: every opened tag is closed afterwards!
     // In a more advanced version, shared properties should be kept. This is
     // what FChangedParams was introduced for!
-    if [cfFontName, cfFontSize, cfFontColor] * FChangedparams[i] <> [] then
+    if not SameFont(FBaseFont, FFonts[i]) then
     begin
-      Result := Result + '<font';
+      if [cfFontName, cfFontSize, cfFontColor] * FChangedparams[i] <> [] then
-      if cfFontName in FChangedParams[i] then
+      begin
-        Result := Result + ' face="' + FFonts[i].FontName + '"';
+        Result := Result + '<font';
-      if cfFontSize in FChangedParams[i] then
+        if cfFontName in FChangedParams[i] then
-        Result := Result + ' size="' + Format('%.gpt', [FFonts[i].Size], FPointSeparatorSettings) + '"';
+          Result := Result + ' face="' + FFonts[i].FontName + '"';
-      if cfFontColor in FChangedParams[i] then
+        if cfFontSize in FChangedParams[i] then
-        Result := Result + ' color="' + ColorToHTMLColorStr(FFonts[i].Color) + '"';
+          Result := Result + ' size="' + Format('%.gpt', [FFonts[i].Size], FPointSeparatorSettings) + '"';
-    end;
+        if cfFontColor in FChangedParams[i] then
-    if (cfBold in FChangedParams[i]) then
+          Result := Result + ' color="' + ColorToHTMLColorStr(FFonts[i].Color) + '"';
-      Result := Result + '<b>';
+        Result := Result + '>';
-    if (cfItalic in FChangedParams[i]) then
+      end;
-      Result := Result + '<i>';
+      if (cfBold in FChangedParams[i]) then
-    if (cfUnderline in FChangedParams[i]) then
+        Result := Result + '<b>';
-      Result := Result + '<u>';
+      if (cfItalic in FChangedParams[i]) then
-    if (cfStrikeout in FChangedParams[i]) then
+        Result := Result + '<i>';
-      Result := Result + '<s>';
+      if (cfUnderline in FChangedParams[i]) then
-    if (cfFontPosition in FChangedParams[i]) then
+        Result := Result + '<u>';
-    begin
+      if (cfStrikeout in FChangedParams[i]) then
-      if FFonts[i].Position = fpSuperscript then Result := Result + '<sup>';
+        Result := Result + '<s>';
-      if FFonts[i].Position = fpSubscript then Result := Result + '<sub>';
+      if (cfFontPosition in FChangedParams[i]) then
+      begin
+        if FFonts[i].Position = fpSuperscript then Result := Result + '<sup>';
+        if FFonts[i].Position = fpSubscript then Result := Result + '<sub>';
+      end;
     end;
     // Add the node text
     Result := Result + GetTextOfRichTextParam(i);
     // Add closing tags (reverse order as opening!)
-    if (cfFontPosition in FChangedParams[i]) then
+    if not SameFont(FBaseFont, FFonts[i]) then
     begin
-      if FFonts[i].Position = fpSubscript then Result := Result + '</sub>';
+      if (cfFontPosition in FChangedParams[i]) then
-      if FFonts[i].Position = fpSuperscript then Result := Result + '</sup>';
+      begin
+        if FFonts[i].Position = fpSubscript then Result := Result + '</sub>';
+        if FFonts[i].Position = fpSuperscript then Result := Result + '</sup>';
+      end;
+      if (cfStrikeout in FChangedParams[i]) then
+        Result := Result + '</s>';
+      if (cfUnderline in FChangedParams[i]) then
+        Result := Result + '</u>';
+      if (cfItalic in FChangedParams[i]) then
+        Result := Result + '</i>';
+      if (cfBold in FChangedParams[i]) then
+        Result := Result + '</b>';
+      if [cfFontName, cfFontSize, cfFontColor] * FChangedParams[i] <> [] then
+        Result := Result + '</font>';
     end;
-    if (cfStrikeout in FChangedParams[i]) then
-      Result := Result + '</s>';
-    if (cfUnderline in FChangedParams[i]) then
-      Result := Result + '</u>';
-    if (cfItalic in FChangedParams[i]) then
-      Result := Result + '</i>';
-    if (cfBold in FChangedParams[i]) then
-      Result := Result + '</b>';
-    if [cfFontName, cfFontSize, cfFontColor] * FChangedParams[i] <> [] then
-      Result := Result + '</font';
   end;
 end;
 

components/fpspreadsheet/fpspreadsheet.pas

@@ -4183,6 +4183,8 @@ var
   numFmtParams: TsNumFormatParams;
   maxDig: Integer;
   isMixed: Boolean;
+  rtParams: TsRichTextParams;
+  plain: String;
 begin
   if ACell = nil then
     exit;
@@ -4252,7 +4254,8 @@ begin
     exit;
   end;
 
-  WriteUTF8Text(ACell, AValue);
+  HTMLToRichText(FWorkbook, ReadcellFont(ACell), AValue, plain, rtParams);
+  WriteUTF8Text(ACell, plain, rtParams);
 end;
 
 {@@ ----------------------------------------------------------------------------

components/fpspreadsheet/fpspreadsheetctrls.pas

@@ -212,6 +212,7 @@ type
   TsCellEdit = class(TMemo, IsSpreadsheetControl)
   private
     FWorkbookSource: TsWorkbookSource;
+    FShowHTMLText: Boolean;
     function GetSelectedCell: PCell;
     function GetWorkbook: TsWorkbook;
     function GetWorksheet: TsWorksheet;
@@ -234,6 +235,7 @@ type
     {@@ Refers to the underlying worksheet to which the edited cell belongs. }
     property Worksheet: TsWorksheet read GetWorksheet;
   published
+    property ShowHTMLText: Boolean read FShowHTMLText write FShowHTMLText default true;
     {@@ Link to the WorkbookSource which provides the workbook and worksheet. }
     property WorkbookSource: TsWorkbookSource read FWorkbookSource write SetWorkbookSource;
   end;
@@ -462,7 +464,7 @@ implementation
 
 uses
   Types, Math, TypInfo, LCLType, LCLProc, Dialogs, Forms,
-  fpsStrings, fpsUtils, fpsNumFormat;
+  fpsStrings, fpsUtils, fpsNumFormat, fpsHTMLUtils;
 
 {@@ ----------------------------------------------------------------------------
   Registers the spreadsheet components in the Lazarus component palette,
@@ -1577,6 +1579,7 @@ end;
 constructor TsCellEdit.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
+  FShowHTMLText := True;
   WantReturns := false;
   WantTabs := false;
   AutoSize := true;
@@ -1748,6 +1751,14 @@ begin
             Lines.Text := FormatDateTime('ddddd', ACell^.DateTimevalue)
           else                                      // both
             Lines.Text := FormatDateTime('c', ACell^.DateTimeValue);
+        cctUTF8String:
+          if FShowHTMLText then
+          begin
+            RichTextToHTML(Workbook, Worksheet.ReadCellFont(ACell),
+              ACell^.UTF8StringValue, ACell^.RichTextParams, s);
+            Lines.Text := s;
+          end else
+            Lines.Text := ACell^.UTF8StringValue;
         else
           Lines.Text := Worksheet.ReadAsUTF8Text(ACell);
       end;