You've already forked lazarus-ccr
fpspreadsheet: Add simple converter from plain text+rich formatting to html-coded text.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4270 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -40,6 +40,11 @@ procedure HTMLToRichText(AWorkbook: TsWorkbook; AFont: TsFont;
|
||||
const AHTMLText: String; out APlainText: String;
|
||||
out ARichTextParams: TsRichTextParams);
|
||||
|
||||
procedure RichTextToHTML(AWorkbook: TsWorkbook; AFont: TsFont;
|
||||
const APlainText: String; const ARichTextParams: TsRichTextParams;
|
||||
out AHTMLText: String);
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
@ -891,7 +896,10 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
|
||||
{@@ ----------------------------------------------------------------------------
|
||||
Extracts rich-text parameters out of an html-formatted string and returns the
|
||||
plain text
|
||||
-------------------------------------------------------------------------------}
|
||||
procedure HTMLToRichText(AWorkbook: TsWorkbook; AFont: TsFont;
|
||||
const AHTMLText: String; out APlainText: String;
|
||||
out ARichTextParams: TsRichTextParams);
|
||||
@ -911,5 +919,212 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{==============================================================================}
|
||||
{ Rich-text-to-HTML conversion }
|
||||
{==============================================================================}
|
||||
|
||||
type
|
||||
TsChangeFlag = (cfFontName, cfFontSize, cfFontColor, cfFontPosition,
|
||||
cfBold, cfItalic, cfUnderline, cfStrikeout);
|
||||
TsChangeFlags = set of TsChangeFlag;
|
||||
|
||||
TsHTMLComposer = class
|
||||
private
|
||||
FPointSeparatorSettings: TFormatSettings;
|
||||
FWorkbook: TsWorkbook;
|
||||
FBaseFont: TsFont;
|
||||
FPlainText: String;
|
||||
FRichTextParams: TsRichTextParams;
|
||||
FChangedParams: array of TsChangeFlags;
|
||||
FFonts: array of TsFont;
|
||||
FHTMLText: String;
|
||||
function FindChangedParams(AStartIndex: Integer): Integer;
|
||||
procedure GetFontsFromWorkbook;
|
||||
function GetTextOfRichTextParam(AIndex: Integer): String;
|
||||
procedure StoreChangedParams(AIndex: Integer);
|
||||
protected
|
||||
public
|
||||
constructor Create(AWorkbook: TsWorkbook; AFont: TsFont);
|
||||
function Exec(const APlainText: String; const ARichTextParams: TsRichTextParams): String;
|
||||
end;
|
||||
|
||||
constructor TsHTMLComposer.Create(AWorkbook: TsWorkbook; AFont: TsFont);
|
||||
begin
|
||||
FPointSeparatorSettings := DefaultFormatSettings;
|
||||
FPointSeparatorSettings.DecimalSeparator := '.';
|
||||
FWorkbook := AWorkbook;
|
||||
FBaseFont := AFont;
|
||||
end;
|
||||
|
||||
function TsHTMLComposer.Exec(const APlainText: String;
|
||||
const ARichTextParams: TsRichTextParams): String;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
if Length(ARichTextParams) = 0 then
|
||||
begin
|
||||
Result := FPlainText;
|
||||
exit;
|
||||
end;
|
||||
|
||||
FRichTextParams := ARichTextParams;
|
||||
FPlainText := APlainText;
|
||||
|
||||
GetFontsFromWorkbook;
|
||||
SetLength(FChangedParams, Length(FRichTextParams));
|
||||
|
||||
if FRichTextParams[0].FirstIndex > 1 then
|
||||
Result := GetTextOfRichTextParam(-1) else
|
||||
Result := '';
|
||||
|
||||
for i:=0 to High(FRichTextParams) do
|
||||
begin
|
||||
// Remember what is changed in this step
|
||||
StoreChangedParams(i);
|
||||
// Find when these items were changed before
|
||||
// j := FindChangedParams(i); --- not needed in the simple version
|
||||
// For the changed items add an open tag
|
||||
// NOTE: This is a simple version: every opened tag is closed afterwards!
|
||||
// In a more advanced version, shared properties should be kept. This is
|
||||
// what FChangedParams was introduced for!
|
||||
if [cfFontName, cfFontSize, cfFontColor] * FChangedparams[i] <> [] then
|
||||
begin
|
||||
Result := Result + '<font';
|
||||
if cfFontName in FChangedParams[i] then
|
||||
Result := Result + ' face="' + FFonts[i].FontName + '"';
|
||||
if cfFontSize in FChangedParams[i] then
|
||||
Result := Result + ' size="' + Format('%.gpt', [FFonts[i].Size], FPointSeparatorSettings) + '"';
|
||||
if cfFontColor in FChangedParams[i] then
|
||||
Result := Result + ' color="' + ColorToHTMLColorStr(FFonts[i].Color) + '"';
|
||||
end;
|
||||
if (cfBold in FChangedParams[i]) then
|
||||
Result := Result + '<b>';
|
||||
if (cfItalic in FChangedParams[i]) then
|
||||
Result := Result + '<i>';
|
||||
if (cfUnderline in FChangedParams[i]) then
|
||||
Result := Result + '<u>';
|
||||
if (cfStrikeout in FChangedParams[i]) then
|
||||
Result := Result + '<s>';
|
||||
if (cfFontPosition in FChangedParams[i]) then
|
||||
begin
|
||||
if FFonts[i].Position = fpSuperscript then Result := Result + '<sup>';
|
||||
if FFonts[i].Position = fpSubscript then Result := Result + '<sub>';
|
||||
end;
|
||||
// Add the node text
|
||||
Result := Result + GetTextOfRichTextParam(i);
|
||||
// Add closing tags (reverse order as opening!)
|
||||
if (cfFontPosition in FChangedParams[i]) then
|
||||
begin
|
||||
if FFonts[i].Position = fpSubscript then Result := Result + '</sub>';
|
||||
if FFonts[i].Position = fpSuperscript then Result := Result + '</sup>';
|
||||
end;
|
||||
if (cfStrikeout in FChangedParams[i]) then
|
||||
Result := Result + '</s>';
|
||||
if (cfUnderline in FChangedParams[i]) then
|
||||
Result := Result + '</u>';
|
||||
if (cfItalic in FChangedParams[i]) then
|
||||
Result := Result + '</i>';
|
||||
if (cfBold in FChangedParams[i]) then
|
||||
Result := Result + '</b>';
|
||||
if [cfFontName, cfFontSize, cfFontColor] * FChangedParams[i] <> [] then
|
||||
Result := Result + '</font';
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Going back from AStartIndex find the changed parameter flags in which all
|
||||
flags are used like in the one at AStartIndex. }
|
||||
function TsHTMLComposer.FindChangedParams(AStartIndex: Integer): Integer;
|
||||
var
|
||||
cp: TsChangeFlags;
|
||||
begin
|
||||
cp := FChangedParams[AStartIndex];
|
||||
Result := AStartIndex - 1;
|
||||
while (Result >= 0) and (cp * FChangedParams[Result] <> cp) do
|
||||
dec(Result);
|
||||
end;
|
||||
|
||||
procedure TsHTMLComposer.GetFontsFromWorkbook;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
SetLength(FFonts, Length(FRichTextParams));
|
||||
for i:=0 to High(FFonts) do
|
||||
FFonts[i] := FWorkbook.GetFont(FRichTextParams[i].FontIndex);
|
||||
end;
|
||||
|
||||
function TsHTMLComposer.GetTextOfRichTextParam(AIndex: Integer): String;
|
||||
var
|
||||
p1, p2: Integer;
|
||||
begin
|
||||
if AIndex = -1 then
|
||||
Result := UTF8Copy(FPlainText, 1, FRichTextParams[0].FirstIndex-1)
|
||||
else
|
||||
if AIndex <= High(FRichTextParams) then
|
||||
begin
|
||||
p1 := FRichTextParams[AIndex].FirstIndex;
|
||||
if AIndex < High(FRichTextparams) then
|
||||
p2 := FRichTextParams[AIndex+1].FirstIndex else
|
||||
p2 := UTF8Length(FPlainText) + 1;
|
||||
Result := UTF8Copy(FPlaiNText, p1, p2-p1);
|
||||
end else
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
{ Entering the rich-text parameter region with the specified index. Detects
|
||||
the font differences to the preceding section. }
|
||||
procedure TsHTMLComposer.StoreChangedParams(AIndex: Integer);
|
||||
const
|
||||
EPS = 1e-3;
|
||||
var
|
||||
fnt1, fnt2: TsFont;
|
||||
begin
|
||||
// Font in previous section
|
||||
if AIndex = 0 then
|
||||
fnt1 := FBaseFont else
|
||||
fnt1 := FFonts[AIndex-1];
|
||||
// Font in current (new) section
|
||||
fnt2 := FFonts[AIndex];
|
||||
if not SameText(fnt1.FontName, fnt2.FontName) then
|
||||
Include(FChangedParams[AIndex], cfFontName);
|
||||
if not SameValue(fnt1.Size, fnt2.Size, EPS) then
|
||||
Include(FChangedParams[Aindex], cfFontSize);
|
||||
if fnt1.Color <> fnt2.Color then
|
||||
Include(FChangedParams[AIndex], cfFontColor);
|
||||
if fnt1.Position <> fnt2.Position then
|
||||
Include(FChangedParams[AIndex], cfFontPosition);
|
||||
if (fnt1.Style * [fssBold] <> fnt2.Style * [fssBold]) then
|
||||
Include(FChangedParams[Aindex], cfBold);
|
||||
if (fnt1.Style * [fssItalic] <> fnt2.Style * [fssItalic]) then
|
||||
Include(FChangedParams[AIndex], cfItalic);
|
||||
if (fnt1.Style * [fssUnderline] <> fnt2.style * [fssUnderline]) then
|
||||
Include(FChangedParams[AIndex], cfUnderline);
|
||||
if (fnt1.STyle * [fssStrikeout] <> fnt2.Style * [fssStrikeout]) then
|
||||
Include(FChangedParams[AIndex], cfStrikeout);
|
||||
end;
|
||||
|
||||
|
||||
{@@ ----------------------------------------------------------------------------
|
||||
Constructs a html-coded string from a plain text string and
|
||||
rich-text parameters
|
||||
-------------------------------------------------------------------------------}
|
||||
procedure RichTextToHTML(AWorkbook: TsWorkbook; AFont: TsFont;
|
||||
const APlainText: String; const ARichTextParams: TsRichTextParams;
|
||||
out AHTMLText: String);
|
||||
var
|
||||
composer: TsHTMLComposer;
|
||||
begin
|
||||
if Length(ARichTextParams) = 0 then
|
||||
AHTMLText := APlainText
|
||||
else begin
|
||||
composer := TsHTMLComposer.Create(AWorkbook, AFont);
|
||||
try
|
||||
AHTMLText := composer.Exec(APlainText, ARichTextParams);
|
||||
finally
|
||||
composer.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -148,6 +148,7 @@ procedure InitPageLayout(out APageLayout: TsPageLayout);
|
||||
procedure CopyCellValue(AFromCell, AToCell: PCell);
|
||||
function HasFormula(ACell: PCell): Boolean;
|
||||
function SameCellBorders(AFormat1, AFormat2: PsCellFormat): Boolean;
|
||||
function SameFont(AFont1, AFont2: TsFont): Boolean;
|
||||
|
||||
procedure AppendToStream(AStream: TStream; const AString: String); inline; overload;
|
||||
procedure AppendToStream(AStream: TStream; const AString1, AString2: String); inline; overload;
|
||||
@ -1913,6 +1914,26 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{@@ ----------------------------------------------------------------------------
|
||||
Checks whether two fonts are equal
|
||||
|
||||
@param AFormat1 Pointer to the first font to be compared
|
||||
@param AFormat2 Pointer to the second font to be compared
|
||||
-------------------------------------------------------------------------------}
|
||||
function SameFont(AFont1, AFont2: TsFont): Boolean;
|
||||
const
|
||||
EPS = 1E-3;
|
||||
begin
|
||||
Result := (AFont1 <> nil) and (AFont2 <> nil) and
|
||||
SameText(AFont1.FontName, AFont2.FontName) and
|
||||
SameValue(AFont1.Size, AFont2.Size, EPS) and
|
||||
(AFont1.Color = AFont2.Color) and
|
||||
(AFont1.Style = AFont2.Style) and
|
||||
(AFont1.Position = AFont2.Position);
|
||||
if (AFont1 = nil) and (AFont2 = nil) then
|
||||
Result := true;
|
||||
end;
|
||||
|
||||
{@@ ----------------------------------------------------------------------------
|
||||
Appends a string to a stream
|
||||
|
||||
|
||||
Reference in New Issue
Block a user