diff --git a/components/fpspreadsheet/fpshtml.pas b/components/fpspreadsheet/fpshtml.pas
index bed134042..7764ae617 100644
--- a/components/fpspreadsheet/fpshtml.pas
+++ b/components/fpspreadsheet/fpshtml.pas
@@ -28,12 +28,17 @@ type
FInHeader: Boolean;
FTableCounter: Integer;
FCurrRow, FCurrCol: LongInt;
- FCelLText: String;
+ FCurrCellFormat: TsCellFormat;
+ FCellFont: TsFont;
+ FCellText: String;
FAttrList: TsHTMLAttrList;
FColSpan, FRowSpan: Integer;
FHRef: String;
+ procedure ExtractBackgroundColor;
procedure ExtractHRef;
procedure ExtractMergedRange;
+ procedure InitFont(AFont: TsFont);
+ procedure InitCellFormat;
procedure TagFoundHandler(NoCaseTag, ActualTag: string);
procedure TextFoundHandler(AText: String);
protected
@@ -419,10 +424,12 @@ begin
ReplaceFormatSettings(FFormatSettings, FWorkbook.FormatSettings);
FTableCounter := -1;
FAttrList := TsHTMLAttrList.Create;
+ FCellFont := TsFont.Create;
end;
destructor TsHTMLReader.Destroy;
begin
+ FreeAndNil(FCellFont);
FreeAndNil(FAttrList);
FreeAndNil(parser);
inherited Destroy;
@@ -438,13 +445,24 @@ var
decs: Integer;
currSym: String;
warning: String;
+ fntIndex: Integer;
begin
// Empty strings are blank cells -- nothing to do
if (AText = '') then
exit;
+ // Create cell
cell := FWorksheet.AddCell(ARow, ACol);
+ // Format
+ fntIndex := FWorkbook.FindFont(FCellFont.FontName, FCellFont.Size,
+ FCellFont.Style, FCellFont.Color, FCellFont.Position);
+ if fntIndex = -1 then
+ fntIndex := FWorkbook.AddFont(FCellFont.FontName, FCellFont.Size,
+ FCellFont.Style, FCellFont.Color, FCellFont.Position);
+ FCurrCellFormat.FontIndex := fntIndex;
+ cell^.FormatIndex := FWorkbook.AddCellFormat(FCurrCellFormat);
+
// Merged cells
if (FColSpan > 0) or (FRowSpan > 0) then begin
FWorksheet.MergeCells(ARow, ACol, ARow + FRowSpan, ACol + FColSpan);
@@ -497,6 +515,22 @@ begin
FWorksheet.WriteUTF8Text(cell, AText);
end;
+procedure TsHTMLReader.ExtractBackgroundColor;
+var
+ idx: Integer;
+begin
+ idx := FAttrList.IndexOfName('bgcolor'); // html tag
+ if idx = -1 then
+ idx := FAttrList.IndexOfName('background-color'); // value taken from "style"
+ if idx > -1 then
+ begin
+ FCurrCellFormat.Background.BgColor := HTMLColorStrToColor(FAttrList[idx].Value);
+ FCurrCellFormat.Background.FgColor := FCurrCellFormat.Background.BgColor;
+ FCurrCellFormat.Background.Style := fsSolidFill; // No other fill styles in html
+ Include(FCurrCellFormat.UsedFormattingFields, uffBackground);
+ end;
+end;
+
procedure TsHTMLReader.ExtractHRef;
var
idx: Integer;
@@ -522,6 +556,27 @@ begin
// -1 to compensate for correct determination of the range end cell
end;
+procedure TsHTMLReader.InitFont(AFont: TsFont);
+var
+ fnt: TsFont;
+begin
+ fnt := FWorkbook.GetDefaultFont;
+ AFont.FontName := fnt.FontName;
+ AFont.Size := fnt.Size;
+ AFont.Style := fnt.Style;
+ AFont.Color := fnt.Color;
+ AFont.Position := fnt.Position;
+end;
+
+procedure TsHTMLReader.InitCellFormat;
+begin
+ InitFormatRecord(FCurrCellFormat);
+ InitFont(FCellFont);
+
+ // HTML tables, by default, have word-wrapped cell texts.
+ Include(FCurrCellFormat.UsedFormattingFields, uffWordwrap);
+end;
+
procedure TsHTMLReader.ReadFromStream(AStream: TStream);
var
list: TStringList;
@@ -581,8 +636,10 @@ begin
FInCell := true;
inc(FCurrCol);
FCellText := '';
+ InitCellFormat;
FAttrList.Parse(ActualTag);
ExtractMergedRange;
+ ExtractBackgroundColor;
end else
if ((NoCaseTag = '| ') or (pos(' | -1 then ParseStyle(Items[i].Value);
+end;
+
+{ AStyle is the value part of a 'style="...."' HTML string. Splits the into
+ individual records at the semicolons (;) and into name-value pairs at the
+ colon (:). Adds the name-value pairs to the list. }
+procedure TsHTMLAttrList.ParseStyle(AStyle: String);
+var
+ i, len: Integer;
+ value, nam: String;
+begin
+ i := 1;
+ len := Length(AStyle);
+
+ // skip white space
+ while (i <= len) and (AStyle[i] = ' ') do inc(i);
+
+ // iterate through string
+ nam := '';
+ while (i <= len) do
+ begin
+ case AStyle[i] of
+ ':': begin // name-value separator
+ while (i <= len) and (AStyle[i] = ' ') do inc(i); // skip white space
+ value := '';
+ while (i <= len) and (AStyle[i] <> ';') do
+ value := value + AStyle[i];
+ inc(i); // skip final ';'
+ Add(TsHTMLAttr.Create(lowercase(nam), value));
+ nam := '';
+ end;
+ ' ': ;
+ else nam := nam + AStyle[i];
+ end;
+ inc(i);
+ end;
end;
procedure TsHTMLAttrList.SetItem(AIndex: Integer; AValue: TsHTMLAttr);
diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas
index 1ecb152d1..096a4b537 100644
--- a/components/fpspreadsheet/fpsutils.pas
+++ b/components/fpspreadsheet/fpsutils.pas
@@ -1474,6 +1474,10 @@ begin
if AValue[1] = '#' then begin
AValue[1] := '$';
Result := LongRGBToExcelPhysical(DWord(StrToInt(AValue)));
+ end else
+ if AValue[1] in ['0'..'9','A'..'F', 'a'..'f'] then begin
+ AValue := '$' + AValue;
+ Result := LongRGBToExcelPhysical(DWord(StrToInt(AValue)));
end else begin
AValue := lowercase(AValue);
if AValue = 'red' then
|