fpspreadsheet: Add ods reading support for cell borders, border line styles and border colors. Borders of ods files are displayed in fpsgrid correctly.

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

components/fpspreadsheet/fpsopendocument.pas

@@ -74,6 +74,7 @@ type
     procedure ReadNumFormats(AStylesNode: TDOMNode);
     procedure ReadStyles(AStylesNode: TDOMNode);
     { Record writing methods }
+    procedure ReadBlank(ARow, ACol: Word; ACellNode: TDOMNode);
     procedure ReadFormula(ARow : Word; ACol : Word; ACellNode: TDOMNode);
     procedure ReadLabel(ARow : Word; ACol : Word; ACellNode: TDOMNode);
     procedure ReadNumber(ARow : Word; ACol : Word; ACellNode: TDOMNode);
@@ -332,6 +333,16 @@ begin
   end;
 end;
 
+procedure TsSpreadOpenDocReader.ReadBlank(ARow, ACol: Word; ACellNode: TDOMNode);
+var
+  styleName: String;
+begin
+  FWorkSheet.WriteBlank(ARow, ACol);
+
+  styleName := GetAttrValue(ACellNode, 'table:style-name');
+  ApplyStyleToCell(ARow, ACol, stylename);
+end;
+
 procedure TsSpreadOpenDocReader.ReadDateMode(SpreadSheetNode: TDOMNode);
 var
   CalcSettingsNode, NullDateNode: TDOMNode;
@@ -433,6 +444,8 @@ begin
             ReadNumber(Row, Col, CellNode)
           else if (ParamValueType = 'date') or (ParamValueType = 'time') then
             ReadDate(Row, Col, CellNode)
+          else if (ParamValueType = '') then
+            ReadBlank(Row, Col, CellNode)
           else if ParamFormula <> '' then
             ReadLabel(Row, Col, CellNode);
 
@@ -464,9 +477,14 @@ begin
   ReadNumber(ARow, ACol, ACellNode);
 end;
 
-procedure TsSpreadOpenDocReader.ReadLabel(ARow: Word; ACol : Word; ACellNode : TDOMNode);
+procedure TsSpreadOpenDocReader.ReadLabel(ARow: Word; ACol: Word; ACellNode: TDOMNode);
+var
+  styleName: String;
 begin
-  FWorkSheet.WriteUTF8Text(ARow,ACol,UTF8Encode(ACellNode.TextContent));
+  FWorkSheet.WriteUTF8Text(ARow, ACol, UTF8Encode(ACellNode.TextContent));
+
+  styleName := GetAttrValue(ACellNode, 'table:style-name');
+  ApplyStyleToCell(ARow, ACol, stylename);
 end;
 
 procedure TsSpreadOpenDocReader.ReadNumber(ARow: Word; ACol : Word; ACellNode : TDOMNode);
@@ -728,6 +746,7 @@ end;
 
 procedure TsSpreadOpenDocReader.ReadStyles(AStylesNode: TDOMNode);
 var
+  fs: TFormatSettings;
   style: TStyleData;
   styleNode: TDOMNode;
   styleChildNode: TDOMNode;
@@ -739,11 +758,78 @@ var
   numFmtIndexDefault: Integer;
   wrap: Boolean;
   borders: TsCellBorders;
+  borderStyles: TsCellBorderStyles;
   s: String;
+
+  procedure SetBorderStyle(ABorder: TsCellBorder; AStyleValue: String);
+  var
+    L: TStringList;
+    i: Integer;
+    isSolid: boolean;
+    s: String;
+    wid: Double;
+    linestyle: String;
+    rgb: DWord;
+    p: Integer;
+  begin
+    L := TStringList.Create;
+    try
+      L.Delimiter := ' ';
+      L.StrictDelimiter := true;
+      L.DelimitedText := AStyleValue;
+      wid := 0;
+      rgb := 0;
+      linestyle := '';
+      for i:=0 to L.Count-1 do begin
+        s := L[i];
+        if (s = 'solid') or (s = 'dashed') or (s = 'fine-dashed') or (s = 'dotted')
+          then linestyle := s;
+        if s[1] = '#' then begin
+          s[1] := '$';
+          rgb := StrToInt(s);
+        end;
+        p := pos('pt', s);
+        if p = Length(s)-1 then begin
+          wid := StrToFloat(copy(s, 1, p-1), fs);
+          continue;
+        end;
+        p := pos('mm', s);
+        if p = Length(s)-1 then begin
+          wid := mmToPts(StrToFloat(copy(s, 1, p-1), fs));
+          Continue;
+        end;
+        p := pos('cm', s);
+        if p = Length(s)-1 then begin
+          wid := cmToPts(StrToFloat(copy(s, 1, p-1), fs));
+          Continue;
+        end;
+      end;
+      borderStyles[ABorder].LineStyle := lsThin;
+      if (linestyle = 'solid') then begin
+        if (wid >= 2) then borderStyles[ABorder].LineStyle := lsThick
+        else if (wid >= 1) then borderStyles[ABorder].LineStyle := lsMedium
+      end else
+      if (linestyle = 'dotted') then
+        borderStyles[ABorder].LineStyle := lsHair
+      else
+      if (linestyle = 'dashed') then
+        borderStyles[ABorder].LineStyle := lsDashed
+      else
+      if (linestyle = 'fine-dashed') then
+        borderStyles[ABorder].LineStyle := lsDotted;
+      borderStyles[ABorder].Color := Workbook.AddColorToPalette(LongRGBToExcelPhysical(rgb));
+    finally
+      L.Free;
+    end;
+  end;
+
 begin
   if not Assigned(AStylesNode) then
     exit;
 
+  fs := DefaultFormatSettings;
+  fs.DecimalSeparator := '.';
+
   numFmtIndexDefault := NumFormatList.FindByName('N0');
 
   styleNode := AStylesNode.FirstChild;
@@ -764,14 +850,34 @@ begin
         while Assigned(styleChildNode) do begin
           if styleChildNode.NodeName = 'style:table-cell-properties' then begin
             // Borders
+            s := GetAttrValue(styleChildNode, 'fo:border');
+            if (s <>'') then begin
+              borders := borders + [cbNorth, cbSouth, cbEast, cbWest];
+              SetBorderStyle(cbNorth, s);
+              SetBorderStyle(cbSouth, s);
+              SetBorderStyle(cbEast, s);
+              SetBorderStyle(cbWest, s);
+            end;
             s := GetAttrValue(styleChildNode, 'fo:border-top');
-            if (s <> '') and (s <> 'none') then Include(borders, cbNorth);
+            if (s <> '') and (s <> 'none') then begin
+              Include(borders, cbNorth);
+              SetBorderStyle(cbNorth, s);
+            end;
             s := GetAttrValue(styleChildNode, 'fo:border-right');
-            if (s <> '') and (s <> 'none') then Include(borders, cbEast);
+            if (s <> '') and (s <> 'none') then begin
+              Include(borders, cbEast);
+              SetBorderStyle(cbEast, s);
+            end;
             s := GetAttrValue(styleChildNode, 'fo:border-bottom');
-            if (s <> '') and (s <> 'none') then Include(borders, cbSouth);
+            if (s <> '') and (s <> 'none') then begin
+              Include(borders, cbSouth);
+              SetBorderStyle(cbSouth, s);
+            end;
             s := GetAttrValue(styleChildNode, 'fo:border-left');
-            if (s <> '') and (s <> 'none') then Include(borders, cbWest);
+            if (s <> '') and (s <> 'none') then begin
+              Include(borders, cbWest);
+              SetBorderStyle(cbWest, s);
+            end;
 
             // Text wrap
             s := GetAttrValue(styleChildNode, 'fo:wrap-option');
@@ -792,7 +898,7 @@ begin
         style.WordWrap := wrap;
         style.TextRotation := trHorizontal;
         style.Borders := borders;
-        style.BorderStyles := DEFAULT_BORDERSTYLES;
+        style.BorderStyles := borderStyles;
         style.BackgroundColor := scNotDefined;
 
         styleIndex := FStyleList.Add(style);

components/fpspreadsheet/fpspreadsheet.pas

@@ -550,6 +550,7 @@ type
     procedure RemoveAllFonts;
     procedure SetDefaultFont(const AFontName: String; ASize: Single);
     { Color handling }
+    function AddColorToPalette(AColorValue: TsColorValue): TsColor;
     function FPSColorToHexString(AColor: TsColor; ARGBColor: TFPColor): String;
     function GetColorName(AColorIndex: TsColor): string;
     function GetPaletteColor(AColorIndex: TsColor): TsColorValue;
@@ -2831,6 +2832,33 @@ begin
   Result := FFontList.Count;
 end;
 
+{@@
+  Adds a color to the palette and returns its palette index, but only if the
+  color does not already exist - in this case, it returns the index of the
+  existing color entry. }
+function TsWorkbook.AddColorToPalette(AColorValue: TsColorValue): TsColor;
+var
+  i: Integer;
+begin
+  // No palette yet? Add the 16 first entries of the default_palette. They are
+  // common to all palettes
+  if Length(FPalette) = 0 then begin
+    SetLength(FPalette, 16);
+    for i := 0 to 15 do
+      FPalette[i] := DEFAULT_PALETTE[i];
+  end;
+
+  // Now look for the color. Is already in the existing palette?
+  for Result := 0 to Length(FPalette)-1 do
+    if FPalette[Result] = AColorValue then
+      exit;
+
+  // No. Add it to the palette.
+  Result := Length(FPalette);
+  SetLength(FPalette, Result+1);
+  FPalette[Result] := AColorValue;
+end;
+
 {@@
   Converts a fpspreadsheet color into into a string RRGGBB.
   Note that colors are written to xls files as ABGR (where A is 0).

components/fpspreadsheet/fpsutils.pas

@@ -102,6 +102,9 @@ function FormatDateTime(const FormatStr: string; DateTime: TDateTime;
 function FormatDateTime(const FormatStr: string; DateTime: TDateTime;
   const FormatSettings: TFormatSettings; Options : TFormatDateTimeOptions = []): string;
 
+function cmToPts(AValue: Double): Double;
+function mmToPts(AValue: Double): Double;
+
 implementation
 
 uses
@@ -1290,5 +1293,17 @@ begin
   DateTimeToString(Result, FormatStr, DateTime, FormatSettings,Options);
 end;
 
+{ Converts centimeters to points (72 pts = 1 inch) }
+function cmToPts(AValue: Double): Double;
+begin
+  Result := AValue/(2.54*72);
+end;
+
+{ Converts millimeters to points (72 pts = 1 inch) }
+function mmToPts(AValue: Double): Double;
+begin
+  Result := AValue/(25.4*72);
+end;
+
 end.