From 632b9d62009821a44073f9a236fcd54f8a3a467a Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Tue, 27 May 2014 13:09:23 +0000 Subject: [PATCH] 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 | 120 +++++++++++++++++-- components/fpspreadsheet/fpspreadsheet.pas | 28 +++++ components/fpspreadsheet/fpsutils.pas | 15 +++ 3 files changed, 156 insertions(+), 7 deletions(-) diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index fbc0eaa91..c70c49520 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/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); diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 240da2051..ad623703c 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/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). diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index 7cee8c2a6..de96068c7 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/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.