From 4f741ca06dffce484098f7560e3f49a96f290e6b Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Wed, 12 Aug 2015 20:07:24 +0000 Subject: [PATCH] fpspreadsheet: Add new worksheet method "WriteTextAsHTML" which can contain embedded html codes translated to "rich-text" sections. The method for normal text, "WriteUTF8Text", has been renamed to "WriteText"; the old one is deprecated. Same with "ReadAsUTF8Text" (which is now "ReadText"). git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4267 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../read_write/excel8demo/excel8read.lpr | 2 +- .../read_write/excel8demo/excel8write.lpr | 125 ++++--- components/fpspreadsheet/fpshtml.pas | 2 - components/fpspreadsheet/fpshtmlutils.pas | 347 +++++++++++++++++- components/fpspreadsheet/fpspreadsheet.pas | 135 ++++++- 5 files changed, 524 insertions(+), 87 deletions(-) diff --git a/components/fpspreadsheet/examples/read_write/excel8demo/excel8read.lpr b/components/fpspreadsheet/examples/read_write/excel8demo/excel8read.lpr index 294677bf4..66df1d5df 100644 --- a/components/fpspreadsheet/examples/read_write/excel8demo/excel8read.lpr +++ b/components/fpspreadsheet/examples/read_write/excel8demo/excel8read.lpr @@ -50,7 +50,7 @@ begin begin Write('Row: ', CurCell^.Row, ' Col: ', CurCell^.Col, ' Value: ', - UTF8ToConsole(MyWorkSheet.ReadAsUTF8Text(CurCell^.Row, + UTF8ToConsole(MyWorkSheet.ReadAsText(CurCell^.Row, CurCell^.Col)) ); if HasFormula(CurCell) then diff --git a/components/fpspreadsheet/examples/read_write/excel8demo/excel8write.lpr b/components/fpspreadsheet/examples/read_write/excel8demo/excel8write.lpr index 2a2ab14ec..6ff79e30a 100644 --- a/components/fpspreadsheet/examples/read_write/excel8demo/excel8write.lpr +++ b/components/fpspreadsheet/examples/read_write/excel8demo/excel8write.lpr @@ -19,7 +19,6 @@ const Str_Fourth = 'Fourth'; Str_Worksheet1 = 'Meu Relatório'; Str_Worksheet2 = 'My Worksheet 2'; - Str_Total = 'Total:'; var MyWorkbook: TsWorkbook; MyWorksheet: TsWorksheet; @@ -58,9 +57,13 @@ begin MyWorksheet.WriteNumber(0, 1, 2.0); // B1 MyWorksheet.WriteNumber(0, 2, 3.0); // C1 MyWorksheet.WriteNumber(0, 3, 4.0); // D1 - MyWorksheet.WriteUTF8Text(4, 2, Str_Total);// C5 + MyWorksheet.WriteText (4, 2, 'Total'); // C5 MyWorksheet.WriteNumber(4, 3, 10); // D5 + MyWorksheet.WriteTextAsHTML(2, 0, 'H2O'); + MyWorksheet.WriteTextAsHTML(3, 0, 'red, yellow, green'); + MyWorksheet.WriteTextAsHTML(4, 0, 'sin2 α + cos2 β = 1'); + // D6 number with background color MyWorksheet.WriteNumber(5, 3, 10); lCell := MyWorksheet.GetCell(5, 3); @@ -82,7 +85,7 @@ begin // F7, top border only, but different color MyWorksheet.WriteBorders(6, 5, [cbNorth]); MyWorksheet.WriteBorderColor(6, 5, cbNorth, scGreen); - MyWorksheet.WriteUTF8Text(6, 5, 'top border green or red?'); + MyWorksheet.WriteText(6, 5, 'top border green or red?'); // Excel shows it to be red --> the upper border wins // H6 empty cell, all medium borders @@ -122,15 +125,15 @@ begin MyWorksheet.WriteBorderLineStyle(5, 14, cbWest, lsDouble); // Word-wrapped long text in D7 - MyWorksheet.WriteUTF8Text(6, 3, 'This is a very, very, very, very long wrapped text.'); + MyWorksheet.WriteText(6, 3, 'This is a very, very, very, very long wrapped text.'); MyWorksheet.WriteUsedFormatting(6, 3, [uffWordwrap]); // Cell with changed font in D8 - MyWorksheet.WriteUTF8Text(7, 3, 'This is 16pt red bold & italic Times New Roman.'); + MyWorksheet.WriteText(7, 3, 'This is 16pt red bold & italic Times New Roman.'); Myworksheet.WriteFont(7, 3, 'Times New Roman', 16, [fssBold, fssItalic], scRed); // Cell with changed font and background in D9 and comment - MyWorksheet.WriteUTF8Text(8, 3, 'Colors...'); + MyWorksheet.WriteText(8, 3, 'Colors...'); MyWorksheet.WriteFont(8, 3, 'Courier New', 12, [fssUnderline], scBlue); MyWorksheet.WriteBackgroundColor(8, 3, scYellow); // MyWorksheet.WriteComment(8, 3, 'This is font "Courier New", Size 12.'); @@ -174,46 +177,46 @@ begin nil))))); r := 10; - MyWorksheet.WriteUTF8Text(r, 0, 'Writing current date/time:'); + MyWorksheet.WriteText(r, 0, 'Writing current date/time:'); inc(r, 2); // Write current date/time to cells B11:B16 - MyWorksheet.WriteUTF8Text(r, 0, '(default format)'); + MyWorksheet.WriteText(r, 0, '(default format)'); MyWorksheet.WriteDateTime(r, 1, now); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfShortDate'); + MyWorksheet.WriteText(r, 0, 'nfShortDate'); MyWorksheet.WriteDateTime(r, 1, now, nfShortDate); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfLongDate'); + MyWorksheet.WriteText(r, 0, 'nfLongDate'); MyWorksheet.WriteDateTime(r, 1, now, nfLongDate); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfShortTime'); + MyWorksheet.WriteText(r, 0, 'nfShortTime'); MyWorksheet.WriteDateTime(r, 1, now, nfShortTime); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfLongTime'); + MyWorksheet.WriteText(r, 0, 'nfLongTime'); MyWorksheet.WriteDateTime(r, 1, now, nfLongTime); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfShortDateTime'); + MyWorksheet.WriteText(r, 0, 'nfShortDateTime'); MyWorksheet.WriteDateTime(r, 1, now, nfShortDateTime); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, ''dd/mmm'''); + MyWorksheet.WriteText(r, 0, 'nfCustom, ''dd/mmm'''); MyWorksheet.WriteDateTime(r, 1, now, nfCustom, 'dd/mmm'); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, ''MMM/YY'''); + MyWorksheet.WriteText(r, 0, 'nfCustom, ''MMM/YY'''); MyWorksheet.WriteDateTime(r, 1, now, nfCustom, 'mmm/yy'); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfShortTimeAM'); + MyWorksheet.WriteText(r, 0, 'nfShortTimeAM'); MyWorksheet.WriteDateTime(r, 1, now, nfShortTimeAM); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfLongTimeAM'); + MyWorksheet.WriteText(r, 0, 'nfLongTimeAM'); MyWorksheet.WriteDateTime(r, 1, now, nfLongTimeAM); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, ''mm:ss'''); + MyWorksheet.WriteText(r, 0, 'nfCustom, ''mm:ss'''); MyWorksheet.WriteDateTime(r, 1, now, nfCustom, 'mm:ss'); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, ''mm:ss.z'''); + MyWorksheet.WriteText(r, 0, 'nfCustom, ''mm:ss.z'''); MyWorksheet.WriteDateTime(r, 1, now, nfCustom, 'mm:ss.z'); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, ''mm:ss.zzz'''); + MyWorksheet.WriteText(r, 0, 'nfCustom, ''mm:ss.zzz'''); MyWorksheet.WriteDateTime(r, 1, now, nfCustom, 'mm:ss.zzz'); // Write formatted numbers @@ -221,88 +224,88 @@ begin val(s, number, i); inc(r, 2); - MyWorksheet.WriteUTF8Text(r, 0, 'The number '+s+' is displayed in various formats:'); + MyWorksheet.WriteText(r, 0, 'The number '+s+' is displayed in various formats:'); inc(r,2); - MyWorksheet.WriteUTF8Text(r, 0, 'nfGeneral'); + MyWorksheet.WriteText(r, 0, 'nfGeneral'); MyWorksheet.WriteNumber(r, 1, number, nfGeneral); MyWorksheet.WriteNumber(r, 2, -number, nfGeneral); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfFixed, 0 decs'); + MyWorksheet.WriteText(r, 0, 'nfFixed, 0 decs'); MyWorksheet.WriteNumber(r, 1, number, nfFixed, 0); MyWorksheet.WriteNumber(r, 2, -number, nfFixed, 0); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfFixed, 1 decs'); + MyWorksheet.WriteText(r, 0, 'nfFixed, 1 decs'); MyWorksheet.WriteNumber(r, 1, number, nfFixed, 1); MyWorksheet.WriteNumber(r, 2, -number, nfFixed, 1); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfFixed, 2 decs'); + MyWorksheet.WriteText(r, 0, 'nfFixed, 2 decs'); MyWorksheet.WriteNumber(r, 1, number, nfFixed, 2); MyWorksheet.WriteNumber(r, 2, -number, nfFixed, 2); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfFixed, 3 decs'); + MyWorksheet.WriteText(r, 0, 'nfFixed, 3 decs'); MyWorksheet.WriteNumber(r, 1, number, nfFixed, 3); MyWorksheet.WriteNumber(r, 2, -number, nfFixed, 3); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfFixedTh, 0 decs'); + MyWorksheet.WriteText(r, 0, 'nfFixedTh, 0 decs'); MyWorksheet.WriteNumber(r, 1, number, nfFixedTh, 0); MyWorksheet.WriteNumber(r, 2, -number, nfFixedTh, 0); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfFixedTh, 1 decs'); + MyWorksheet.WriteText(r, 0, 'nfFixedTh, 1 decs'); MyWorksheet.WriteNumber(r, 1, number, nfFixedTh, 1); MyWorksheet.WriteNumber(r, 2, -number, nfFixedTh, 1); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfFixedTh, 2 decs'); + MyWorksheet.WriteText(r, 0, 'nfFixedTh, 2 decs'); MyWorksheet.WriteNumber(r, 1, number, nfFixedTh, 2); MyWorksheet.WriteNumber(r, 2, -number, nfFixedTh, 2); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfFixedTh, 3 decs'); + MyWorksheet.WriteText(r, 0, 'nfFixedTh, 3 decs'); MyWorksheet.WriteNumber(r, 1, number, nfFixedTh, 3); MyWorksheet.WriteNumber(r, 2, -number, nfFixedTh, 3); inc(r,2); - MyWorksheet.WriteUTF8Text(r, 0, 'nfExp, 0 dec'); + MyWorksheet.WriteText(r, 0, 'nfExp, 0 dec'); MyWorksheet.WriteNumber(r, 1, number, nfExp, 0); MyWorksheet.WriteNumber(r, 2, -number, nfExp, 0); MyWorksheet.WriteNumber(r, 3, 1.0/number, nfExp, 0); MyWorksheet.WriteNumber(r, 4, -1.0/number, nfExp, 0); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfExp, 1 dec'); + MyWorksheet.WriteText(r, 0, 'nfExp, 1 dec'); MyWorksheet.WriteNumber(r, 1, number, nfExp, 1); MyWorksheet.WriteNumber(r, 2, -number, nfExp, 1); MyWorksheet.WriteNumber(r, 3, 1.0/number, nfExp, 1); MyWorksheet.WriteNumber(r, 4, -1.0/number, nfExp, 1); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfExp, 2 decs'); + MyWorksheet.WriteText(r, 0, 'nfExp, 2 decs'); MyWorksheet.WriteNumber(r, 1, number, nfExp, 2); MyWorksheet.WriteNumber(r, 2, -number, nfExp, 2); MyWorksheet.WriteNumber(r, 3, 1.0/number, nfExp, 2); MyWorksheet.WriteNumber(r, 4, -1.0/number, nfExp, 2); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfExp, 3 decs'); + MyWorksheet.WriteText(r, 0, 'nfExp, 3 decs'); MyWorksheet.WriteNumber(r, 1, number, nfExp, 3); MyWorksheet.WriteNumber(r, 2, -number, nfExp, 3); MyWorksheet.WriteNumber(r, 3, 1.0/number, nfExp, 3); MyWorksheet.WriteNumber(r, 4, -1.0/number, nfExp, 3); inc(r,2); - MyWorksheet.WriteUTF8Text(r, 0, 'nfCurrency, 0 decs'); + MyWorksheet.WriteText(r, 0, 'nfCurrency, 0 decs'); MyWorksheet.WriteCurrency(r, 1, number, nfCurrency, 0, 'USD'); MyWorksheet.WriteCurrency(r, 2, -number, nfCurrency, 0, 'USD'); MyWorksheet.WriteCurrency(r, 3, 0.0, nfCurrency, 0, 'USD'); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfCurrencyRed, 0 decs'); + MyWorksheet.WriteText(r, 0, 'nfCurrencyRed, 0 decs'); MyWorksheet.WriteCurrency(r, 1, number, nfCurrencyRed, 0, 'USD'); MyWorksheet.WriteCurrency(r, 2, -number, nfCurrencyRed, 0, 'USD'); MyWorksheet.WriteCurrency(r, 3, 0.0, nfCurrencyRed, 0, 'USD'); inc(r,2); - MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, "EUR "#,##0_);("EUR "#,##0)'); + MyWorksheet.WriteText(r, 0, 'nfCustom, "EUR "#,##0_);("EUR "#,##0)'); MyWorksheet.WriteNumber(r, 1, number); MyWorksheet.WriteNumberFormat(r, 1, nfCustom, '"EUR "#,##0_);("EUR "#,##0)'); MyWorksheet.WriteNumber(r, 2, -number); MyWorksheet.WriteNumberFormat(r, 2, nfCustom, '"EUR "#,##0_);("EUR "#,##0)'); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, "$"#,##0.0_);[Red]("$"#,##0.0)'); + MyWorksheet.WriteText(r, 0, 'nfCustom, "$"#,##0.0_);[Red]("$"#,##0.0)'); MyWorksheet.WriteNumber(r, 1, number); MyWorksheet.WriteNumberFormat(r, 1, nfCustom, '"$"#,##0.0_);[Red]("$"#,##0.0)'); MyWorksheet.WriteNumber(r, 2, -number); @@ -310,61 +313,61 @@ begin inc(r, 2); number := 1.333333333; - MyWorksheet.WriteUTF8Text(r, 0, 'nfPercentage, 0 decs'); + MyWorksheet.WriteText(r, 0, 'nfPercentage, 0 decs'); MyWorksheet.WriteNumber(r, 1, number, nfPercentage, 0); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfPercentage, 1 decs'); + MyWorksheet.WriteText(r, 0, 'nfPercentage, 1 decs'); MyWorksheet.WriteNumber(r, 1, number, nfPercentage, 1); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfPercentage, 2 decs'); + MyWorksheet.WriteText(r, 0, 'nfPercentage, 2 decs'); MyWorksheet.WriteNumber(r, 1, number, nfPercentage, 2); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfPercentage, 3 decs'); + MyWorksheet.WriteText(r, 0, 'nfPercentage, 3 decs'); MyWorksheet.WriteNumber(r, 1, number, nfPercentage, 3); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval Default=[h]:mm:ss'); + MyWorksheet.WriteText(r, 0, 'nfTimeInterval Default=[h]:mm:ss'); MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, h:m:s'); + MyWorksheet.WriteText(r, 0, 'nfTimeInterval, h:m:s'); MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, 'h:m:s'); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [h]:m:s'); + MyWorksheet.WriteText(r, 0, 'nfTimeInterval, [h]:m:s'); MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[h]:m:s'); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [h]:n:s'); + MyWorksheet.WriteText(r, 0, 'nfTimeInterval, [h]:n:s'); MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[h]:n:s'); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [hh]:mm'); + MyWorksheet.WriteText(r, 0, 'nfTimeInterval, [hh]:mm'); MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[hh]:mm'); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [hh]:nn'); + MyWorksheet.WriteText(r, 0, 'nfTimeInterval, [hh]:nn'); MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[hh]:nn'); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval [h]:m'); + MyWorksheet.WriteText(r, 0, 'nfTimeInterval [h]:m'); MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[h]:m'); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [h]:n'); + MyWorksheet.WriteText(r, 0, 'nfTimeInterval, [h]:n'); MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[h]:n'); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [h]'); + MyWorksheet.WriteText(r, 0, 'nfTimeInterval, [h]'); MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[h]'); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [m]:s'); + MyWorksheet.WriteText(r, 0, 'nfTimeInterval, [m]:s'); MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[m]:s'); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, m:s'); + MyWorksheet.WriteText(r, 0, 'nfTimeInterval, m:s'); MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, 'm:s'); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [mm]:ss'); + MyWorksheet.WriteText(r, 0, 'nfTimeInterval, [mm]:ss'); MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[mm]:ss'); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [ss]'); + MyWorksheet.WriteText(r, 0, 'nfTimeInterval, [ss]'); MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[ss]'); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfFraction, ??/??'); + MyWorksheet.WriteText(r, 0, 'nfFraction, ??/??'); Myworksheet.WriteNumber(r, 1, number, nfFraction, '??/??'); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfFraction, # ??/??'); + MyWorksheet.WriteText(r, 0, 'nfFraction, # ??/??'); Myworksheet.WriteNumber(r, 1, number, nfFraction, '# ??/??'); // Set width of columns 0, 1 and 5 @@ -384,10 +387,10 @@ begin MyWorksheet := MyWorkbook.AddWorksheet(Str_Worksheet2); // Write some string cells - MyWorksheet.WriteUTF8Text(0, 0, Str_First); - MyWorksheet.WriteUTF8Text(0, 1, Str_Second); - MyWorksheet.WriteUTF8Text(0, 2, Str_Third); - MyWorksheet.WriteUTF8Text(0, 3, Str_Fourth); + MyWorksheet.WriteText(0, 0, Str_First); + MyWorksheet.WriteText(0, 1, Str_Second); + MyWorksheet.WriteText(0, 2, Str_Third); + MyWorksheet.WriteText(0, 3, Str_Fourth); MyWorksheet.WriteTextRotation(0, 0, rt90DegreeClockwiseRotation); MyWorksheet.WriteFontStyle(0, 1, [fssBold]); diff --git a/components/fpspreadsheet/fpshtml.pas b/components/fpspreadsheet/fpshtml.pas index 8c3178dd3..2be267a2f 100644 --- a/components/fpspreadsheet/fpshtml.pas +++ b/components/fpspreadsheet/fpshtml.pas @@ -162,8 +162,6 @@ begin end; destructor TsHTMLReader.Destroy; -var - i: Integer; begin FreeAndNil(FFontStack); FreeAndNil(FCurrFont); diff --git a/components/fpspreadsheet/fpshtmlutils.pas b/components/fpspreadsheet/fpshtmlutils.pas index f4cf0af74..46defd664 100644 --- a/components/fpspreadsheet/fpshtmlutils.pas +++ b/components/fpspreadsheet/fpshtmlutils.pas @@ -5,7 +5,7 @@ unit fpsHTMLUtils; interface uses - Classes, SysUtils, contnrs; + Classes, SysUtils, contnrs, fpstypes, fpspreadsheet; type TsHTMLEntity = record @@ -36,12 +36,15 @@ type property Items[AIndex: Integer]: TsHTMLAttr read GetItem write SetItem; default; end; +procedure HTMLToRichText(AWorkbook: TsWorkbook; AFont: TsFont; + const AHTMLText: String; out APlainText: String; + out ARichTextParams: TsRichTextParams); implementation uses - Strings, - fpsUtils; + math, Strings, lazUtf8, fasthtmlparser, + fpsUtils, fpsClasses; const // http://unicode.e-workers.de/entities.php @@ -570,5 +573,343 @@ begin end; +{==============================================================================} +{ HTML-to-Rich-text conversion } +{==============================================================================} +type + TsHTMLAnalyzer = class(THTMLParser) + private + FWorkbook: TsWorkbook; + FPlainText: String; + FRichTextParams: TsRichTextParams; + FAttrList: TsHTMLAttrList; + FFontStack: TsIntegerStack; + FCurrFont: TsFont; + FPointSeparatorSettings: TFormatSettings; + function AddFont(AFont: TsFont): Integer; + procedure AddRichTextParam(AFont: TsFont; AHyperlinkIndex: Integer = -1); + procedure ProcessFontRestore; + procedure ReadFont(AFont: TsFont); + procedure TagFoundHandler(NoCaseTag, ActualTag: string); + procedure TextFoundHandler(AText: string); + public + constructor Create(AWorkbook: TsWorkbook; AFont: TsFont; AText: String); + destructor Destroy; override; + property PlainText: String read FPlainText; + property RichTextParams: TsRichTextParams read FRichTextParams; + end; + +constructor TsHTMLAnalyzer.Create(AWorkbook: TsWorkbook; AFont: TsFont; + AText: String); +begin + if AWorkbook = nil then + raise Exception.Create('[TsHTMLAnalyzer.Create] Workbook required.'); + if AFont = nil then + raise Exception.Create('[TsHTMLAnalyzer.Create] Font required.'); + + inherited Create(AText); + FWorkbook := AWorkbook; + + OnFoundTag := @TagFoundHandler; + OnFoundText := @TextFoundHandler; + + FPlainText := ''; + SetLength(FRichTextParams, 0); + + FAttrList := TsHTMLAttrList.Create; + FCurrFont := TsFont.Create; + FCurrFont.CopyOf(AFont); + + FFontStack := TsIntegerStack.Create; + + FPointSeparatorSettings := DefaultFormatSettings; + FPointSeparatorSettings.DecimalSeparator := '.'; +end; + +destructor TsHTMLAnalyzer.Destroy; +begin + FreeAndNil(FFontStack); + FreeAndNil(FCurrFont); + FreeAndNil(FAttrList); + inherited Destroy; +end; + +{ Stores a font in the workbook's font list. Does not allow duplicates. } +function TsHTMLAnalyzer.AddFont(AFont: TsFont): Integer; +const + EPS = 1e-3; +var + i: Integer; + fnt: TsFont; +begin + // Is the font already stored in the workbook's font list? + Result := FWorkbook.FindFont(AFont.FontName, AFont.Size, AFont.Style, AFont.Color, AFont.Position); + if Result = -1 then + begin + // No. Create a new font, add it to the list, and return the new index. + fnt := TsFont.Create; + fnt.CopyOf(AFont); + Result := FWorkbook.AddFont(fnt); + end; +end; + +procedure TsHTMLAnalyzer.AddRichTextParam(AFont: TsFont; + AHyperlinkIndex: Integer = -1); +var + len: Integer; + fntIndex: Integer; + n: Integer; +begin + n := Length(FRichTextParams); + len := UTF8Length(FPlainText); + fntIndex := AddFont(AFont); + if (n > 0) and (FRichTextparams[n-1].FirstIndex = len+1) then + begin + // Avoid adding another rich-text parameter for the same text location: + // Update the previous one + FRichTextParams[n-1].FontIndex := fntIndex; + FRichTextParams[n-1].HyperlinkIndex := AHyperlinkIndex; + end else + begin + // Add a new rich-text parameter + SetLength(FRichTextParams, n+1); + FRichTextParams[n].FirstIndex := len + 1; + FRichTextParams[n].FontIndex := fntIndex; + FRichTextParams[n].HyperlinkIndex := AHyperlinkIndex; + end; +end; + +procedure TsHTMLAnalyzer.ProcessFontRestore; +var + fntIndex: Integer; +begin + fntIndex := FFontStack.Pop; + if fntIndex > -1 then + begin + FCurrFont.CopyOf(FWorkbook.GetFont(fntIndex)); + AddRichTextParam(FCurrFont); + end; +end; + +procedure TsHTMLAnalyzer.ReadFont(AFont: TsFont); +const + FACTOR = 1.2; + MIN_FONTSIZE = 6; +var + idx: Integer; + L: TStringList; + i, ip, im: Integer; + s: String; + f: Double; + defFntSize: Single; +begin + idx := FAttrList.IndexOfName('font-family'); // style tag + if idx = -1 then + idx := FAttrList.IndexOfName('face'); // html tag + if idx > -1 then begin + L := TStringList.Create; + try + L.StrictDelimiter := true; + L.DelimitedText := FAttrList[idx].Value; + AFont.FontName := L[0]; + finally + L.Free; + end; + end; + + idx := FAttrList.IndexOfName('font-size'); + if idx = -1 then + idx := FAttrList.IndexOfName('size'); + if idx > -1 then begin + defFntSize := FWorkbook.GetDefaultFont.Size; + s := FAttrList[idx].Value; + case s of + 'medium', '3' : AFont.Size := defFntSize; + 'large', '4' : AFont.Size := defFntSize*FACTOR; + 'x-large', '5' : AFont.Size := defFntSize*FACTOR*FACTOR; + 'xx-large', '6' : AFont.Size := defFntSize*FACTOR*FACTOR*FACTOR; + 'small', '2' : AFont.Size := Max(MIN_FONTSIZE, defFntSize/FACTOR); + 'x-small' : AFont.Size := Max(MIN_FONTSIZE, defFntSize/FACTOR/FACTOR); + 'xx-small', '1' : AFont.Size := Max(MIN_FONTSIZE, defFntSize/FACTOR/FACTOR/FACTOR); + 'larger' : AFont.Size := AFont.Size * FACTOR; + 'smaller' : AFont.Size := Max(MIN_FONTSIZE, AFont.Size / FACTOR); + else + if s[1] in ['+', '-'] then + begin + TryStrToInt(s, i); + AFont.Size := defFntSize * IntPower(FACTOR, i); + end else + begin + i := 0; + im := 0; + ip := pos('%', s); + if ip = 0 then begin + im := pos('rem', s); + if im = 0 then + im := pos('em', s); + end; + if (ip > 0) then i := ip else + if (im > 0) then i := im; + if i > 0 then + begin + s := copy(s, 1, i-1); + if TryStrToFloat(s, f, FPointSeparatorSettings) then + begin + if ip > 0 then f := f * 0.01; + AFont.Size := Max(MIN_FONTSIZE, abs(f) * defFntSize); + end; + end else + AFont.Size := Max(MIN_FONTSIZE, HTMLLengthStrToPts(s)); + end; + end; + end; + + idx := FAttrList.IndexOfName('font-style'); + if idx > -1 then + case FAttrList[idx].Value of + 'normal' : Exclude(AFont.Style, fssItalic); + 'italic' : Include(AFont.Style, fssItalic); + 'oblique' : Include(AFont.Style, fssItalic); + end; + + idx := FAttrList.IndexOfName('font-weight'); + if idx > -1 then + begin + s := FAttrList[idx].Value; + if TryStrToInt(s, i) and (i >= 700) then Include(AFont.Style, fssBold); + end; + + idx := FAttrList.IndexOfName('text-decoration'); + if idx > -1 then + begin + s := FAttrList[idx].Value; + if pos('underline', s) <> 0 then Include(AFont.Style, fssUnderline); + if pos('line-through', s) <> 0 then Include(AFont.Style, fssStrikeout); + end; + + idx := FAttrList.IndexOfName('color'); + if idx > -1 then + AFont.Color := HTMLColorStrToColor(FAttrList[idx].Value); +end; + +procedure TsHTMLAnalyzer.TagFoundHandler(NoCaseTag, ActualTag: String); +begin + case NoCaseTag[2] of + 'B': case NoCaseTag of + '' : begin + FFontStack.Push(AddFont(FCurrFont)); + Include(FCurrFont.Style, fssBold); + AddRichTextParam(FCurrFont); + end; + '
', + '
': FPlainText := FPlainText + FPS_LINE_ENDING; + else if (pos('
' : begin + FFontStack.Push(AddFont(FCurrFont)); + Include(FCurrFont.Style, fssItalic); + AddRichTextParam(FCurrFont); + end; + '': begin + FFontStack.Push(AddFont(FCurrFont)); + Include(FCurrFont.Style, fssUnderline); + AddRichTextParam(FCurrFont); + end; + end; + 'S': case NoCaseTag of + '' : begin + FFontStack.Push(AddFont(FCurrFont)); + Include(FCurrFont.Style, fssStrikeout); + AddRichTextParam(FCurrFont); + end; + '':begin + FFontStack.Push(AddFont(FCurrFont)); + Include(FCurrFont.Style, fssBold); + AddRichTextParam(FCurrFont); + end; + '': begin + FFontStack.Push(AddFont(FCurrFont)); + FCurrFont.Position := fpSubscript; + AddRichTextParam(FCurrFont); + end; + '': begin + FFontStack.Push(AddFont(FCurrFont)); + FCurrFont.Position := fpSuperscript; + AddRichTextParam(FCurrFont); + end; + end; + 'U': if (NoCaseTag = '') then + begin + FFontStack.Push(AddFont(FCurrFont)); + Include(FCurrFont.Style, fssUnderline); + AddRichTextParam(FCurrFont); + end; + '/': case NoCaseTag[3] of + 'B': if (NoCaseTag) = '' then ProcessFontRestore; + 'D': if (NoCaseTag) = '' then ProcessFontRestore; + 'E': if (NoCaseTag) = '' then ProcessFontRestore; + 'F': if (NoCaseTag) = '' then ProcessFontRestore; + 'I': if (NoCaseTag = '') or (NoCaseTag = '') then ProcessFontRestore; + 'S': if (NoCaseTag = '') or (NoCaseTag = '') or + (NoCaseTag = '') or (NoCaseTag = '') then ProcessFontRestore; + 'U': if (NoCaseTag = '') then ProcessFontRestore; + end; + end; +end; + +procedure TsHTMLAnalyzer.TextFoundHandler(AText: String); +begin + AText := CleanHTMLString(AText); + if AText <> '' then + begin + if FPlainText = '' then + FPlainText := AText + else + FPlainText := FPlainText + AText; + end; +end; + + + +procedure HTMLToRichText(AWorkbook: TsWorkbook; AFont: TsFont; + const AHTMLText: String; out APlainText: String; + out ARichTextParams: TsRichTextParams); +var + analyzer: TsHTMLAnalyzer; + j: Integer; +begin + analyzer := TsHTMLAnalyzer.Create(AWorkbook, AFont, AHTMLText + ''); + try + analyzer.Exec; + APlainText := analyzer.PlainText; + SetLength(ARichTextParams, Length(analyzer.RichTextParams)); + for j:=0 to High(ARichTextParams) do + ARichTextParams[j] := analyzer.RichTextParams[j]; + finally + analyzer.Free; + end; +end; + end. diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 12ee3947c..e171c2023 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -174,9 +174,12 @@ type procedure UpdateCaches; { Reading of values } - function ReadAsUTF8Text(ARow, ACol: Cardinal): string; overload; - function ReadAsUTF8Text(ACell: PCell): string; overload; - function ReadAsUTF8Text(ACell: PCell; AFormatSettings: TFormatSettings): string; overload; + function ReadAsText(ARow, ACol: Cardinal): string; overload; + function ReadAsText(ACell: PCell): string; overload; + function ReadAsText(ACell: PCell; AFormatSettings: TFormatSettings): string; overload; + function ReadAsUTF8Text(ARow, ACol: Cardinal): string; overload; deprecated 'Use ReadAsText'; + function ReadAsUTF8Text(ACell: PCell): string; overload; deprecated 'Use ReadAsText'; + function ReadAsUTF8Text(ACell: PCell; AFormatSettings: TFormatSettings): string; overload; deprecated 'Use ReadAsText'; function ReadAsNumber(ARow, ACol: Cardinal): Double; overload; function ReadAsNumber(ACell: PCell): Double; overload; function ReadAsDateTime(ARow, ACol: Cardinal; out AResult: TDateTime): Boolean; overload; @@ -263,10 +266,17 @@ type procedure WriteRPNFormula(ACell: PCell; AFormula: TsRPNFormula); overload; - function WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring; + function WriteText(ARow, ACol: Cardinal; AText: String; ARichTextParams: TsRichTextParams = nil): PCell; overload; - procedure WriteUTF8Text(ACell: PCell; AText: String; + procedure WriteText(ACell: PCell; AText: String; ARichTextparams: TsRichTextParams = nil); overload; + function WriteTextAsHTML(ARow, ACol: Cardinal; AText: String): PCell; overload; + procedure WriteTextAsHTML(ACell: PCell; AText: String); overload; + + function WriteUTF8Text(ARow, ACol: Cardinal; AText: String; + ARichTextParams: TsRichTextParams = nil): PCell; overload; deprecated 'Use WriteText'; + procedure WriteUTF8Text(ACell: PCell; AText: String; + ARichTextparams: TsRichTextParams = nil); overload; deprecated 'Use WriteText'; { Writing of cell attributes } function WriteBackground(ARow, ACol: Cardinal; AStyle: TsFillStyle; @@ -826,7 +836,7 @@ implementation uses Math, StrUtils, DateUtils, TypInfo, lazutf8, lazFileUtils, URIParser, RegExpr, fpsStrings, uvirtuallayer_ole, - fpsUtils, fpsreaderwriter, fpsCurrency, fpsExprParser, + fpsUtils, fpsHTMLUtils, fpsreaderwriter, fpsCurrency, fpsExprParser, fpsNumFormatParser; (* @@ -1481,7 +1491,7 @@ begin // Detect whether the cell already has a hyperlink, but has no other content. if HasHyperlink(ACell) then noCellText := (ACell^.ContentType = cctUTF8String) and - (GetDisplayText(ReadHyperlink(ACell).Target) = ReadAsUTF8Text(ACell)); + (GetDisplayText(ReadHyperlink(ACell).Target) = ReadAsText(ACell)); // Attach the hyperlink to the cell FHyperlinks.AddHyperlink(ACell^.Row, ACell^.Col, ATarget, ATooltip); @@ -2085,7 +2095,7 @@ begin Result := 0; if (ACell <> nil) and (ACell^.ContentType = cctNumber) then begin - s := ReadAsUTF8Text(ACell); + s := ReadAsText(ACell); p := pos(Workbook.FormatSettings.DecimalSeparator, s); if p > 0 then begin @@ -2367,9 +2377,14 @@ end; @param ACol The column of the cell @return The text representation of the cell -------------------------------------------------------------------------------} -function TsWorksheet.ReadAsUTF8Text(ARow, ACol: Cardinal): string; //ansistring; +function TsWorksheet.ReadAsText(ARow, ACol: Cardinal): string; begin - Result := ReadAsUTF8Text(GetCell(ARow, ACol)); + Result := ReadAsText(GetCell(ARow, ACol)); +end; + +function TsWorksheet.ReadAsUTF8Text(ARow, ACol: Cardinal): string; +begin + Result := ReadAsText(GetCell(ARow, ACol)); end; {@@ ---------------------------------------------------------------------------- @@ -2381,9 +2396,14 @@ end; @param ACell Pointer to the cell @return The text representation of the cell -------------------------------------------------------------------------------} -function TsWorksheet.ReadAsUTF8Text(ACell: PCell): string; //ansistring; +function TsWorksheet.ReadAsText(ACell: PCell): string; begin - Result := ReadAsUTF8Text(ACell, FWorkbook.FormatSettings); + Result := ReadAsText(ACell, FWorkbook.FormatSettings); +end; + +function TsWorksheet.ReadAsUTF8Text(ACell: PCell): string; +begin + Result := ReadAsText(ACell, FWorkbook.FormatSettings); end; {@@ ---------------------------------------------------------------------------- @@ -2397,7 +2417,7 @@ end; of numbers and date/times. @return The text representation of the cell -------------------------------------------------------------------------------} -function TsWorksheet.ReadAsUTF8Text(ACell: PCell; +function TsWorksheet.ReadAsText(ACell: PCell; AFormatSettings: TFormatSettings): string; var fmt: PsCellFormat; @@ -2464,6 +2484,12 @@ begin end; end; +function TsWorksheet.ReadAsUTF8Text(ACell: PCell; + AFormatSettings: TFormatSettings): string; +begin + Result := ReadAsText(ACell, AFormatSettings); +end; + {@@ ---------------------------------------------------------------------------- Returns the value of a cell as a number. @@ -3563,7 +3589,7 @@ var var txt: String; begin - txt := ReadAsUTF8Text(ACell); + txt := ReadAsText(ACell); if (soRegularExpr in AOptions) then Result := regex.Exec(txt) else @@ -3753,19 +3779,23 @@ end; @see TsRichTextParams @see TsRichTextParam -------------------------------------------------------------------------------} -function TsWorksheet.WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring; +function TsWorksheet.WriteText(ARow, ACol: Cardinal; AText: String; ARichTextParams: TsRichTextParams = nil): PCell; begin Result := GetCell(ARow, ACol); - WriteUTF8Text(Result, AText, ARichTextParams); + WriteText(Result, AText, ARichTextParams); +end; + +function TsWorksheet.WriteUTF8Text(ARow, ACol: Cardinal; AText: String; + ARichTextParams: TsRichTextParams = nil): PCell; +begin + Result := GetCell(ARow, ACol); + WriteText(Result, AText, ARichTextParams); end; {@@ ---------------------------------------------------------------------------- Writes UTF-8 encoded text to a cell. - On formats that don't support unicode, the text will be converted - to ISO Latin 1. - @param ACell Pointer to the cell @param AText The text to be written encoded in utf-8 @param ARichTextParams Array of formatting instructions for characters or @@ -3774,7 +3804,7 @@ end; @see TsRichTextParams @see TsRichTextParam -------------------------------------------------------------------------------} -procedure TsWorksheet.WriteUTF8Text(ACell: PCell; AText: String; +procedure TsWorksheet.WriteText(ACell: PCell; AText: String; ARichTextParams: TsRichTextParams = nil); var r, c: Cardinal; @@ -3823,6 +3853,71 @@ begin ChangedCell(ACell^.Row, ACell^.Col); end; +procedure TsWorksheet.WriteUTF8Text(ACell: PCell; AText: String; + ARichTextParams: TsRichTextParams = nil); +begin + WriteText(ACell, AText, ARichTextParams); +end; + +{@@ ---------------------------------------------------------------------------- + Writes text containing HTML codes to a cell. Here are the allowed HTML codes: + , ... bold text + , ........ italic text + , ....... underlined text + , ....... strike-out text + ............ subscript + ............ superscript + ...... full font selection. "tags" can be: + face="..." ... font name + size="..." ... font size, in pt, em, px, % (add units!) + color="..." .. font color (e.g. red, or #FF0000). + + @param ARow The row of the cell + @param ACol The column of the cell + @param AText The text containing the html codes + + @return Pointer to cell created or used + + @see TsRichTextParams + @see TsRichTextParam +-------------------------------------------------------------------------------} +function TsWorksheet.WriteTextAsHTML(ARow, ACol: Cardinal; AText: String): PCell; +begin + Result := GetCell(ARow, ACol); + WriteTextAsHTML(Result, AText); +end; + +{@@ ---------------------------------------------------------------------------- + Writes text containing HTML codes to a cell. Here are the allowed HTML codes: + , ... bold text + , ........ italic text + , ....... underlined text + , ....... strike-out text + ............ subscript + ............ superscript + ...... full font selection. "tags" can be: + face="..." ... font name + size="..." ... font size, in pt, em, px, % (add units!) + color="..." .. font color (e.g. red, or #FF0000). + + @param ACell Pointer to the cell + @param AText The text containing the html codes + + @see TsRichTextParams + @see TsRichTextParam +-------------------------------------------------------------------------------} +procedure TsWorksheet.WriteTextAsHTML(ACell: PCell; AText: String); +var + plainText: String; + rtParams: TsRichTextParams; +begin + if ACell = nil then + exit; + + HTMLToRichText(FWorkbook, ReadCellFont(ACell), AText, plainText, rtParams); + WriteText(ACell, plainText, rtParams); +end; + {@@ ---------------------------------------------------------------------------- Writes a floating-point number to a cell, does not change the number format