fpspreadsheet: Initial commit of html writer.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4218 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/examples/visual/fpsctrls/main.lfm

@@ -954,7 +954,7 @@ object MainForm: TMainForm
       Category = 'File'
       Caption = 'Save &as ...'
       Dialog.Title = 'AcSaveFileAs'
-      Dialog.Filter = 'Excel XML spreadsheet (*.xlsx)|*.xlsx|Excel 97-2003 spreadsheets (*.xls)|*.xls|Excel 5 spreadsheet (*.xls)|*.xls|Excel 2.1 spreadsheets (*.xls)|*.xls|LibreOffice/OpenOffice spreadsheet (*.ods)|*.ods|Comma-delimited files (*.csv)|*.csv|WikiTable (WikiMedia-Format, *.wikitable_wikimedia)|*.wikitable_wikimedia'
+      Dialog.Filter = 'Excel XML spreadsheet (*.xlsx)|*.xlsx|Excel 97-2003 spreadsheets (*.xls)|*.xls|Excel 5 spreadsheet (*.xls)|*.xls|Excel 2.1 spreadsheets (*.xls)|*.xls|LibreOffice/OpenOffice spreadsheet (*.ods)|*.ods|Comma-delimited files (*.csv)|*.csv|HTML files (*.html; *.htm)|*.html;*.htm|WikiTable (WikiMedia-Format, *.wikitable_wikimedia)|*.wikitable_wikimedia'
       Hint = 'Save spreadsheet'
       ImageIndex = 45
       BeforeExecute = AcFileSaveAsBeforeExecute
@@ -1562,6 +1562,14 @@ object MainForm: TMainForm
       OnExecute = AcSearchExecute
       ShortCut = 16454
     end
+    object AcShowGridLines: TAction
+      Category = 'View'
+      AutoCheck = True
+      Caption = 'Grid lines'
+      Checked = True
+      OnExecute = AcShowGridLinesExecute
+      OnUpdate = AcShowGridLinesUpdate
+    end
   end
   object ImageList: TImageList
     left = 176
@@ -5093,6 +5101,13 @@ object MainForm: TMainForm
     end
     object MnuView: TMenuItem
       Caption = 'View'
+      object MenuItem134: TMenuItem
+        Action = AcShowGridLines
+        AutoCheck = True
+      end
+      object MenuItem133: TMenuItem
+        Caption = '-'
+      end
       object MenuItem52: TMenuItem
         Action = AcViewInspector
         AutoCheck = True

components/fpspreadsheet/examples/visual/fpsctrls/main.pas

@@ -22,6 +22,7 @@ type
     AcSettingsCurrency: TAction;
     AcSettingsFormatSettings: TAction;
     AcSearch: TAction;
+    AcShowGridLines: TAction;
     AcViewInspector: TAction;
     ActionList: TActionList;
     AcFileExit: TFileExit;
@@ -64,6 +65,8 @@ type
     MenuItem130: TMenuItem;
     MenuItem131: TMenuItem;
     MenuItem132: TMenuItem;
+    MenuItem133: TMenuItem;
+    MenuItem134: TMenuItem;
     MnuSettings: TMenuItem;
     MenuItem11: TMenuItem;
     MenuItem12: TMenuItem;
@@ -342,6 +345,8 @@ type
     procedure AcSettingsCSVParamsExecute(Sender: TObject);
     procedure AcSettingsCurrencyExecute(Sender: TObject);
     procedure AcSettingsFormatSettingsExecute(Sender: TObject);
+    procedure AcShowGridLinesExecute(Sender: TObject);
+    procedure AcShowGridLinesUpdate(Sender: TObject);
     procedure AcViewInspectorExecute(Sender: TObject);
     procedure HyperlinkHandler(Sender: TObject; ACaption: String;
       var AHyperlink: TsHyperlink);
@@ -411,6 +416,7 @@ begin
     6: WorkbookSource.FileFormat := sfExcel2;        // Excel 2.1
     7: WorkbookSource.FileFormat := sfOpenDocument;  // Open/LibreOffice
     8: WorkbookSource.FileFormat := sfCSV;           // Text files
+//    9: WorkbookSource.FileFormat := sfHTML;          // HTML files
   end;
   WorkbookSource.FileName := UTF8ToAnsi(AcFileOpen.Dialog.FileName);  // this loads the file
   UpdateCaption;
@@ -430,7 +436,8 @@ begin
       4: fmt := sfExcel2;
       5: fmt := sfOpenDocument;
       6: fmt := sfCSV;
-      7: fmt := sfWikiTable_WikiMedia;
+      7: fmt := sfHTML;
+      8: fmt := sfWikiTable_WikiMedia;
     end;
     WorkbookSource.SaveToSpreadsheetFile(UTF8ToAnsi(AcFileSaveAs.Dialog.FileName), fmt);
     UpdateCaption;
@@ -537,6 +544,16 @@ begin
   end;
 end;
 
+procedure TMainForm.AcShowGridLinesExecute(Sender: TObject);
+begin
+  WorksheetGrid.ShowGridLines := AcShowGridLines.Checked;
+end;
+
+procedure TMainForm.AcShowGridLinesUpdate(Sender: TObject);
+begin
+  AcShowGridLines.Checked := WorksheetGrid.ShowGridLines;
+end;
+
 { Toggles the spreadsheet inspector on and off }
 procedure TMainForm.AcViewInspectorExecute(Sender: TObject);
 begin

components/fpspreadsheet/fpsallformats.pas

@@ -10,7 +10,8 @@ unit fpsallformats;
 interface
 
 uses
-  xlsbiff2, xlsbiff5, xlsbiff8, fpsopendocument, xlsxooxml, wikitable, fpscsv;
+  xlsbiff2, xlsbiff5, xlsbiff8, fpsopendocument, xlsxooxml, wikitable,
+  fpscsv, fpshtml;
 
 implementation
 

components/fpspreadsheet/fpshtml.pas

@@ -0,0 +1,572 @@
+unit fpsHTML;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fasthtmlparser,
+  fpstypes, fpspreadsheet, fpsReaderWriter;
+
+type            (*
+  TsHTMLReader = class(TsCustomSpreadReader)
+  private
+    FWorksheetName: String;
+    FFormatSettings: TFormatSettings;
+    function IsBool(AText: String; out AValue: Boolean): Boolean;
+    function IsDateTime(AText: String; out ADateTime: TDateTime;
+      out ANumFormat: TsNumberFormat): Boolean;
+    function IsNumber(AText: String; out ANumber: Double; out ANumFormat: TsNumberFormat;
+      out ADecimals: Integer; out ACurrencySymbol, AWarning: String): Boolean;
+    function IsQuotedText(var AText: String): Boolean;
+    procedure ReadCellValue(ARow, ACol: Cardinal; AText: String);
+  protected
+    procedure ReadBlank(AStream: TStream); override;
+    procedure ReadFormula(AStream: TStream); override;
+    procedure ReadLabel(AStream: TStream); override;
+    procedure ReadNumber(AStream: TStream); override;
+  public
+    constructor Create(AWorkbook: TsWorkbook); override;
+    procedure ReadFromFile(AFileName: String); override;
+    procedure ReadFromStream(AStream: TStream); override;
+    procedure ReadFromStrings(AStrings: TStrings); override;
+  end;
+              *)
+  TsHTMLWriter = class(TsCustomSpreadWriter)
+  private
+    FFormatSettings: TFormatSettings;
+    function GetBackgroundAsStyle(AFill: TsFillPattern): String;
+    function GetBorderAsStyle(ABorder: TsCellBorders; const ABorderStyles: TsCellBorderStyles): String;
+    function GetFontAsStyle(AFontIndex: Integer): String;
+    function GetHorAlignAsStyle(AHorAlign: TsHorAlignment): String;
+    function GetTextRotation(ATextRot: TsTextRotation): String;
+    function GetVertAlignAsStyle(AVertAlign: TsVertAlignment): String;
+    function GetWordWrapAsStyle(AWordWrap: Boolean): String;
+    procedure WriteBody(AStream: TStream);
+    procedure WriteWorksheet(AStream: TStream; ASheet: TsWorksheet);
+
+  protected
+    function CellFormatAsString(ACell: PCell; ForThisTag: String): String;
+    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;
+    procedure WriteToStream(AStream: TStream); override;
+    procedure WriteToStrings(AStrings: TStrings); override;
+  end;
+
+  TsHTMLParams = record
+    SheetIndex: Integer;             // W: Index of the sheet to be written
+    TrueText: String;                // RW: String for boolean TRUE
+    FalseText: String;               // RW: String for boolean FALSE
+  end;
+
+var
+  HTMLParams: TsHTMLParams = (
+    SheetIndex: -1;       // -1 = active sheet, MaxInt = all sheets
+    TrueText: 'TRUE';
+    FalseText: 'FALSE';
+  );
+
+implementation
+
+uses
+  LazUTF8, fpsUtils;
+
+constructor TsHTMLWriter.Create(AWorkbook: TsWorkbook);
+begin
+  inherited Create(AWorkbook);
+end;
+
+function TsHTMLWriter.CellFormatAsString(ACell: PCell; ForThisTag: String): String;
+var
+  fmt: PsCellFormat;
+begin
+  Result := '';
+  if ACell <> nil then
+    fmt := FWorkbook.GetPointerToCellFormat(ACell^.FormatIndex)
+  else
+    fmt := nil;
+  case ForThisTag of
+    'td':
+      if ACell = nil then
+      begin
+        Result := 'border-collapse:collapse; ';
+        if soShowGridLines in FWorksheet.Options then
+          Result := Result + 'border:1px solid lightgrey; '
+      end else
+      begin
+        if (uffVertAlign in fmt^.UsedFormattingFields) then
+          Result := Result + GetVertAlignAsStyle(fmt^.VertAlignment);
+        if (uffBorder in fmt^.UsedFormattingFields) then
+          Result := Result + GetBorderAsStyle(fmt^.Border, fmt^.BorderStyles)
+        else begin
+          Result := Result + 'border-collapse:collapse; ';
+          if soShowGridLines in FWorksheet.Options then
+            Result := Result + 'border:1px solid lightgrey; ';
+        end;
+        if (uffBackground in fmt^.UsedFormattingFields) then
+          Result := Result + GetBackgroundAsStyle(fmt^.Background);
+        if (uffFont in fmt^.UsedFormattingFields) then
+          Result := Result + GetFontAsStyle(fmt^.FontIndex);
+        if (uffTextRotation in fmt^.UsedFormattingFields) then
+          Result := Result + GetTextRotation(fmt^.TextRotation);
+      end;
+    'div', 'p':
+      begin
+        if fmt = nil then
+          exit;
+        if (uffHorAlign in fmt^.UsedFormattingFields) and (fmt^.HorAlignment <> haDefault) then
+          Result := Result + GetHorAlignAsStyle(fmt^.HorAlignment)
+        else
+          case ACell^.ContentType of
+            cctNumber    : Result := Result + GetHorAlignAsStyle(haRight);
+            cctDateTime  : Result := Result + GetHorAlignAsStyle(haLeft);
+            cctBool      : Result := Result + GetHorAlignAsStyle(haCenter);
+            else           Result := Result + GetHorAlignAsStyle(haLeft);
+          end;
+        if (uffFont in fmt^.UsedFormattingFields) then
+          Result := Result + GetFontAsStyle(fmt^.FontIndex);   {
+        if (uffTextRotation in fmt^.UsedFormattingFields) then
+          Result := Result + GetTextRotation(fmt^.TextRotation);}
+        Result := Result + GetWordwrapAsStyle(uffWordwrap in fmt^.UsedFormattingFields);
+      end;
+  end;
+  if Result <> '' then
+    Result := ' style="' + Result +'"';
+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', 'border-left', 'border-right', 'border-bottom', '', ''
+  );
+  LINESTYLE_NAMES: array[TsLineStyle] of string = (
+    'thin solid',    // lsThin
+    'medium solid',  // lsMedium
+    'thin dashed',   // lsDashed
+    'thin dotted',   // lsDotted
+    'thick solid',   // lsThick,
+    'thin double',   // lsDouble,
+    '1px solid'      // lsHair
+  );
+var
+  cb: TsCellBorder;
+begin
+  Result := 'border-collape:collapse';
+  for cb in TsCellBorder do
+  begin
+    if BORDER_NAMES[cb] = '' then
+      continue;
+    Result := Result + BORDER_NAMES[cb] + ':' +
+      LINESTYLE_NAMES[ABorderStyles[cb].LineStyle] + ' ' +
+      ColorToHTMLColorStr(ABorderStyles[cb].Color) + ';';
+  end;
+end;
+
+function TsHTMLWriter.GetFontAsStyle(AFontIndex: Integer): String;
+var
+  fs: TFormatSettings;
+  font: TsFont;
+begin
+  fs := DefaultFormatSettings;
+  fs.DecimalSeparator := '.';
+  font := FWorkbook.GetFont(AFontIndex);
+  Result := Format('font-family:''%s'';font-size:%.1fpt;color:%s;', [
+    font.FontName, font.Size, ColorToHTMLColorStr(font.Color)], fs);
+  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.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.GetTextRotation(ATextRot: TsTextRotation): String;
+begin
+  Result := '';
+  case ATextRot of
+    trHorizontal: ;
+    rt90DegreeClockwiseRotation:
+      Result := 'writing-mode:vertical-rl;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: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'; //-moz-pre-wrap -o-pre-wrap pre-wrap;';
+                          { Firefox      Opera        Chrome  }
+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,
+    '<body>');
+  if HTMLParams.SheetIndex < 0 then      // active sheet
+    WriteWorksheet(AStream, FWorkbook.ActiveWorksheet)
+  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,
+    '</body>');
+end;
+
+{ Write boolean cell to stream formatted as string }
+procedure TsHTMLWriter.WriteBool(AStream: TStream; const ARow, ACol: Cardinal;
+  const AValue: Boolean; ACell: PCell);
+var
+  s: String;
+  style: String;
+begin
+  Unused(AStream);
+  Unused(ARow, ACol, ACell);
+  if AValue then
+    s := HTMLParams.TrueText
+  else
+    s := HTMLParams.FalseText;
+  AppendToStream(AStream,
+    '<div' + style + '>' + s + '</div>');
+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
+  style: String;
+  s: String;
+begin
+  style := CellFormatAsString(ACell, 'div');
+  s := FWorksheet.ReadAsUTF8Text(ACell);
+  AppendToStream(AStream,
+    '<div' + style + '>' + s + '</div>');
+end;
+
+procedure TsHTMLWriter.WriteError(AStream: TStream;
+  const ARow, ACol: Cardinal; const AValue: TsErrorValue; ACell: PCell);
+var
+  style: String;
+  s: String;
+begin
+  style := CellFormatAsString(ACell, 'div');
+  s := FWOrksheet.ReadAsUTF8Text(ACell);
+  AppendToStream(AStream,
+    '<div' + style + '>' + s + '</div>');
+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
+  L: TStringList;
+  style: String;
+  i, n, len: Integer;
+  txt, textp: String;
+  rtParam: TsRichTextParam;
+  fnt, cellfnt: TsFont;
+  escapement: String;
+begin
+  Unused(ARow, ACol, AValue);
+
+  txt := ACell^.UTF8StringValue;
+  if txt = '' then
+    exit;
+
+  style := CellFormatAsString(ACell, 'div');
+
+  // No hyperlink, normal text only
+  if Length(ACell^.RichTextParams) = 0 then
+  begin
+    // Standard text formatting
+    ValidXMLText(txt);
+    AppendToStream(AStream,
+      '<div' + style + '>' + txt + '</div>')
+  end else
+  begin
+    // "Rich-text" formatting
+    cellfnt := FWorksheet.ReadCellFont(ACell);
+    len := UTF8Length(AValue);
+    textp := '<div' + style + '>';
+    rtParam := ACell^.RichTextParams[0];
+    if rtParam.StartIndex > 0 then
+    begin
+      txt := UTF8Copy(AValue, 1, rtParam.StartIndex);
+      ValidXMLText(txt);
+      if cellfnt.Position <> fpNormal then
+        txt := Format('<%0:s>%1:s</%0:s>', [ESCAPEMENT_TAG[cellFnt.Position], txt]);
+      textp := textp + txt;
+    end;
+    for i := 0 to High(ACell^.RichTextParams) do
+    begin
+      rtParam := ACell^.RichTextParams[i];
+      fnt := FWorkbook.GetFont(rtParam.FontIndex);
+      style := GetFontAsStyle(rtParam.FontIndex);
+      if style <> '' then
+        style := ' style="' + style +'"';
+      n := rtParam.EndIndex - rtParam.StartIndex;
+      txt := UTF8Copy(AValue, rtParam.StartIndex+1, n);
+      ValidXMLText(txt);
+      if fnt.Position <> fpNormal then
+        txt := Format('<%0:s>%1:s</%0:s>', [ESCAPEMENT_TAG[fnt.Position], txt]);
+      textp := textp + '<span' + style +'>' + txt + '</span>';
+      if (rtParam.EndIndex < len) and (i = High(ACell^.RichTextParams)) then
+      begin
+        txt := UTF8Copy(AValue, rtParam.EndIndex+1, MaxInt);
+        ValidXMLText(txt);
+        textp := textp + txt;
+      end else
+      if (i < High(ACell^.RichTextParams)) and (rtParam.EndIndex < ACell^.RichTextParams[i+1].StartIndex)
+      then begin
+        n := ACell^.RichTextParams[i+1].StartIndex - rtParam.EndIndex;
+        txt := UTF8Copy(AValue, rtParam.EndIndex+1, n);
+        ValidXMLText(txt);
+        textp := textp + txt;
+      end;
+    end;
+    textp := textp + '</div>';
+    AppendToStream(AStream, textp);
+  end;
+
+{
+  L := TStringList.Create;
+  try
+    L.Text := ACell^.UTF8StringValue;
+    if L.Count = 1 then
+      AppendToStream(AStream,
+        '<div' + style + '>' + s + '</div>')
+    else
+    for i := 0 to L.Count-1 do
+      AppendToStream(AStream, '<p><div'+ style + '>' + L[i] + '</div></p>');
+  finally
+    L.Free;
+  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;
+  style: String;
+begin
+  Unused(AStream);
+  Unused(ARow, ACol);
+
+  style := CellFormatAsString(ACell, 'div');
+
+  {
+  if HTMLParams.NumberFormat <> '' then
+    s := Format(HTMLParams.NumberFormat, [AValue], FFormatSettings)
+  else
+  }
+  s := FWorksheet.ReadAsUTF8Text(ACell, FFormatSettings);
+  AppendToStream(AStream,
+    '<div' + style + '>' + s + '</div>');
+end;
+
+procedure TsHTMLWriter.WriteToStream(AStream: TStream);
+begin
+  AppendToStream(AStream,
+    '<!DOCTYPE html>' +
+    '<html>' +
+      '<head>'+
+    //    '<title>Written by FPSpreadsheet</title>' +
+        '<meta charset="utf-8">' +
+      '</head>');
+      WriteBody(AStream);
+  AppendToStream(AStream,
+    '</html>');
+end;
+
+procedure TsHTMLWriter.WriteToStrings(AStrings: TStrings);
+var
+  Stream: TStream;
+begin
+  Stream := TStringStream.Create('');
+  try
+    WriteToStream(Stream);
+    Stream.Position := 0;
+    AStrings.LoadFromStream(Stream);
+  finally
+    Stream.Free;
+  end;
+end;
+
+procedure TsHTMLWriter.WriteWorksheet(AStream: TStream; ASheet: TsWorksheet);
+var
+  r, rFirst, rLast: Cardinal;
+  c, cFirst, cLast: Cardinal;
+  txt: String;
+  cell: PCell;
+  style: String;
+  fixedLayout: Boolean;
+  col: PCol;
+  w: Single;
+  fs: TFormatSettings;
+begin
+  FWorksheet := ASheet;
+
+  rFirst := FWorksheet.GetFirstRowIndex;
+  cFirst := FWorksheet.GetFirstColIndex;
+  rLast := FWorksheet.GetLastOccupiedRowIndex;
+  cLast := FWorksheet.GetLastOccupiedColIndex;
+
+  fs := DefaultFormatSettings;
+  fs.DecimalSeparator := '.';
+
+  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 + 'border:1px solid lightgrey; ';
+
+  if fixedLayout then
+    style := style + 'table-layout:fixed; '
+  else
+    style := style + 'table-layout:auto; width:100%; ';
+
+  AppendToStream(AStream,
+    '<div>' +
+      '<table style="' + style + '">');
+  for r := rFirst to rLast do begin
+    AppendToStream(AStream,
+        '<tr>');
+      for c := cFirst to cLast do begin
+        cell := FWorksheet.FindCell(r, c);
+        style := CellFormatAsString(cell, 'td');
+
+        if (c = cFirst) then
+        begin
+          w := FWorksheet.DefaultColWidth;
+          if fixedLayout then
+          begin
+            col := FWorksheet.GetCol(c);
+            if col <> nil then
+              w := col^.Width;
+            style := Format(' width="%.1fpt"', [w*FWorkbook.GetDefaultFont.Size], fs) + style;
+          end;
+        end;
+
+        if (cell = nil) or (cell^.ContentType = cctEmpty) then
+          AppendToStream(AStream,
+            '<td' + style + ' />')
+        else
+        begin
+          AppendToStream(AStream,
+            '<td' + style + '>');
+          WriteCellToStream(AStream, cell);
+          AppendToStream(AStream,
+            '</td>');
+        end;
+      end;
+    AppendToStream(AStream,
+        '</tr>');
+  end;
+  AppendToStream(AStream,
+      '</table>' +
+    '</div>');
+end;
+
+initialization
+  RegisterSpreadFormat(nil, TsHTMLWriter, sfHTML);
+
+end.
+

components/fpspreadsheet/fpsopendocument.pas

@@ -4794,10 +4794,8 @@ begin
   defFnt := Workbook.GetDefaultFont;
   if AFont = nil then AFont := defFnt;
 
-//  if AFont.FontName <> defFnt.FontName then
   Result := Result + Format('style:font-name="%s" ', [AFont.FontName]);
 
-//  if AFont.Size <> defFnt.Size then
   Result := Result + Format('fo:font-size="%.1fpt" style:font-size-asian="%.1fpt" style:font-size-complex="%.1fpt" ',
     [AFont.Size, AFont.Size, AFont.Size], FPointSeparatorSettings);
 

components/fpspreadsheet/fpstypes.pas

@@ -19,7 +19,8 @@ uses
 type
   {@@ File formats supported by fpspreadsheet }
   TsSpreadsheetFormat = (sfExcel2, sfExcel5, sfExcel8,
-   sfOOXML, sfOpenDocument, sfCSV, sfWikiTable_Pipes, sfWikiTable_WikiMedia);
+   sfOOXML, sfOpenDocument, sfCSV, sfHTML,
+   sfWikiTable_Pipes, sfWikiTable_WikiMedia);
 
   {@@ Flag set during reading or writing of a workbook }
   TsReadWriteFlag = (rwfNormal, rwfRead, rwfWrite);
@@ -40,6 +41,8 @@ const
   STR_OPENDOCUMENT_CALC_EXTENSION = '.ods';
   {@@ Default extension of <b>comma-separated-values</b> file }
   STR_COMMA_SEPARATED_EXTENSION = '.csv';
+  {@@ Default extension for <b>HTML</b> files }
+  STR_HTML_EXTENSION = '.html';
   {@@ Default extension of <b>wikitable files</b> in <b>pipes</b> format}
   STR_WIKITABLE_PIPES_EXTENSION = '.wikitable_pipes';
   {@@ Default extension of <b>wikitable files</b> in <b>wikimedia</b> format }
@@ -59,7 +62,7 @@ const
   {@@ Index of bold default font in workbook's font list }
   BOLD_FONTINDEX = 2;
   {@@ Index of italic default font in workbook's font list - not used directly }
-  INTALIC_FONTINDEX = 3;
+  ITALIC_FONTINDEX = 3;
 
   {@@ Takes account of effect of cell margins on row height by adding this
       value to the nominal row height. Note that this is an empirical value

components/fpspreadsheet/fpsutils.pas

@@ -800,6 +800,7 @@ begin
     sfooxml               : Result := 'OOXML';
     sfOpenDocument        : Result := 'Open Document';
     sfCSV                 : Result := 'CSV';
+    sfHTML                : Result := 'HTML';
     sfWikiTable_Pipes     : Result := 'WikiTable Pipes';
     sfWikiTable_WikiMedia : Result := 'WikiTable WikiMedia';
     else                    Result := rsUnknownSpreadsheetFormat;
@@ -821,6 +822,7 @@ begin
     sfOOXML               : Result := STR_OOXML_EXCEL_EXTENSION;
     sfOpenDocument        : Result := STR_OPENDOCUMENT_CALC_EXTENSION;
     sfCSV                 : Result := STR_COMMA_SEPARATED_EXTENSION;
+    sfHTML                : Result := STR_HTML_EXTENSION;
     sfWikiTable_Pipes     : Result := STR_WIKITABLE_PIPES_EXTENSION;
     sfWikiTable_WikiMedia : Result := STR_WIKITABLE_WIKIMEDIA_EXTENSION;
     else                    raise Exception.Create(rsUnknownSpreadsheetFormat);
@@ -846,6 +848,7 @@ begin
     STR_OOXML_EXCEL_EXTENSION         : SheetType := sfOOXML;
     STR_OPENDOCUMENT_CALC_EXTENSION   : SheetType := sfOpenDocument;
     STR_COMMA_SEPARATED_EXTENSION     : SheetType := sfCSV;
+    STR_HTML_EXTENSION, '.htm'        : SheetType := sfHTML;
     STR_WIKITABLE_PIPES_EXTENSION     : SheetType := sfWikiTable_Pipes;
     STR_WIKITABLE_WIKIMEDIA_EXTENSION : SheetType := sfWikiTable_WikiMedia;
     else                                Result := False;
@@ -1503,17 +1506,16 @@ end;
 -------------------------------------------------------------------------------}
 function UTF8TextToXMLText(AText: ansistring): ansistring;
 var
-  Idx:Integer;
+  Idx: Integer;
-  WrkStr, AppoSt:ansistring;
+  AppoSt:ansistring;
 begin
-  WrkStr:='';
+  Result := '';
-
+  idx := 1;
-  for Idx:=1 to Length(AText) do
+  while idx <= Length(AText) do
   begin
     case AText[Idx] of
       '&': begin
-        AppoSt:=Copy(AText, Idx, 6);
+        AppoSt := Copy(AText, Idx, 6);
-
         if (Pos('&amp;',  AppoSt) = 1) or
            (Pos('&lt;',   AppoSt) = 1) or
            (Pos('&gt;',   AppoSt) = 1) or
@@ -1522,26 +1524,33 @@ begin
            (Pos('&#37;',  AppoSt) = 1)     // %
         then begin
           //'&' is the first char of a special chat, it must not be converted
-          WrkStr:=WrkStr + AText[Idx];
+          Result := Result + AText[Idx];
         end else begin
-          WrkStr:=WrkStr + '&amp;';
+          Result := Result + '&amp;';
         end;
       end;
-      '<': WrkStr:=WrkStr + '&lt;';
+      '<': Result := Result + '&lt;';
-      '>': WrkStr:=WrkStr + '&gt;';
+      '>': Result := Result + '&gt;';
-      '"': WrkStr:=WrkStr + '&quot;';
+      '"': Result := Result + '&quot;';
-      '''':WrkStr:=WrkStr + '&apos;';
+      '''':Result := Result + '&apos;';
-      '%': WrkStr:=WrkStr + '&#37;';
+      '%': Result := Result + '&#37;';
+      #10: begin
+             Result := Result + '<br />';
+             if (idx < Length(AText)) and (AText[idx+1] = #13) then inc(idx);
+           end;
+      #13: begin
+             Result := Result + '<br />';
+             if (idx < Length(AText)) and (AText[idx+1] = #10) then inc(idx);
+           end;
       {
       #10: WrkStr := WrkStr + '&#10;';
       #13: WrkStr := WrkStr + '&#13;';
       }
     else
-      WrkStr:=WrkStr + AText[Idx];
+      Result := Result + AText[Idx];
     end;
+    inc(idx);
   end;
-
-  Result:=WrkStr;
 end;
 
 {@@ ----------------------------------------------------------------------------

components/fpspreadsheet/laz_fpspreadsheet.lpk

@@ -29,7 +29,7 @@
 This package is all you need if you don't want graphical components (like grids and charts)."/>
     <License Value="LGPL with static linking exception. This is the same license as is used in the LCL (Lazarus Component Library)."/>
     <Version Major="1" Minor="7"/>
-    <Files Count="35">
+    <Files Count="36">
       <Item1>
         <Filename Value="fpolestorage.pas"/>
         <UnitName Value="fpolestorage"/>
@@ -170,6 +170,10 @@ This package is all you need if you don't want graphical components (like grids
         <Filename Value="fpspalette.pas"/>
         <UnitName Value="fpsPalette"/>
       </Item35>
+      <Item36>
+        <Filename Value="fpshtml.pas"/>
+        <UnitName Value="fpsHTML"/>
+      </Item36>
     </Files>
     <RequiredPkgs Count="2">
       <Item1>

components/fpspreadsheet/laz_fpspreadsheet.pas

@@ -13,7 +13,7 @@ uses
   uvirtuallayer_ole_helpers, uvirtuallayer_ole_types, uvirtuallayer_stream, 
   fpolebasic, wikitable, fpsNumFormatParser, fpsfunc, fpsRPN, fpsStrings, 
   fpscsv, fpsCsvDocument, fpspatches, fpsTypes, xlsEscher, fpsReaderWriter, 
-  fpsNumFormat, fpsclasses, fpsHeaderFooterParser, fpsPalette;
+  fpsNumFormat, fpsclasses, fpsHeaderFooterParser, fpsPalette, fpsHTML;
 
 implementation