fpspreadsheet: Fix incorrect assignment of cell format to hyperlinks when reading ods files (and some more bugs). Extend TsSpreadsheetInspector to display font and cell format lists of the workbook.

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

components/fpspreadsheet/examples/fpsctrls/demo_ctrls.lpi

@@ -69,6 +69,7 @@
         <ComponentName Value="MainForm"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
+        <UnitName Value="main"/>
       </Unit1>
     </Units>
   </ProjectOptions>

components/fpspreadsheet/examples/fpsctrls/main.lfm

@@ -1,7 +1,7 @@
 object MainForm: TMainForm
-  Left = 495
+  Left = 503
   Height = 621
-  Top = 132
+  Top = 157
   Width = 940
   Caption = 'demo_ctrls'
   ClientHeight = 601
@@ -55,7 +55,7 @@ object MainForm: TMainForm
     Top = 83
     Width = 253
     OnChange = InspectorTabControlChange
-    TabIndex = 0
+    TabIndex = 1
     Tabs.Strings = (
       'Workbook'
       'Worksheet'
@@ -71,9 +71,11 @@ object MainForm: TMainForm
       Top = 23
       Width = 249
       Align = alClient
-      RowCount = 25
+      RowCount = 32
       TabOrder = 1
       TitleStyle = tsNative
+      DisplayOptions = [doColumnTitles]
+      Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goColSizing, goAlwaysShowEditor, goThumbTracking, goCellHints, goTruncCellHints]
       Strings.Strings = (
         'FileName='
         'FileFormat=sfExcel8'
@@ -99,6 +101,13 @@ object MainForm: TMainForm
         '  PosCurrencyFormat=3'
         '  NegCurrencyFormat=8'
         '  TwoDigitYearCenturyWindow=50'
+        'Font0=Arial; size 10,0; color black'
+        'Font1=Arial; size 10,0; color black; bold'
+        'Font2=Arial; size 10,0; color black; italic'
+        'Font3=Arial; size 10,0; color black; underline'
+        'Font4='
+        'Font5=Arial; size 10,0; color black; bold; italic'
+        'Font6=Arial; size 10,0; color blue; underline'
       )
       TitleCaptions.Strings = (
         'Properties'
@@ -112,13 +121,14 @@ object MainForm: TMainForm
       )
     end
   end
-  object Splitter1: TSplitter
+  object InspectorSplitter: TSplitter
     Left = 682
     Height = 518
     Top = 83
     Width = 5
     Align = alRight
     ResizeAnchor = akRight
+    Visible = False
   end
   object ToolBar1: TToolBar
     Left = 0

components/fpspreadsheet/examples/fpsctrls/main.pas

@@ -230,7 +230,7 @@ type
     ToolButton19: TToolButton;
     AcFontUnderline: TsFontStyleAction;
     AcFontStrikeout: TsFontStyleAction;
-    Splitter1: TSplitter;
+    InspectorSplitter: TSplitter;
     Inspector: TsSpreadsheetInspector;
     InspectorTabControl: TTabControl;
     AcAddWorksheet: TsWorksheetAddAction;
@@ -394,6 +394,8 @@ end;
 procedure TMainForm.AcViewInspectorExecute(Sender: TObject);
 begin
   InspectorTabControl.Visible := AcViewInspector.Checked;
+  InspectorSplitter.Visible := AcViewInspector.Checked;
+  InspectorSplitter.Left := 0;
 end;
 
 { Event handler to synchronize the mode of the spreadsheet inspector with the

components/fpspreadsheet/fpsopendocument.pas

@@ -96,7 +96,7 @@ type
     procedure ReadColumnStyle(AStyleNode: TDOMNode);
     // Figures out the base year for times in this file (dates are unambiguous)
     procedure ReadDateMode(SpreadSheetNode: TDOMNode);
-    function ReadFont(ANode: TDOMnode; IsDefaultFont: Boolean): Integer;
+    function ReadFont(ANode: TDOMnode; APreferredIndex: Integer = -1): Integer;
     procedure ReadRowsAndCells(ATableNode: TDOMNode);
     procedure ReadRowStyle(AStyleNode: TDOMNode);
 
@@ -1183,9 +1183,11 @@ end;
 
 { Reads font data from an xml node, adds the font to the workbooks FontList
   (if not yet contained), and returns the index in the font list.
-  If "IsDefaultFont" is true the first FontList entry (DefaultFont) is replaced. }
+  If the font is a special font (such as DefaultFont, or HyperlinkFont) then
+  APreferredIndex defines the index under which the font should be stored in the
+  list. }
 function TsSpreadOpenDocReader.ReadFont(ANode: TDOMnode;
-  IsDefaultFont: Boolean): Integer;
+  APreferredIndex: Integer = -1): Integer;
 var
   fntName: String;
   fntSize: Single;
@@ -1227,12 +1229,18 @@ begin
   else
     fntColor := FWorkbook.GetFont(0).Color;
 
-  if IsDefaultFont then
+  if APreferredIndex = 0 then
   begin
     FWorkbook.SetDefaultFont(fntName, fntSize);
     Result := 0;
-  end
+  end else
-  else
+  if (APreferredIndex > -1) then
+  begin
+    if (APreferredIndex = 4) then
+      raise Exception.Create('Cannot replace font #4');
+    FWorkbook.ReplaceFont(APreferredIndex, fntName, fntSize, fntStyles, fntColor);
+    Result := APreferredIndex;
+  end else
   begin
     Result := FWorkbook.FindFont(fntName, fntSize, fntStyles, fntColor);
     if Result = -1 then
@@ -1525,6 +1533,7 @@ begin
     if pos('../', hyperlink) = 1 then
       Delete(hyperlink, 1, Length('../'));
     FWorksheet.WriteHyperlink(cell, hyperlink);
+    FWorksheet.WriteFont(cell, HYPERLINK_FONTINDEX);
   end;
 
   styleName := GetAttrValue(ACellNode, 'table:style-name');
@@ -2340,7 +2349,7 @@ begin
     nodeName := styleNode.NodeName;
     if nodeName = 'style:default-style' then
     begin
-      ReadFont(styleNode.FindNode('style:text-properties'), true);
+      ReadFont(styleNode.FindNode('style:text-properties'), DEFAULT_FONTINDEX);
     end else
     if nodeName = 'style:style' then
     begin
@@ -2378,7 +2387,13 @@ begin
           nodeName := styleChildNode.NodeName;
           if nodeName = 'style:text-properties' then
           begin
-            fmt.FontIndex := ReadFont(styleChildNode, false);
+            if SameText(stylename, 'Default') then
+              fmt.FontIndex := ReadFont(styleChildNode, DEFAULT_FONTINDEX)
+            else
+            if SameText(stylename, 'Excel_20_Built-in_20_Hyperlink') then
+              fmt.FontIndex := ReadFont(styleChildNode, HYPERLINK_FONTINDEX)
+            else
+              fmt.FontIndex := ReadFont(styleChildNode);
             if fmt.FontIndex = 1  then
               Include(fmt.UsedFormattingFields, uffBold)
             else if fmt.FontIndex > 1 then

components/fpspreadsheet/fpspreadsheet.pas

@@ -627,9 +627,10 @@ type
     function TryStrToCellRanges(AText: String; out AWorksheet: TsWorksheet;
       out ARanges: TsCellRangeArray; AListSeparator: Char = #0): Boolean;
 
-    { Format handling }
+    { Cell format handling }
     function AddCellFormat(const AValue: TsCellFormat): Integer;
     function GetCellFormat(AIndex: Integer): TsCellFormat;
+    function GetCellFormatAsString(AIndex: Integer): String;
     function GetNumCellFormats: Integer;
     function GetPointerToCellFormat(AIndex: Integer): PsCellFormat;
 
@@ -649,6 +650,8 @@ type
     function GetHyperlinkFont: TsFont;
     procedure InitFonts;
     procedure RemoveAllFonts;
+    procedure ReplaceFont(AFontIndex: Integer; AFontName: String;
+      ASize: Single; AStyle: TsFontStyles; AColor: TsColor);
     procedure SetDefaultFont(const AFontName: String; ASize: Single);
 
     { Color handling }
@@ -6164,8 +6167,10 @@ begin
   InitFonts;
 
   FCellFormatList := TsCellFormatList.Create(false);
+
+  // Add default cell format
   InitFormatRecord(fmt);
-  AddCellFormat(fmt);   // Add record for default format to the FormatList
+  AddCellFormat(fmt);
 end;
 
 {@@ ----------------------------------------------------------------------------
@@ -6976,6 +6981,51 @@ begin
   Result := FCellFormatList.Items[AIndex]^;
 end;
 
+{@@ ----------------------------------------------------------------------------
+  Returns a string describing the cell format with the specified index.
+-------------------------------------------------------------------------------}
+function TsWorkbook.GetCellFormatAsString(AIndex: Integer): String;
+var
+  fmt: PsCellFormat;
+  cb: TsCellBorder;
+  s: String;
+begin
+  Result := '';
+  fmt := GetPointerToCellFormat(AIndex);
+  if fmt = nil then
+    exit;
+
+  if (uffBold in fmt^.UsedFormattingFields) then
+    Result := Format('%s; bold', [Result]);
+  if (uffFont in fmt^.UsedFormattingFields) then
+    Result := Format('%s; Font%d', [Result, fmt^.FontIndex]);
+  if (uffBackground in fmt^.UsedFormattingFields) then begin
+    Result := Format('%s; Bg %s', [GetColorName(fmt^.Background.BgColor)]);
+    Result := Format('%s; Fg %s', [GetColorName(fmt^.Background.FgColor)]);
+    Result := Format('%s; Pattern %s', [GetEnumName(TypeInfo(TsFillStyle), ord(fmt^.Background.Style))]);
+  end;
+  if (uffHorAlign in fmt^.UsedFormattingfields) then
+    Result := Format('%s; %s', [Result, GetEnumName(TypeInfo(TsHorAlignment), ord(fmt^.HorAlignment))]);
+  if (uffVertAlign in fmt^.UsedFormattingFields) then
+    Result := Format('%s; %s', [Result, GetEnumName(TypeInfo(TsVertAlignment), ord(fmt^.VertAlignment))]);
+  if (uffWordwrap in fmt^.UsedFormattingFields) then
+    Result := Format('%s; Word-wrap', [Result]);
+  if (uffNumberFormat in fmt^.UsedFormattingFields) then
+    Result := Format('%s; %s (%s)', [Result,
+        GetEnumName(TypeInfo(TsNumberFormat), ord(fmt^.NumberFormat)),
+        fmt^.NumberFormatStr
+      ]);
+  if (uffBorder in fmt^.UsedFormattingFields) then
+  begin
+    s := '';
+    for cb in fmt^.Border do
+      if s = '' then s := GetEnumName(TypeInfo(TsCellBorder), ord(cb))
+        else s := s + '+' + GetEnumName(TypeInfo(TsCellBorder), ord(cb));
+    Result := Format('%s; %s', [Result, s]);
+  end;
+  if Result <> '' then Delete(Result, 1, 2);
+end;
+
 {@@ ----------------------------------------------------------------------------
   Returns the count of format records used all over the workbook
 -------------------------------------------------------------------------------}
@@ -7152,6 +7202,24 @@ begin
   FBuiltinFontCount := 0;
 end;
 
+{@@ ----------------------------------------------------------------------------
+  Replaces the built-in font at a specific index with different font parameters
+-------------------------------------------------------------------------------}
+procedure TsWorkbook.ReplaceFont(AFontIndex: Integer; AFontName: String;
+  ASize: Single; AStyle: TsFontStyles; AColor: TsColor);
+var
+  fnt: TsFont;
+begin
+  if (AFontIndex < FBuiltinFontCount) and (AFontIndex <> 4) then
+  begin
+    fnt := TsFont(FFontList[AFontIndex]);
+    fnt.FontName := AFontName;
+    fnt.Size := ASize;
+    fnt.Style := AStyle;
+    fnt.Color := AColor;
+  end;
+end;
+
 {@@ ----------------------------------------------------------------------------
   Defines the default font. This is the font with index 0 in the FontList.
   The next built-in fonts will have the same font name and size
@@ -7214,7 +7282,7 @@ var
 begin
   fnt := GetFont(AIndex);
   if fnt <> nil then begin
-    Result := Format('%s; size %.1f; color %s', [
+    Result := Format('%s; size %.1g; %s', [
       fnt.FontName, fnt.Size, GetColorName(fnt.Color)]);
     if (fssBold in fnt.Style) then Result := Result + '; bold';
     if (fssItalic in fnt.Style) then Result := Result + '; italic';

components/fpspreadsheet/fpspreadsheetctrls.pas

@@ -2563,33 +2563,37 @@ begin
   else
     InitFormatRecord(fmt);
 
+  if (ACell = nil)
+    then AStrings.Add('FormatIndex=(default)')
+    else AStrings.Add(Format('FormatIndex=%d', [ACell^.FormatIndex]));
+
   if (ACell = nil) or not (uffFont in fmt.UsedFormattingFields)
-    then AStrings.Add('FontIndex=')
+    then AStrings.Add('FontIndex=(default)')
     else AStrings.Add(Format('FontIndex=%d (%s)', [
            fmt.FontIndex,
            Workbook.GetFontAsString(fmt.FontIndex)
          ]));
 
   if (ACell=nil) or not (uffTextRotation in fmt.UsedFormattingFields)
-    then AStrings.Add('TextRotation=')
+    then AStrings.Add('TextRotation=(default)')
     else AStrings.Add(Format('TextRotation=%s', [
            GetEnumName(TypeInfo(TsTextRotation), ord(fmt.TextRotation))
          ]));
 
   if (ACell=nil) or not (uffHorAlign in fmt.UsedFormattingFields)
-    then AStrings.Add('HorAlignment=')
+    then AStrings.Add('HorAlignment=(default)')
     else AStrings.Add(Format('HorAlignment=%s', [
            GetEnumName(TypeInfo(TsHorAlignment), ord(fmt.HorAlignment))
          ]));
 
   if (ACell=nil) or not (uffVertAlign in fmt.UsedFormattingFields)
-    then AStrings.Add('VertAlignment=')
+    then AStrings.Add('VertAlignment=(default)')
     else AStrings.Add(Format('VertAlignment=%s', [
            GetEnumName(TypeInfo(TsVertAlignment), ord(fmt.VertAlignment))
          ]));
 
   if (ACell=nil) or not (uffBorder in fmt.UsedFormattingFields) then
-    AStrings.Add('Borders=')
+    AStrings.Add('Borders=(none)')
   else
   begin
     s := '';
@@ -2602,7 +2606,7 @@ begin
 
   for cb in TsCellBorder do
     if ACell = nil then
-      AStrings.Add(Format('BorderStyles[%s]=', [
+      AStrings.Add(Format('BorderStyles[%s]=(default)', [
         GetEnumName(TypeInfo(TsCellBorder), ord(cb))]))
     else
       AStrings.Add(Format('BorderStyles[%s]=%s, %s', [
@@ -2612,9 +2616,9 @@ begin
 
   if (ACell = nil) or not (uffBackground in fmt.UsedformattingFields) then
   begin
-    AStrings.Add('Style=');
+    AStrings.Add('Style=(default)');
-    AStrings.Add('PatternColor=');
+    AStrings.Add('PatternColor=(default)');
-    AStrings.Add('BackgroundColor=');
+    AStrings.Add('BackgroundColor=(default)');
   end else
   begin
     AStrings.Add(Format('Style=%s', [
@@ -2627,8 +2631,8 @@ begin
 
   if (ACell = nil) or not (uffNumberFormat in fmt.UsedFormattingFields) then
   begin
-    AStrings.Add('NumberFormat=');
+    AStrings.Add('NumberFormat=(default)');
-    AStrings.Add('NumberFormatStr=');
+    AStrings.Add('NumberFormatStr=(none)');
   end else
   begin
     AStrings.Add(Format('NumberFormat=%s', [
@@ -2637,7 +2641,7 @@ begin
   end;
 
   if (Worksheet = nil) or not Worksheet.IsMerged(ACell) then
-    AStrings.Add('Merged range=')
+    AStrings.Add('Merged range=(none)')
   else
   begin
     Worksheet.FindMergedRange(ACell, r1, c1, r2, c2);
@@ -2793,6 +2797,12 @@ begin
     AStrings.Add('  PosCurrencyFormat='+IntToStr(AWorkbook.FormatSettings.CurrencyFormat));
     AStrings.Add('  NegCurrencyFormat='+IntToStr(AWorkbook.FormatSettings.NegCurrFormat));
     AStrings.Add('  TwoDigitYearCenturyWindow='+IntToStr(AWorkbook.FormatSettings.TwoDigitYearCenturyWindow));
+
+    for i:=0 to AWorkbook.GetFontCount-1 do
+      AStrings.Add(Format('Font%d=%s', [i, AWorkbook.GetFontAsString(i)]));
+
+    for i:=0 to AWorkbook.GetNumCellFormats-1 do
+      AStrings.Add(Format('CellFormat%d=%s', [i, AWorkbook.GetCellFormatAsString(i)]));
   end;
 end;