fpspreadsheet: Fix rich-text ignoring non-ansi characters. Beginning to handle rich-text formatting runs when reading biff5 files.

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

components/fpspreadsheet/fpstypes.pas

@@ -431,6 +431,15 @@ type
   {@@ Parameters describing formatting of text ranges in cell text }
   TsRichTextParams = array of TsRichTextParam;
 
+  {@@ Excel rich-text formatting run }
+  TsRichTextFormattingRun = record
+    FirstIndex: Integer;
+    FontIndex: Integer;
+  end;
+
+  {@@ Array of Excel rich-text formatting runs }
+  TsRichTextFormattingRuns = array of TsRichTextFormattingRun;
+
   {@@ Indicates the border for a cell. If included in the CellBorders set the
       corresponding border is drawn in the style defined by the CellBorderStyle. }
   TsCellBorder = (cbNorth, cbWest, cbEast, cbSouth, cbDiagUp, cbDiagDown);

components/fpspreadsheet/fpsvisualutils.pas

@@ -263,7 +263,6 @@ var
   procedure ScanLine(var P: PChar; var NumSpaces: Integer;
     var PendingRtpIndex: Integer; var width, height: Integer);
   var
-    ch: Char;
     pEOL: PChar;
     savedSpaces: Integer;
     savedWidth: Integer;
@@ -273,6 +272,8 @@ var
     dw, h: Integer;
     fntpos: TsFontPosition;
     spaceFound: Boolean;
+    s: utf8String;
+    charLen: Integer;
   begin
     NumSpaces := 0;
 
@@ -299,15 +300,15 @@ var
       UpdateFont(p, rtState, PendingRtpIndex, h, fntpos);
       if h > height then height := h;
 
-      ch := p^;
+      s := UnicodeToUTF8(UTF8CharacterToUnicode(p, charLen));
-      case ch of
+      case p^ of
         ' ': begin
                spaceFound := true;
                pEOL := p;
                savedWidth := width;
                savedSpaces := NumSpaces;
                savedRtpIndex := PendingRtpIndex;
-               dw := Math.IfThen(ARotation = rtStacked, h, ACanvas.TextWidth(ch));
+               dw := Math.IfThen(ARotation = rtStacked, h, ACanvas.TextWidth(s));
                if width + dw < MaxWidth then
                begin
                  inc(NumSpaces);
@@ -324,7 +325,7 @@ var
                exit;
              end;
         else begin
-               dw := Math.IfThen(ARotation = rtStacked, h, ACanvas.TextWidth(ch));
+               dw := Math.IfThen(ARotation = rtStacked, h, ACanvas.TextWidth(s));
                width := width + dw;
                if width > maxWidth then
                begin
@@ -345,69 +346,70 @@ var
              end;
       end;
 
-      inc(P, UTF8CharacterLength(p));
+      inc(p, charLen);
     end;
   end;
 
   procedure DrawLine(pStart, pEnd: PChar; x,y, hLine: Integer; PendingRtpIndex: Integer);
   var
-    ch: Char;
     p: PChar;
     rtState: TRtState;
     h, w: Integer;
     fntpos: TsFontPosition;
+    s: utf8String;
+    charLen: Integer;
   begin
     p := pStart;
     InitFont(p, rtState, PendingRtpIndex, h);
     while p^ <> #0 do begin
+      s := UnicodeToUTF8(UTF8CharacterToUnicode(p, charLen));
       UpdateFont(p, rtState, PendingRtpIndex, h, fntpos);
-      ch := p^;
       case ARotation of
         trHorizontal:
           begin
             ACanvas.Font.Orientation := 0;
             case fntpos of
-              fpNormal     : ACanvas.TextOut(x, y, ch);
+              fpNormal     : ACanvas.TextOut(x, y, s);
-              fpSubscript  : ACanvas.TextOut(x, y + hLine div 2, ch);
+              fpSubscript  : ACanvas.TextOut(x, y + hLine div 2, s);
-              fpSuperscript: ACanvas.TextOut(x, y - hLine div 6, ch);
+              fpSuperscript: ACanvas.TextOut(x, y - hLine div 6, s);
             end;
-            inc(x, ACanvas.TextWidth(ch));
+            inc(x, ACanvas.TextWidth(s));
           end;
         rt90DegreeClockwiseRotation:
           begin
             ACanvas.Font.Orientation := -900;
             case fntpos of
-              fpNormal     : ACanvas.TextOut(x, y, ch);
+              fpNormal     : ACanvas.TextOut(x, y, s);
-              fpSubscript  : ACanvas.TextOut(x - hLine div 2, y, ch);
+              fpSubscript  : ACanvas.TextOut(x - hLine div 2, y, s);
-              fpSuperscript: ACanvas.TextOut(x + hLine div 6, y, ch);
+              fpSuperscript: ACanvas.TextOut(x + hLine div 6, y, s);
             end;
-            inc(y, ACanvas.TextWidth(ch));
+            inc(y, ACanvas.TextWidth(s));
           end;
         rt90DegreeCounterClockwiseRotation:
           begin
             ACanvas.Font.Orientation := +900;
             case fntpos of
-              fpNormal     : ACanvas.TextOut(x, y, ch);
+              fpNormal     : ACanvas.TextOut(x, y, s);
-              fpSubscript  : ACanvas.TextOut(x + hLine div 2, y, ch);
+              fpSubscript  : ACanvas.TextOut(x + hLine div 2, y, s);
-              fpSuperscript: ACanvas.TextOut(x - hLine div 6, y, ch);
+              fpSuperscript: ACanvas.TextOut(x - hLine div 6, y, s);
             end;
-            dec(y, ACanvas.TextWidth(ch));
+            dec(y, ACanvas.TextWidth(s));
           end;
         rtStacked:
           begin
             ACanvas.Font.Orientation := 0;
-            w := ACanvas.TextWidth(ch);
+            w := ACanvas.TextWidth(s);
             // chars centered around x
             case fntpos of
-              fpNormal     : ACanvas.TextOut(x - w div 2, y, ch);
+              fpNormal     : ACanvas.TextOut(x - w div 2, y, s);
-              fpSubscript  : ACanvas.TextOut(x - w div 2, y + hLine div 2, ch);
+              fpSubscript  : ACanvas.TextOut(x - w div 2, y + hLine div 2, s);
-              fpSuperscript: ACanvas.TextOut(x - w div 2, y - hLine div 6, ch);
+              fpSuperscript: ACanvas.TextOut(x - w div 2, y - hLine div 6, s);
             end;
             inc(y, h);
           end;
       end;
 
-      inc(P, UTF8CharacterLength(p));
+      inc(P, charLen);
       if P >= PEnd then break;
     end;
   end;
@@ -425,11 +427,10 @@ begin
     iRtp := -1;
   totalHeight := 0;
 
+  Convert_sFont_to_Font(AWorkbook.GetFont(AFontIndex), ACanvas.Font);
+
   if ARotation = rtStacked then
-  begin
-    Convert_sFont_to_Font(AWorkbook.GetFont(AFontIndex), ACanvas.Font);
     stackPeriod := ACanvas.TextWidth('M') * 2;
-  end;
 
   // Get layout of lines:
   // "lineinfos" collect data on where lines start and end, their width and

components/fpspreadsheet/xlsbiff5.pas

@@ -516,18 +516,20 @@ end;
 procedure TsSpreadBIFF5Reader.ReadRichString(AStream: TStream);
 var
   L: Word;
-  B: BYTE;
+  B, F: Byte;
   ARow, ACol: Cardinal;
   XF: Word;
-  AStrValue: ansistring;
+  ansistr: ansistring;
+  valueStr: UTF8String;
   cell: PCell;
+  rtfRuns: TsRichTextFormattingRuns;
 begin
   ReadRowColXF(AStream, ARow, ACol, XF);
 
   { Byte String with 16-bit size }
-  L := WordLEtoN(AStream.ReadWord());
+  L := WordLEtoN(AStream.ReadWord);
-  SetLength(AStrValue,L);
+  SetLength(ansistr, L);
-  AStream.ReadBuffer(AStrValue[1], L);
+  AStream.ReadBuffer(ansistr[1], L);
 
   { Create cell }
   if FIsVirtualMode then begin
@@ -537,16 +539,20 @@ begin
     cell := FWorksheet.AddCell(ARow, ACol);
 
   { Save the data }
-  FWorksheet.WriteUTF8Text(cell, ISO_8859_1ToUTF8(AStrValue));
+  valueStr := ConvertEncoding(ansistr, FCodePage, encodingUTF8);
-  //Read formatting runs (not supported)
+  FWorksheet.WriteUTF8Text(cell, valuestr);
+
+  // Read rich-text formatting runs
   B := AStream.ReadByte;
+  SetLength(rtfRuns, B);
   for L := 0 to B-1 do begin
-    AStream.ReadByte; // First formatted character
+    rtfRuns[L].FirstIndex := AStream.ReadByte; // Index of first formatted character
-    AStream.ReadByte; // Index to FONT record
+    rtfRuns[L].FontIndex := AStream.ReadByte;  // Index of font used
   end;
 
   { Add attributes to cell }
   ApplyCellFormatting(cell, XF);
+  ApplyRichTextFormattingRuns(cell, rtfRuns);
 
   if FIsVirtualMode then
     Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
@@ -626,7 +632,7 @@ var
   dw: DWord;
   fill: Word;
   fs: TsFillStyle;
-  fnt: TsFont;
+//  fnt: TsFont;
 begin
   InitFormatRecord(fmt);
   fmt.ID := FCellFormatList.Count;
@@ -638,10 +644,13 @@ begin
   // Font index
   i := WordLEToN(rec.FontIndex);
   if i > 4 then dec(i);  // Watch out for the nasty missing font #4...
+  fmt.FontIndex := FixFontIndex(i);
+  {
   fnt := TsFont(FFontList[i]);
   fmt.FontIndex := Workbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
   if fmt.FontIndex = -1 then
     fmt.FontIndex := Workbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
+    }
   if fmt.FontIndex > 1 then
     Include(fmt.UsedFormattingFields, uffFont);
 

components/fpspreadsheet/xlscommon.pas

@@ -353,14 +353,18 @@ type
     FIncompleteNoteLength: Word;
     FFirstNumFormatIndexInFile: Integer;
     FPalette: TsPalette;
+
     procedure AddBuiltinNumFormats; override;
-    procedure ApplyCellFormatting(ACell: PCell; XFIndex: Word); virtual; //overload;
+    procedure ApplyCellFormatting(ACell: PCell; XFIndex: Word); virtual;
+    procedure ApplyRichTextFormattingRuns(ACell: PCell;
+      ARuns: TsRichTextFormattingRuns);
     // Extracts a number out of an RK value
     function DecodeRKValue(const ARK: DWORD): Double;
     // Returns the numberformat for a given XF record
     procedure ExtractNumberFormat(AXFIndex: WORD;
       out ANumberFormat: TsNumberFormat; out ANumberFormatStr: String); virtual;
     procedure FixColors;
+    function FixFontIndex(AFontIndex: Integer): Integer;
     // Tries to find if a number cell is actually a date/datetime/time cell and retrieves the value
     function IsDateTime(Number: Double; ANumberFormat: TsNumberFormat;
       ANumberFormatStr: String; out ADateTime: TDateTime): Boolean;
@@ -837,6 +841,46 @@ begin
   end;
 end;
 
+{@@ ----------------------------------------------------------------------------
+  Converts the rich-text formatting run data as read from the file to the
+  internal format used by the cell.
+-------------------------------------------------------------------------------}
+procedure TsSpreadBIFFReader.ApplyRichTextFormattingRuns(ACell: PCell;
+  ARuns: TsRichTextFormattingRuns);
+var
+  fntIndex: Integer;
+  cellFntIndex: Integer;
+  cellStr: String;
+  i: Integer;
+begin
+  if Length(ARuns) = 0 then
+    exit;
+
+  cellStr := ACell^.UTF8StringValue;
+  cellFntIndex := FWorksheet.ReadCellFontIndex(ACell);
+
+  SetLength(ACell^.RichTextParams, 0);
+  for i := 0 to High(ARuns) do begin
+    // Make sure that the fontindex defined in the formatting runs array points to
+    // the workbook's fontlist, not to the reader's fontlist.
+    fntIndex := FixFontIndex(ARuns[i].FontIndex);
+    // Ony fonts different from the cell's standard font are considered to be
+    // elements in the TsRichTextParams array used by the cell.
+    if fntIndex <> cellFntIndex then
+    begin
+      SetLength(ACell^.RichTextParams, Length(ACell^.RichTextParams)+1);
+      with ACell^.RichTextParams[High(ACell^.RichTextParams)] do
+      begin
+        FontIndex := fntIndex;
+        StartIndex := ARuns[i].FirstIndex;
+        if i < High(ARuns) then
+          EndIndex := ARuns[i+1].FirstIndex else
+          EndIndex := Length(cellStr);
+      end;
+    end;
+  end;
+end;
+
 {@@ ----------------------------------------------------------------------------
   Extracts a number out of an RK value.
   Valid since BIFF3.
@@ -934,6 +978,21 @@ begin
   end;
 end;
 
+{@@ ----------------------------------------------------------------------------
+  Converts the index of a font in the reader fontlist to the index of this font
+  in the workbook's fontlist. If the font is not yet contained in the workbook
+  fontlist it is added.
+-------------------------------------------------------------------------------}
+function TsSpreadBIFFReader.FixFontIndex(AFontIndex: Integer): Integer;
+var
+  fnt: TsFont;
+begin
+  fnt := TsFont(FFontList[AFontIndex]);
+  Result := FWorkbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position);
+  if Result = -1 then
+    Result := FWorkbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position);
+end;
+
 {@@ ----------------------------------------------------------------------------
   Converts the number to a date/time and return that if it is
 -------------------------------------------------------------------------------}