From 9505aeb4850a44684c9ec24f20c4ac9b80dea301 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Wed, 29 Jul 2015 22:54:34 +0000 Subject: [PATCH] fpspreadsheet: Add style section to written html file. Fix some issues of rich-text formatting when writing html. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4222 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/fpspreadsheet/fpshtml.pas | 179 +++++++++++++++----- components/fpspreadsheet/fpsvisualutils.pas | 2 +- 2 files changed, 141 insertions(+), 40 deletions(-) diff --git a/components/fpspreadsheet/fpshtml.pas b/components/fpspreadsheet/fpshtml.pas index 4fe687326..98200956f 100644 --- a/components/fpspreadsheet/fpshtml.pas +++ b/components/fpspreadsheet/fpshtml.pas @@ -35,9 +35,12 @@ type (* TsHTMLWriter = class(TsCustomSpreadWriter) private FPointSeparatorSettings: TFormatSettings; +// function CellFormatAsString(ACell: PCell; ForThisTag: String): String; + function CellFormatAsString(AFormat: PsCellFormat; ATagName: String): String; function GetBackgroundAsStyle(AFill: TsFillPattern): String; function GetBorderAsStyle(ABorder: TsCellBorders; const ABorderStyles: TsCellBorderStyles): String; function GetColWidthAsAttr(AColIndex: Integer): String; + function GetDefaultHorAlignAsStyle(ACell: PCell): String; function GetFontAsStyle(AFontIndex: Integer): String; function GetGridBorderAsStyle: String; function GetHorAlignAsStyle(AHorAlign: TsHorAlignment): String; @@ -48,10 +51,10 @@ type (* function GetWordWrapAsStyle(AWordWrap: Boolean): String; function IsHyperlinkTarget(ACell: PCell; out ABookmark: String): Boolean; procedure WriteBody(AStream: TStream); + procedure WriteStyles(AStream: TStream); procedure WriteWorksheet(AStream: TStream; ASheet: TsWorksheet); protected - function CellFormatAsString(ACell: PCell; ForThisTag: String): String; procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal; ACell: PCell); override; procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal; @@ -92,7 +95,7 @@ var implementation uses - LazUTF8, URIParser, Math, + LazUTF8, URIParser, Math, StrUtils, fpsUtils; constructor TsHTMLWriter.Create(AWorkbook: TsWorkbook); @@ -111,7 +114,7 @@ destructor TsHTMLWriter.Destroy; begin inherited Destroy; end; - + (* function TsHTMLWriter.CellFormatAsString(ACell: PCell; ForThisTag: String): String; var fmt: PsCellFormat; @@ -130,6 +133,21 @@ begin Result := Result + GetGridBorderAsStyle; end else begin + if (uffBackground in fmt^.UsedFormattingFields) then + Result := Result + GetBackgroundAsStyle(fmt^.Background); + if (uffFont in fmt^.UsedFormattingFields) then + Result := Result + GetFontAsStyle(fmt^.FontIndex); + if (uffTextRotation in fmt^.UsedFormattingFields) then + Result := Result + GetTextRotationAsStyle(fmt^.TextRotation); + if (uffHorAlign in fmt^.UsedFormattingFields) and (fmt^.HorAlignment <> haDefault) then + Result := Result + GetHorAlignAsStyle(fmt^.HorAlignment) + else + case ACell^.ContentType of + cctNumber : Result := Result + GetHorAlignAsStyle(haRight); + cctDateTime : Result := Result + GetHorAlignAsStyle(haLeft); + cctBool : Result := Result + GetHorAlignAsStyle(haCenter); + else Result := Result + GetHorAlignAsStyle(haLeft); + end; if (uffVertAlign in fmt^.UsedFormattingFields) then Result := Result + GetVertAlignAsStyle(fmt^.VertAlignment); if (uffBorder in fmt^.UsedFormattingFields) then @@ -138,17 +156,17 @@ begin if soShowGridLines in FWorksheet.Options then Result := Result + GetGridBorderAsStyle; end; - if (uffBackground in fmt^.UsedFormattingFields) then - Result := Result + GetBackgroundAsStyle(fmt^.Background); if (uffFont in fmt^.UsedFormattingFields) then - Result := Result + GetFontAsStyle(fmt^.FontIndex); + Result := Result + GetFontAsStyle(fmt^.FontIndex); { if (uffTextRotation in fmt^.UsedFormattingFields) then - Result := Result + GetTextRotationAsStyle(fmt^.TextRotation); + Result := Result + GetTextRotation(fmt^.TextRotation);} + Result := Result + GetWordwrapAsStyle(uffWordwrap in fmt^.UsedFormattingFields); end; 'div', 'p': begin if fmt = nil then exit; + { if (uffHorAlign in fmt^.UsedFormattingFields) and (fmt^.HorAlignment <> haDefault) then Result := Result + GetHorAlignAsStyle(fmt^.HorAlignment) else @@ -163,11 +181,43 @@ begin if (uffTextRotation in fmt^.UsedFormattingFields) then Result := Result + GetTextRotation(fmt^.TextRotation);} Result := Result + GetWordwrapAsStyle(uffWordwrap in fmt^.UsedFormattingFields); + } end; end; if Result <> '' then Result := ' style="' + Result +'"'; end; + *) +function TsHTMLWriter.CellFormatAsString(AFormat: PsCellFormat; ATagName: String): String; +begin + Result := ''; + + if (uffBackground in AFormat^.UsedFormattingFields) then + Result := Result + GetBackgroundAsStyle(AFormat^.Background); + + if (uffFont in AFormat^.UsedFormattingFields) then + Result := Result + GetFontAsStyle(AFormat^.FontIndex); + + if (uffTextRotation in AFormat^.UsedFormattingFields) then + Result := Result + GetTextRotationAsStyle(AFormat^.TextRotation); + + if (uffHorAlign in AFormat^.UsedFormattingFields) and (AFormat^.HorAlignment <> haDefault) then + Result := Result + GetHorAlignAsStyle(AFormat^.HorAlignment); + + if (uffVertAlign in AFormat^.UsedFormattingFields) then + Result := Result + GetVertAlignAsStyle(AFormat^.VertAlignment); + + if (uffBorder in AFormat^.UsedFormattingFields) then + Result := Result + GetBorderAsStyle(AFormat^.Border, AFormat^.BorderStyles); + { + else begin + if soShowGridLines in FWorksheet.Options then + Result := Result + GetGridBorderAsStyle; + end; + } + + Result := Result + GetWordwrapAsStyle(uffWordwrap in AFormat^.UsedFormattingFields); +end; function TsHTMLWriter.GetBackgroundAsStyle(AFill: TsFillPattern): String; begin @@ -261,6 +311,18 @@ begin Result:= Format(' width="%.1fpt"', [w], FPointSeparatorSettings); end; +function TsHTMLWriter.GetDefaultHorAlignAsStyle(ACell: PCell): String; +begin + Result := ''; + if ACell = nil then + exit; + case ACell^.ContentType of + cctNumber : Result := GetHorAlignAsStyle(haRight); + cctDateTime: Result := GetHorAlignAsStyle(haRight); + cctBool : Result := GetHorAlignAsStyle(haCenter); + end; +end; + function TsHTMLWriter.GetFontAsStyle(AFontIndex: Integer): String; var font: TsFont; @@ -284,7 +346,10 @@ end; function TsHTMLWriter.GetGridBorderAsStyle: String; begin - Result := 'border:1px solid lightgrey;'; + if (soShowGridLines in FWorksheet.Options) then + Result := 'border:1px solid lightgrey;' + else + Result := ''; end; function TsHTMLWriter.GetHorAlignAsStyle(AHorAlign: TsHorAlignment): String; @@ -352,7 +417,7 @@ begin if AWordwrap then Result := 'word-wrap:break-word;' else - Result := 'white-space:nowrap'; + Result := 'white-space:nowrap;'; end; function TsHTMLWriter.IsHyperlinkTarget(ACell: PCell; out ABookmark: String): Boolean; @@ -418,43 +483,32 @@ end; { Write boolean cell to stream formatted as string } procedure TsHTMLWriter.WriteBool(AStream: TStream; const ARow, ACol: Cardinal; const AValue: Boolean; ACell: PCell); -var - s: String; - style: String; begin Unused(AStream); Unused(ARow, ACol, ACell); - if AValue then - s := HTMLParams.TrueText - else - s := HTMLParams.FalseText; AppendToStream(AStream, - '' + s + ''); + '
' + IfThen(AValue, HTMLParams.TrueText, HTMLParams.FalseText) + '
'); end; { Write date/time values in the same way they are displayed in the sheet } procedure TsHTMLWriter.WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); var - style: String; s: String; begin - style := CellFormatAsString(ACell, 'div'); s := FWorksheet.ReadAsUTF8Text(ACell); AppendToStream(AStream, - '' + s + ''); + '
' + s + '
'); end; procedure TsHTMLWriter.WriteError(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TsErrorValue; ACell: PCell); var - style: String; s: String; begin - style := CellFormatAsString(ACell, 'div'); s := FWOrksheet.ReadAsUTF8Text(ACell); AppendToStream(AStream, - '' + s + ''); + '
' + s + '
'); end; { HTML does not support formulas, but we can write the formula results to @@ -496,7 +550,8 @@ begin if txt = '' then exit; - style := CellFormatAsString(ACell, 'div'); + style := ''; //CellFormatAsString(ACell, 'div'); + cellfnt := FWorksheet.ReadCellFont(ACell); // Hyperlink target := ''; @@ -532,18 +587,21 @@ begin begin // Standard text formatting ValidXMLText(txt); - if target <> '' then txt := Format('%s', [target, txt]); + if target <> '' then + txt := Format('%s', [target, txt]); + if cellFnt.Position <> fpNormal then + txt := Format('<%0:s>%1:s', [ESCAPEMENT_TAG[cellFnt.Position], txt]); AppendToStream(AStream, '' + txt + '') end else begin - // "Rich-text" formatting - cellfnt := FWorksheet.ReadCellFont(ACell); + // "Rich-text" formatted string len := UTF8Length(AValue); textp := ''; if target <> '' then textp := textp + ''; rtParam := ACell^.RichTextParams[0]; + // Part before first formatted section (has cell fnt) if rtParam.StartIndex > 0 then begin txt := UTF8Copy(AValue, 1, rtParam.StartIndex); @@ -554,6 +612,7 @@ begin end; for i := 0 to High(ACell^.RichTextParams) do begin + // formatted section rtParam := ACell^.RichTextParams[i]; fnt := FWorkbook.GetFont(rtParam.FontIndex); style := GetFontAsStyle(rtParam.FontIndex); @@ -565,17 +624,23 @@ begin if fnt.Position <> fpNormal then txt := Format('<%0:s>%1:s', [ESCAPEMENT_TAG[fnt.Position], txt]); textp := textp + '' + txt + ''; + // unformatted section before end if (rtParam.EndIndex < len) and (i = High(ACell^.RichTextParams)) then begin txt := UTF8Copy(AValue, rtParam.EndIndex+1, MaxInt); ValidXMLText(txt); + if cellFnt.Position <> fpNormal then + txt := Format('<%0:s>%1:s', [ESCAPEMENT_TAG[cellFnt.Position], txt]); textp := textp + txt; end else + // unformatted section between two formatted sections if (i < High(ACell^.RichTextParams)) and (rtParam.EndIndex < ACell^.RichTextParams[i+1].StartIndex) then begin n := ACell^.RichTextParams[i+1].StartIndex - rtParam.EndIndex; txt := UTF8Copy(AValue, rtParam.EndIndex+1, n); ValidXMLText(txt); + if cellFnt.Position <> fpNormal then + txt := Format('<%0:s>%1:s', [ESCAPEMENT_TAG[cellFnt.Position], txt]); textp := textp + txt; end; end; @@ -591,15 +656,11 @@ procedure TsHTMLWriter.WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double; ACell: PCell); var s: String; - style: String; begin Unused(ARow, ACol); - - style := CellFormatAsString(ACell, 'div'); - s := FWorksheet.ReadAsUTF8Text(ACell, FWorkbook.FormatSettings); AppendToStream(AStream, - '' + s + ''); + '
' + s + '
'); end; procedure TsHTMLWriter.WriteToStream(AStream: TStream); @@ -609,13 +670,34 @@ begin '' + '' + ''+ - '' + + ''); + WriteStyles(AStream); + AppendToStream(AStream, ''); WriteBody(AStream); AppendToStream(AStream, ''); end; +procedure TsHTMLWriter.WriteStyles(AStream: TStream); +var + i: Integer; + fmt: PsCellFormat; + fmtStr: String; +begin + AppendToStream(AStream, + ''); +end; + procedure TsHTMLWriter.WriteToStrings(AStrings: TStrings); var Stream: TStream; @@ -634,13 +716,11 @@ procedure TsHTMLWriter.WriteWorksheet(AStream: TStream; ASheet: TsWorksheet); var r, rFirst, rLast: Cardinal; c, cFirst, cLast: Cardinal; - txt: String; cell: PCell; - style: String; + style, s: String; fixedLayout: Boolean; col: PCol; - row: PRow; - w, h: Single; + fmt: PsCellFormat; begin FWorksheet := ASheet; @@ -721,8 +801,29 @@ begin // Pointer to current cell in loop cell := FWorksheet.FindCell(r, c); - // Cell formatting - style := CellFormatAsString(cell, 'td'); // this contains the 'style="..."' + // Cell formatting via predefined styles ("class") + style := ''; + fmt := nil; + if cell <> nil then + begin + style := Format(' class="style%d"', [cell^.FormatIndex+1]); + fmt := FWorkbook.GetPointerToCellFormat(cell^.FormatIndex); + end; + + // Overriding differences between html and fps formatting + s := ''; + if (fmt = nil) then + s := s + GetGridBorderAsStyle + else begin + if ((not (uffBorder in fmt^.UsedFormattingFields)) or (fmt^.Border = [])) then + s := s + GetGridBorderAsStyle; + if ((not (uffHorAlign in fmt^.UsedFormattingFields)) or (fmt^.HorAlignment = haDefault)) then + s := s + GetDefaultHorAlignAsStyle(cell); + if ((not (uffVertAlign in fmt^.UsedFormattingFields)) or (fmt^.VertAlignment = vaDefault)) then + s := s + GetVertAlignAsStyle(vaBottom); + end; + if s <> '' then + style := style + ' style="' + s + '"'; if not HTMLParams.ShowRowColHeaders then begin diff --git a/components/fpspreadsheet/fpsvisualutils.pas b/components/fpspreadsheet/fpsvisualutils.pas index 17cd06185..4c52719ff 100644 --- a/components/fpspreadsheet/fpsvisualutils.pas +++ b/components/fpspreadsheet/fpsvisualutils.pas @@ -41,7 +41,7 @@ uses const {@@ Font size factor for sub-/superscript characters } - SUBSCRIPT_SUPERSCRIPT_FACTOR = 0.6; + SUBSCRIPT_SUPERSCRIPT_FACTOR = 0.66; {@@ ---------------------------------------------------------------------------- Converts a spreadsheet font to a font used for painting (TCanvas.Font).