pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

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").

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4267 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-08-12 20:07:24 +00:00
parent f8202560a5
commit 4f741ca06d
5 changed files with 524 additions and 87 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
components/fpspreadsheet/examples/read_write/excel8demo/excel8read.lpr
View File

@ -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

125
components/fpspreadsheet/examples/read_write/excel8demo/excel8write.lpr
View File

@ -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, 'H<sub>2</sub>O');
MyWorksheet.WriteTextAsHTML(3, 0, '<font color="red">red</font>, <font color="yellow">yellow</font>, <font color="green">green</font>');
MyWorksheet.WriteTextAsHTML(4, 0, 'sin<sup>2</sup> &alpha; + cos<sup>2</sup> &beta; = 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]);

2
components/fpspreadsheet/fpshtml.pas
View File

@ -162,8 +162,6 @@ begin
end;
destructor TsHTMLReader.Destroy;
var
i: Integer;
begin
FreeAndNil(FFontStack);
FreeAndNil(FCurrFont);

347
components/fpspreadsheet/fpshtmlutils.pas
View File

@ -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
'<B>' : begin
FFontStack.Push(AddFont(FCurrFont));
Include(FCurrFont.Style, fssBold);
AddRichTextParam(FCurrFont);
end;
'<BR>',
'<BR/>': FPlainText := FPlainText + FPS_LINE_ENDING;
else if (pos('<BR ', NoCaseTag) = 1) then
FPlainText := FPlainText + FPS_LINE_ENDING;
end;
'D': if (NoCaseTag = '<DEL>') then
begin
FFontStack.Push(AddFont(FCurrFont));
Include(FCurrFont.Style, fssStrikeout);
AddRichTextParam(FCurrFont);
end;
'E': if (NoCaseTag = '<EM>') then
begin
FFontStack.Push(AddFont(FCurrFont));
Include(FCurrFont.Style, fssItalic);
AddRichTextParam(FCurrFont);
end;
'F': if (pos('<FONT ', NoCaseTag) = 1) then
begin
FFontStack.Push(AddFont(FCurrFont));
FAttrList.Parse(ActualTag);
ReadFont(FCurrFont);
AddRichTextparam(FCurrFont);
end;
'I': case NoCaseTag of
'<I>' : begin
FFontStack.Push(AddFont(FCurrFont));
Include(FCurrFont.Style, fssItalic);
AddRichTextParam(FCurrFont);
end;
'<INS>': begin
FFontStack.Push(AddFont(FCurrFont));
Include(FCurrFont.Style, fssUnderline);
AddRichTextParam(FCurrFont);
end;
end;
'S': case NoCaseTag of
'<S>' : begin
FFontStack.Push(AddFont(FCurrFont));
Include(FCurrFont.Style, fssStrikeout);
AddRichTextParam(FCurrFont);
end;
'<STRONG>':begin
FFontStack.Push(AddFont(FCurrFont));
Include(FCurrFont.Style, fssBold);
AddRichTextParam(FCurrFont);
end;
'<SUB>': begin
FFontStack.Push(AddFont(FCurrFont));
FCurrFont.Position := fpSubscript;
AddRichTextParam(FCurrFont);
end;
'<SUP>': begin
FFontStack.Push(AddFont(FCurrFont));
FCurrFont.Position := fpSuperscript;
AddRichTextParam(FCurrFont);
end;
end;
'U': if (NoCaseTag = '<U>') then
begin
FFontStack.Push(AddFont(FCurrFont));
Include(FCurrFont.Style, fssUnderline);
AddRichTextParam(FCurrFont);
end;
'/': case NoCaseTag[3] of
'B': if (NoCaseTag) = '</B>' then ProcessFontRestore;
'D': if (NoCaseTag) = '</DEL>' then ProcessFontRestore;
'E': if (NoCaseTag) = '</EM>' then ProcessFontRestore;
'F': if (NoCaseTag) = '</FONT>' then ProcessFontRestore;
'I': if (NoCaseTag = '</I>') or (NoCaseTag = '</INS>') then ProcessFontRestore;
'S': if (NoCaseTag = '</S>') or (NoCaseTag = '</STRONG>') or
(NoCaseTag = '</SUB>') or (NoCaseTag = '</SUP>') then ProcessFontRestore;
'U': if (NoCaseTag = '</U>') 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 + '<end>');
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.

135
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -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:
<b>, <strong> ... bold text
<i>, <em> ........ italic text
<u>, <ins> ....... underlined text
<s>, <del> ....... strike-out text
<sub> ............ subscript
<sup> ............ superscript
<font tags> ...... 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:
<b>, <strong> ... bold text
<i>, <em> ........ italic text
<u>, <ins> ....... underlined text
<s>, <del> ....... strike-out text
<sub> ............ subscript
<sup> ............ superscript
<font tags> ...... 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