unit fpsHTML; {$mode objfpc}{$H+} interface uses Classes, SysUtils, fasthtmlparser, fpstypes, fpspreadsheet, fpsClasses, fpsReaderWriter, fpsHTMLUtils; type TsHTMLReader = class(TsCustomSpreadReader) private FPointSeparatorSettings: TFormatSettings; FFormatSettings: TFormatSettings; parser: THTMLParser; FInTable: Boolean; FInCell: Boolean; FEncoding: String; FTableCounter: Integer; FCurrRow, FCurrCol: LongInt; FCurrCellFormat: TsCellFormat; FCurrRichTextParams: TsRichTextParams; FCellFont: TsFont; FCurrFont: TsFont; FCellText: String; FAttrList: TsHTMLAttrList; FColSpan, FRowSpan: Integer; FHRef: String; FFontStack: TsIntegerStack; FWindowsClipboardMode: Boolean; procedure ReadBackgroundColor; procedure ReadBorder; procedure ReadEncoding; procedure ReadFont(AFont: TsFont); procedure ReadHRef; procedure ReadHorAlign; procedure ReadMergedRange; procedure ReadTextRot; procedure ReadVertAlign; procedure ReadWordwrap; procedure InitFont(AFont: TsFont); procedure InitCellFormat; procedure ProcessCellTags(NoCaseTag, Actualtag: String); procedure ProcessEndTags(NoCaseTag, ActualTag: String); procedure ProcessFontPosition(AFontPosition: TsFontPosition); procedure ProcessFontSizeAndStyle(AFontSize: Integer; AFontStyle: TsFontStyles); procedure ProcessFontStyle(AFontStyle: TsFontStyle); procedure ProcessFontRestore; procedure TagFoundHandler(NoCaseTag, ActualTag: string); procedure TextFoundHandler(AText: String); protected procedure AddCell(ARow, ACol: LongInt; AText: String); function AddFont(AFont: TsFont): Integer; procedure AddRichTextParam(AFont: TsFont; AHyperlinkIndex: Integer = -1); procedure FixRichTextParams(var AParams: TsRichTextParams); public constructor Create(AWorkbook: TsWorkbook); override; destructor Destroy; override; procedure ReadFromStream(AStream: TStream; AParams: TsStreamParams = []); override; procedure ReadFromStrings(AStrings: TStrings; AParams: TsStreamParams = []); override; end; TsHTMLWriter = class(TsCustomSpreadWriter) private FPointSeparatorSettings: TFormatSettings; FWindowsClipboardMode: Boolean; FStartHtmlPos: Int64; FEndHtmlPos: Int64; FStartFragmentPos: Int64; FEndFragmentPos: Int64; function CellFormatAsString(AFormat: PsCellFormat): 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; function GetMergedRangeAsStyle(AMergeBase: PCell): String; function GetRowHeightAsAttr(ARowIndex: Integer): String; function GetTextRotationAsStyle(ATextRot: TsTextRotation): String; function GetVertAlignAsStyle(AVertAlign: TsVertAlignment): String; 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 procedure InternalWriteToStream(AStream: TStream); procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal; ACell: PCell); override; procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal; const AValue: Boolean; ACell: PCell); override; procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); override; procedure WriteError(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TsErrorValue; ACell: PCell); override; procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal; ACell: PCell); override; procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; const AValue: string; ACell: PCell); override; procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double; ACell: PCell); override; public constructor Create(AWorkbook: TsWorkbook); override; destructor Destroy; override; procedure WriteToStream(AStream: TStream; AParams: TsStreamParams = []); override; procedure WriteToStrings(AStrings: TStrings; AParams: TsStreamParams = []); override; end; TsHTMLParams = record TableIndex: Integer; // R: Index of the table in the HTML file SheetIndex: Integer; // W: Index of the sheet to be written ShowRowColHeaders: Boolean; // RW: Show row/column headers DetectContentType: Boolean; // R: try to convert strings to content types NumberFormat: String; // W: if empty write numbers like in sheet, otherwise use this format AutoDetectNumberFormat: Boolean; // R: automatically detects decimal/thousand separator used in numbers TrueText: String; // RW: String for boolean TRUE FalseText: String; // RW: String for boolean FALSE FormatSettings: TFormatSettings; // RW: add'l parameters for conversion end; var {@@ Default settings for reading/writing of HTML files } HTMLParams: TsHTMLParams = ( TableIndex: -1; // -1 = all tables SheetIndex: -1; // -1 = active sheet, MaxInt = all sheets ShowRowColHeaders: false; DetectContentType: true; NumberFormat: ''; AutoDetectNumberFormat: true; TrueText: 'TRUE'; FalseText: 'FALSE'; {%H-}); sfidHTML: TsSpreadFormatID; implementation uses LConvEncoding, LazUTF8, URIParser, StrUtils, Math, fpsUtils, fpsXMLCommon, fpsNumFormat; const MIN_FONTSIZE = 6; NATIVE_HEADER = 'Version:0.9' + #13#10 + 'StartHTML:%.10d' + #13#10 + // Index of first char of tag 'EndHTML:%.10d' + #13#10 + // End of end of file 'StartFragment:%.10d' + #13#10 + // Index of first char after
') or (pos('
'' then
FCellText := FCellText + FPS_LINE_ENDING;
FFontStack.Push(AddFont(FCurrFont));
FAttrList.Parse(ActualTag);
ReadBackgroundColor;
ReadBorder;
ReadHorAlign;
ReadVertAlign;
ReadWordwrap;
ReadTextRot;
ReadFont(FCurrFont);
AddRichTextParam(FCurrFont);
end;
'S': case NoCaseTag of
'': ProcessFontStyle(fssBold);
'' : ProcessFontStyle(fssStrikeout);
'' : ProcessFontPosition(fpSubscript);
'' : ProcessFontPosition(fpSuperscript);
else
if (pos('') then
ProcessFontStyle(fssUnderline);
end;
end;
procedure TsHTMLReader.ProcessEndTags(NoCaseTag, ActualTag: String);
var
fntIndex: Integer;
begin
Unused(ActualTag);
if not FInTable then exit;
if (NoCaseTag = '') then
ProcessFontRestore;
if (NoCaseTag = '') then
begin
FInTable := false;
ProcessFontRestore;
exit;
end;
if not FInCell then exit;
if (NoCaseTag = '') or (NoCaseTag = '') then
begin
while FWorksheet.IsMerged(FWorksheet.FindCell(FCurrRow, FCurrCol)) do
inc(FCurrCol);
AddCell(FCurrRow, FCurrCol, FCellText);
FInCell := false;
fntIndex := FFontStack.Pop;
if fntIndex <> -1 then
FCurrFont.CopyOf(TsFont(FFontList[fntIndex]));
exit;
end;
// Pre-sort to speed up finding the tag
case NoCaseTag[3] of
'A': if (NoCaseTag = '') then begin
ProcessFontRestore;
FCellText := FCellText + ' ';
end;
'B': if (NoCaseTag = '') then
ProcessFontRestore;
'D': if (NoCaseTag = '') or (NoCaseTag = '
') or (pos(' | ') or (NoCaseTag = ' | ') or (pos(' | ') then begin FInCell := true; inc(FCurrCol); FCellText := ''; FFontStack.Push(AddFont(FCurrFont)); InitCellFormat; FAttrList.Parse(ActualTag); ReadMergedRange; ReadBackgroundColor; ReadBorder; ReadHorAlign; ReadTextRot; ReadVertAlign; ReadWordwrap; ReadFont(FCurrFont); if NoCaseTag[3] = 'H' then begin // for | Include(FCurrFont.Style, fssBold); FCurrCellFormat.HorAlignment := haCenter; Include(FCurrCellFormat.UsedFormattingFields, uffHorAlign); end; FCellFont.CopyOf(FCurrFont); exit; end; if not FInCell then exit; // The next tags are processed only within a | or | context.
ProcessCellTags(NoCaseTag, ActualTag);
end;
procedure TsHTMLReader.TextFoundHandler(AText: String);
begin
if FInCell then
begin
AText := CleanHTMLString(ConvertEncoding(AText, FEncoding, EncodingUTF8));
if AText <> '' then
begin
if FCellText = '' then
FCellText := AText
else
FCellText := FCellText + AText;
end;
end;
end;
{==============================================================================}
{ TsHTMLWriter }
{==============================================================================}
constructor TsHTMLWriter.Create(AWorkbook: TsWorkbook);
begin
inherited Create(AWorkbook);
FPointSeparatorSettings := DefaultFormatSettings;
FPointSeparatorSettings.DecimalSeparator := '.';
// No design limiations in table size
// http://stackoverflow.com/questions/4311283/max-columns-in-html-table
FLimitations.MaxColCount := MaxInt;
FLimitations.MaxRowCount := MaxInt;
end;
destructor TsHTMLWriter.Destroy;
begin
inherited Destroy;
end;
function TsHTMLWriter.CellFormatAsString(AFormat: PsCellFormat): String;
// ATagName: String): String;
begin
// Unused(ATagName);
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
Result := '';
if AFill.Style = fsSolidFill then
Result := 'background-color:' + ColorToHTMLColorStr(AFill.FgColor) + ';';
// other fills not supported
end;
function TsHTMLWriter.GetBorderAsStyle(ABorder: TsCellBorders;
const ABorderStyles: TsCellBorderStyles): String;
const
BORDER_NAMES: array[TsCellBorder] of string = (
'border-top', // cbNorth
'border-left', // cbWest
'border-right', // cbEast
'border-bottom', // cbSouth
'', // cbDiagUp
'' // cbDiagDown
);
LINESTYLE_NAMES: array[TsLineStyle] of string = (
'thin solid', // lsThin
'medium solid', // lsMedium
'thin dashed', // lsDashed
'thin dotted', // lsDotted
'thick solid', // lsThick,
'double', // lsDouble,
'1px solid', // lsHair
'medium dashed', // lsMediumDash --- not all available in HTML...
'thin dashed', // lsDashDot
'medium dashed', // lsMediumDashDot
'thin dotted', // lsDashDotDot
'medium dashed', // lsMediumDashDotDot
'medium dashed' // lsSlantedDashDot
);
var
cb: TsCellBorder;
allEqual: Boolean;
bs: TsCellBorderStyle;
begin
Result := 'border-collape:collapse;';
if ABorder = [cbNorth, cbEast, cbWest, cbSouth] then
begin
allEqual := true;
bs := ABorderStyles[cbNorth];
for cb in TsCellBorder do
begin
if bs.LineStyle <> ABorderStyles[cb].LineStyle then
begin
allEqual := false;
break;
end;
if bs.Color <> ABorderStyles[cb].Color then
begin
allEqual := false;
break;
end;
end;
if allEqual then
begin
Result := 'border:' +
LINESTYLE_NAMES[bs.LineStyle] + ' ' +
ColorToHTMLColorStr(bs.Color) + ';';
exit;
end;
end;
for cb in TsCellBorder do
begin
if BORDER_NAMES[cb] = '' then
continue;
if cb in ABorder then
Result := Result + BORDER_NAMES[cb] + ':' +
LINESTYLE_NAMES[ABorderStyles[cb].LineStyle] + ' ' +
ColorToHTMLColorStr(ABorderStyles[cb].Color) + ';';
end;
end;
function TsHTMLWriter.GetColWidthAsAttr(AColIndex: Integer): String;
var
col: PCol;
w: Single;
rLast: Cardinal;
begin
if AColIndex < 0 then // Row header column
begin
rLast := FWorksheet.GetLastRowIndex;
w := FWorkbook.ConvertUnits(Length(IntToStr(rLast)) + 2, suChars, suPoints);
end else
begin
w := FWorksheet.ReadDefaultColWidth(suPoints);
col := FWorksheet.FindCol(AColIndex);
if (col <> nil) and (col^.Width > 0) then
w := FWorkbook.ConvertUnits(col^.Width, FWorkbook.Units, suPoints);
end;
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;
begin
font := FWorkbook.GetFont(AFontIndex);
Result := Format('font-family:''%s'';font-size:%.1fpt;color:%s;', [
font.FontName, font.Size, ColorToHTMLColorStr(font.Color)], FPointSeparatorSettings);
if fssBold in font.Style then
Result := Result + 'font-weight:700;';
if fssItalic in font.Style then
Result := Result + 'font-style:italic;';
if [fssUnderline, fssStrikeout] * font.Style = [fssUnderline, fssStrikeout] then
Result := Result + 'text-decoration:underline,line-through;'
else
if [fssUnderline, fssStrikeout] * font.Style = [fssUnderline] then
Result := Result + 'text-decoration:underline;'
else
if [fssUnderline, fssStrikeout] * font.Style = [fssStrikeout] then
Result := Result + 'text-decoration:line-through;';
end;
function TsHTMLWriter.GetGridBorderAsStyle: String;
begin
if (soShowGridLines in FWorksheet.Options) then
Result := 'border:1px solid lightgrey;'
else
Result := '';
end;
function TsHTMLWriter.GetHorAlignAsStyle(AHorAlign: TsHorAlignment): String;
begin
case AHorAlign of
haLeft : Result := 'text-align:left;';
haCenter : Result := 'text-align:center;';
haRight : Result := 'text-align:right;';
end;
end;
function TsHTMLWriter.GetMergedRangeAsStyle(AMergeBase: PCell): String;
var
r1, r2, c1, c2: Cardinal;
begin
Result := '';
FWorksheet.FindMergedRange(AMergeBase, r1, c1, r2, c2);
if c1 <> c2 then
Result := Result + ' colspan="' + IntToStr(c2-c1+1) + '"';
if r1 <> r2 then
Result := Result + ' rowspan="' + IntToStr(r2-r1+1) + '"';
end;
function TsHTMLWriter.GetRowHeightAsAttr(ARowIndex: Integer): String;
var
h: Single;
row: PRow;
begin
h := FWorksheet.ReadDefaultRowHeight(suPoints);
row := FWorksheet.FindRow(ARowIndex);
if row <> nil then begin
if row^.RowHeightType = rhtCustom then
h := abs(FWorkbook.ConvertUnits(row^.Height, FWorkbook.Units, suPoints));
end;
Result := Format(' height="%.1fpt"', [h], FPointSeparatorSettings);
end;
function TsHTMLWriter.GetTextRotationAsStyle(ATextRot: TsTextRotation): String;
begin
Unused(ATextRot);
Result := '';
(* --- no - this is not working
case ATextRot of
trHorizontal: ;
rt90DegreeClockwiseRotation:
Result := 'writing-mode:vertical-rl;transform-origin:left top 0;transform:rotate(90deg);'; //-moz-transform: rotate(90deg);';
// Result := 'writing-mode:vertical-rl;text-orientation:sideways-right;-moz-transform: rotate(-90deg);';
rt90DegreeCounterClockwiseRotation:
Result := 'writing-mode:vertical-rt;transform-origin:left top 0;transform:rotate(-90deg);'; //-moz-transform: rotate(-90deg);';
// Result := 'writing-mode:vertical-rt;text-orientation:sideways-left;-moz-transform: rotate(-90deg);';
rtStacked:
Result := 'writing-mode:vertical-rt;text-orientation:upright;';
end;
*)
end;
function TsHTMLWriter.GetVertAlignAsStyle(AVertAlign: TsVertAlignment): String;
begin
case AVertAlign of
vaTop : Result := 'vertical-align:top;';
vaCenter : Result := 'vertical-align:middle;';
vaBottom : Result := 'vertical-align:bottom;';
end;
end;
function TsHTMLWriter.GetWordwrapAsStyle(AWordwrap: Boolean): String;
begin
if AWordwrap then
Result := 'word-wrap:break-word;'
else
Result := 'white-space:nowrap;';
end;
procedure TsHTMLWriter.InternalWriteToStream(AStream: TStream);
begin
FWorkbook.UpdateCaches;
AppendToStream(AStream,
'');
FStartHTMLPos := AStream.Position;
AppendToStream(AStream,
'' +
''+
'');
WriteStyles(AStream);
AppendToStream(AStream,
'');
WriteBody(AStream);
AppendToStream(AStream,
'');
FEndHTMLPos := AStream.Position;
end;
function TsHTMLWriter.IsHyperlinkTarget(ACell: PCell; out ABookmark: String): Boolean;
var
sheet: TsWorksheet;
hyperlink: PsHyperlink;
target, sh: String;
i, r, c: Cardinal;
begin
Result := false;
if ACell = nil then
exit;
for i:=0 to FWorkbook.GetWorksheetCount-1 do
begin
sheet := FWorkbook.GetWorksheetByIndex(i);
for hyperlink in sheet.Hyperlinks do
begin
SplitHyperlink(hyperlink^.Target, target, ABookmark);
if (target <> '') or (ABookmark = '') then
continue;
if ParseSheetCellString(ABookmark, sh, r, c) then
if (sh = TsWorksheet(ACell^.Worksheet).Name) and
(r = ACell^.Row) and (c = ACell^.Col)
then
exit(true);
if (sheet = FWorksheet) and ParseCellString(ABookmark, r, c) then
if (r = ACell^.Row) and (c = ACell^.Col) then
exit(true);
end;
end;
end;
procedure TsHTMLWriter.WriteBlank(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell);
begin
Unused(AStream);
Unused(ARow, ACol, ACell);
// nothing to do
end;
procedure TsHTMLWriter.WriteBody(AStream: TStream);
var
i: Integer;
begin
AppendToStream(AStream,
'');
if FWindowsClipboardMode or (HTMLParams.SheetIndex < 0) then // active sheet
begin
if FWorkbook.ActiveWorksheet = nil then
FWorkbook.SelectWorksheet(FWorkbook.GetWorksheetByIndex(0));
WriteWorksheet(AStream, FWorkbook.ActiveWorksheet)
end else
if HTMLParams.SheetIndex = MaxInt then // all sheets
for i:=0 to FWorkbook.GetWorksheetCount-1 do
WriteWorksheet(AStream, FWorkbook.GetWorksheetByIndex(i))
else // specific sheet
WriteWorksheet(AStream, FWorkbook.GetWorksheetbyIndex(HTMLParams.SheetIndex));
AppendToStream(AStream,
'');
end;
{ Write boolean cell to stream formatted as string }
procedure TsHTMLWriter.WriteBool(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: Boolean; ACell: PCell);
begin
Unused(AStream);
Unused(ARow, ACol, ACell);
AppendToStream(AStream,
' ' + StrUtils.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
s: String;
begin
Unused(AValue, ACol, ARow);
s := FWorksheet.ReadAsText(ACell);
AppendToStream(AStream,
'' + s + ' ');
end;
procedure TsHTMLWriter.WriteError(AStream: TStream;
const ARow, ACol: Cardinal; const AValue: TsErrorValue; ACell: PCell);
var
s: String;
begin
Unused(AValue, ACol, ARow);
s := FWOrksheet.ReadAsText(ACell);
AppendToStream(AStream,
'' + s + ' ');
end;
{ HTML does not support formulas, but we can write the formula results to
to stream. }
procedure TsHTMLWriter.WriteFormula(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell);
begin
if ACell = nil then
exit;
case ACell^.ContentType of
cctBool : WriteBool(AStream, ARow, ACol, ACell^.BoolValue, ACell);
cctEmpty : ;
cctDateTime : WriteDateTime(AStream, ARow, ACol, ACell^.DateTimeValue, ACell);
cctNumber : WriteNumber(AStream, ARow, ACol, ACell^.NumberValue, ACell);
cctUTF8String: WriteLabel(AStream, ARow, ACol, ACell^.UTF8StringValue, ACell);
cctError : ;
end;
end;
{ Writes a LABEL cell to the stream. }
procedure TsHTMLWriter.WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: string; ACell: PCell);
const
ESCAPEMENT_TAG: array[TsFontPosition] of String = ('', 'sup', 'sub');
var
style: String;
i, n, len: Integer;
txt, textp, target, bookmark: String;
rtParam: TsRichTextParam;
fnt, cellfnt: TsFont;
hyperlink: PsHyperlink;
isTargetCell: Boolean;
u: TUri;
begin
Unused(ARow, ACol, AValue);
txt := ACell^.UTF8StringValue;
if txt = '' then
exit;
style := '';
cellfnt := FWorksheet.ReadCellFont(ACell);
// Hyperlink
target := '';
if FWorksheet.HasHyperlink(ACell) then
begin
hyperlink := FWorksheet.FindHyperlink(ACell);
SplitHyperlink(hyperlink^.Target, target, bookmark);
n := Length(hyperlink^.Target);
i := Length(target);
len := Length(bookmark);
if (target <> '') and (pos('file:', target) = 0) then
begin
u := ParseURI(target);
if u.Protocol = '' then
target := '../' + target;
end;
// ods absolutely wants "/" path delimiters in the file uri!
FixHyperlinkPathdelims(target);
if (bookmark <> '') then
target := target + '#' + bookmark;
end;
// Activate hyperlink target if it is within the same file
isTargetCell := IsHyperlinkTarget(ACell, bookmark);
if isTargetCell then bookmark := ' id="' + bookmark + '"' else bookmark := '';
// No hyperlink, normal text only
if Length(ACell^.RichTextParams) = 0 then
begin
// Standard text formatting
ValidXMLText(txt);
txt := LineEndingToBR(txt);
if target <> '' then
txt := Format('%s', [target, txt]);
if cellFnt.Position <> fpNormal then
txt := Format('<%0:s>%1:s%0:s>', [ESCAPEMENT_TAG[cellFnt.Position], txt]);
AppendToStream(AStream,
'' + txt + ' ')
end else
begin
// "Rich-text" formatted string
len := UTF8Length(AValue);
textp := '' else
textp := textp + '';
AppendToStream(AStream, textp);
end;
end;
{ Writes a number cell to the stream. }
procedure TsHTMLWriter.WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: double; ACell: PCell);
var
s: String;
begin
Unused(ARow, ACol, AValue);
s := FWorksheet.ReadAsText(ACell, FWorkbook.FormatSettings);
AppendToStream(AStream,
'' + s + ' ');
end;
procedure TsHTMLWriter.WriteStyles(AStream: TStream);
var
i: Integer;
fmt: PsCellFormat;
fmtStr: String;
begin
AppendToStream(AStream,
'' + LineEnding);
end;
procedure TsHTMLWriter.WriteToStream(AStream: TStream; AParams: TsStreamParams = []);
begin
FWindowsClipboardMode := (spWindowsClipboardHTML in AParams);
if FWindowsClipboardMode then
begin
AppendToStream(AStream, Format(
NATIVE_HEADER, [0, 0, 0, 0])); // value will be replaced at end
InternalWriteToStream(AStream);
AStream.Position := 0;
AppendToStream(AStream, Format(
NATIVE_HEADER, [FStartHTMLPos, FEndHTMLPos, FStartFragmentPos, FEndFragmentPos]));
end else
InternalWriteToStream(AStream);
end;
procedure TsHTMLWriter.WriteToStrings(AStrings: TStrings;
AParams: TsStreamParams = []);
var
Stream: TStream;
begin
Stream := TStringStream.Create('');
try
WriteToStream(Stream, AParams);
Stream.Position := 0;
AStrings.LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
procedure TsHTMLWriter.WriteWorksheet(AStream: TStream; ASheet: TsWorksheet);
var
r, rFirst, rLast: LongInt;
c, cFirst, cLast: LongInt;
cell: PCell;
col: PCol;
row: PRow;
style, s: String;
fixedLayout: Boolean;
fmt: PsCellFormat;
begin
FWorksheet := ASheet;
rFirst := FWorksheet.GetFirstRowIndex;
cFirst := FWorksheet.GetFirstColIndex;
rLast := FWorksheet.GetLastOccupiedRowIndex;
cLast := FWorksheet.GetLastOccupiedColIndex;
fixedLayout := false;
for c:=cFirst to cLast do
begin
col := FWorksheet.GetCol(c);
if col <> nil then
begin
fixedLayout := true;
break;
end;
end;
style := GetFontAsStyle(DEFAULT_FONTINDEX);
style := style + 'border-collapse:collapse; ';
if soShowGridLines in FWorksheet.Options then
style := style + GetGridBorderAsStyle;
if fixedLayout then
style := style + 'table-layout:fixed; '
else
style := style + 'table-layout:auto; width:100%; ';
AppendToStream(AStream,
'' + LineEnding +
' ');
end;
initialization
InitFormatSettings(HTMLParams.FormatSettings);
// Registers this reader / writer in fpSpreadsheet
sfidHTML := RegisterSpreadFormat(sfHTML,
TsHTMLReader, TsHTMLWriter,
STR_FILEFORMAT_HTML, 'HTML', [STR_HTML_EXTENSION, '.htm']
);
end.
|
---|