fpspreadsheet: Fix writing of RichText in Excel2003/XML format.

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

components/fpspreadsheet/examples/read_write/excelxmldemo/excelxmlread.lpr

@@ -23,8 +23,7 @@ var
 begin
   // Open the input file
   dir := ExtractFilePath(ParamStr(0));
-//  inputFileName := dir + 'test.xml';
+  inputFileName := dir + 'test.xml';
-  inputFileName := dir + 'datatypes.xml';
 
   if not FileExists(inputFileName) then begin
     WriteLn('Input file ', inputFileName, ' does not exist. Please run excelxmlwrite first.');

components/fpspreadsheet/examples/read_write/excelxmldemo/excelxmlwrite.lpi

@@ -1,14 +1,14 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="11"/>
+    <Version Value="12"/>
     <PathDelim Value="\"/>
     <General>
       <Flags>
         <LRSInOutputDirectory Value="False"/>
+        <CompatibilityMode Value="True"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
-      <MainUnit Value="0"/>
       <Title Value="excelxmlwrite"/>
       <UseAppBundle Value="False"/>
     </General>
@@ -17,19 +17,16 @@
     </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
-      <IgnoreBinaries Value="False"/>
-      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
-      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
     </PublishOptions>
     <RunParams>
       <local>
-        <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+        <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
       </local>
       <FormatVersion Value="2"/>
       <Modes Count="1">
         <Mode0 Name="default">
           <local>
-            <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+            <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
           </local>
         </Mode0>
       </Modes>

components/fpspreadsheet/examples/read_write/excelxmldemo/excelxmlwrite.lpr

@@ -126,7 +126,6 @@ begin
   MyWorksheet.WriteBorderLineStyle(5, 13, cbSouth, lsDotted);
 
   // N6 empty cell, left border: double
-//  MyWorksheet.WriteBlank(5, 14);
   MyWorksheet.WriteBorders(5, 14, [cbWest]);
   MyWorksheet.WriteBorderLineStyle(5, 14, cbWest, lsDouble);
 
@@ -142,6 +141,8 @@ begin
   MyWorksheet.WriteText(8, 3, 'Colors...');
   MyWorksheet.WriteFont(8, 3, 'Courier New', 12, [fssUnderline], scBlue);
   MyWorksheet.WriteBackgroundColor(8, 3, scYellow);
+
+  (********************* to do...
   MyWorksheet.WriteComment(8, 3, 'This is font "Courier New", Size 12.');
 
   // Write the string formula E1 = A1 + B1 ...
@@ -169,7 +170,7 @@ begin
     RPNSTring('B',
     RPNFunc(fekConcat,
     nil)))));
-
+              *)
   r := 10;
   MyWorksheet.WriteText(r, 0, 'Writing current date/time:');
   inc(r, 2);
@@ -377,6 +378,8 @@ begin
   // Set height of rows 0
   MyWorksheet.WriteRowHeight(0, 5, suLines);  // 5 lines
 
+  //----------------------------------------------------------------------------
+
   // Creates a new worksheet
   MyWorksheet := MyWorkbook.AddWorksheet(Str_Worksheet2);
 

components/fpspreadsheet/source/common/xlsxml.pas

@@ -1174,6 +1174,9 @@ var
   cctStr: String;
   xmlnsStr: String;
   dataTagStr: String;
+  p: Integer;
+  tmp: String;
+  ch:char;
 begin
   if Length(ACell^.RichTextParams) > 0 then
   begin
@@ -1187,6 +1190,24 @@ begin
     );
     xmlnsStr := ' xmlns="http://www.w3.org/TR/REC-html40"';
     dataTagStr := 'ss:';
+
+    // Excel does not like units in font size specification...
+    tmp := valueStr;
+    p := pos('<Font html:Size="', valueStr);
+    if p > 0 then begin
+      valueStr := '';
+      while p > 0 do begin
+        inc(p, Length('<Font html:Size="'));
+        valueStr := valueStr + copy(tmp, 1, p-1);
+        while (tmp[p] <> '"') do begin
+          if (tmp[p] in ['0'..'9', '.']) then valueStr := valueStr + tmp[p];
+          inc(p);
+        end;
+        tmp := copy(tmp, p, MaxInt);
+        p := pos('<Font html:Size="', tmp);
+      end;
+      valueStr := valuestr + tmp;
+    end;
   end else
   begin
     valueStr := AValue;
@@ -1597,8 +1618,8 @@ begin
   // Protection
   protectStr := Format(INDENT3 + '<ProtectObjects>%s</ProtectObjects>' + LF +
                        INDENT3 + '<ProtectScenarios>%s</ProtectScenarios>' + LF, [
-    StrUtils.IfThen(AWorksheet.IsProtected and (spObjects in AWorksheet.Protection), '1', '0'),
+    StrUtils.IfThen(AWorksheet.IsProtected and (spObjects in AWorksheet.Protection), 'True', 'False'),
-    StrUtils.IfThen(AWorksheet.IsProtected {and [spScenarios in AWorksheet.Protection])}, '1', '0')
+    StrUtils.IfThen(AWorksheet.IsProtected {and [spScenarios in AWorksheet.Protection])}, 'True', 'False')
   ]);
 
   // Put it all together...