From 9bf5e60e906fc2b457d7beeb02e84ec334996462 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Tue, 28 Jul 2015 22:13:48 +0000 Subject: [PATCH] fpspreadsheet: Initial commit of html writer. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4218 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../examples/visual/fpsctrls/main.lfm | 17 +- .../examples/visual/fpsctrls/main.pas | 19 +- components/fpspreadsheet/fpsallformats.pas | 3 +- components/fpspreadsheet/fpshtml.pas | 572 ++++++++++++++++++ components/fpspreadsheet/fpsopendocument.pas | 8 +- components/fpspreadsheet/fpstypes.pas | 7 +- components/fpspreadsheet/fpsutils.pas | 43 +- .../fpspreadsheet/laz_fpspreadsheet.lpk | 6 +- .../fpspreadsheet/laz_fpspreadsheet.pas | 2 +- 9 files changed, 648 insertions(+), 29 deletions(-) create mode 100644 components/fpspreadsheet/fpshtml.pas diff --git a/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm b/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm index 0eb128bcf..80a618109 100644 --- a/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm +++ b/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 diff --git a/components/fpspreadsheet/examples/visual/fpsctrls/main.pas b/components/fpspreadsheet/examples/visual/fpsctrls/main.pas index 7f2d2e4bb..275d060f9 100644 --- a/components/fpspreadsheet/examples/visual/fpsctrls/main.pas +++ b/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 diff --git a/components/fpspreadsheet/fpsallformats.pas b/components/fpspreadsheet/fpsallformats.pas index 2cf2c860a..dc96c71fc 100755 --- a/components/fpspreadsheet/fpsallformats.pas +++ b/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 diff --git a/components/fpspreadsheet/fpshtml.pas b/components/fpspreadsheet/fpshtml.pas new file mode 100644 index 000000000..24e5146f2 --- /dev/null +++ b/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, + ''); + 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, + ''); +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, + '' + s + ''); +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, + '' + s + ''); +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, + '' + 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 + 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, + '' + txt + '') + end else + begin + // "Rich-text" formatting + cellfnt := FWorksheet.ReadCellFont(ACell); + len := UTF8Length(AValue); + textp := ''; + 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', [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', [ESCAPEMENT_TAG[fnt.Position], txt]); + textp := textp + '' + txt + ''; + 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 + ''; + AppendToStream(AStream, textp); + end; + +{ + L := TStringList.Create; + try + L.Text := ACell^.UTF8StringValue; + if L.Count = 1 then + AppendToStream(AStream, + '' + s + '') + else + for i := 0 to L.Count-1 do + AppendToStream(AStream, '

' + L[i] + '

'); + 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, + '' + s + ''); +end; + +procedure TsHTMLWriter.WriteToStream(AStream: TStream); +begin + AppendToStream(AStream, + '' + + '' + + ''+ + // 'Written by FPSpreadsheet' + + '' + + ''); + WriteBody(AStream); + AppendToStream(AStream, + ''); +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, + '
' + + ''); + for r := rFirst to rLast do begin + AppendToStream(AStream, + ''); + 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, + '') + else + begin + AppendToStream(AStream, + ''); + WriteCellToStream(AStream, cell); + AppendToStream(AStream, + ''); + end; + end; + AppendToStream(AStream, + ''); + end; + AppendToStream(AStream, + '
' + + '
'); +end; + +initialization + RegisterSpreadFormat(nil, TsHTMLWriter, sfHTML); + +end. + diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index 561ff0ca1..e16de2c4c 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -4794,12 +4794,10 @@ 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]); + 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); + Result := Result + Format('fo:font-size="%.1fpt" style:font-size-asian="%.1fpt" style:font-size-complex="%.1fpt" ', + [AFont.Size, AFont.Size, AFont.Size], FPointSeparatorSettings); if fssBold in AFont.Style then Result := Result + 'fo:font-weight="bold" style:font-weight-asian="bold" style:font-weight-complex="bold" '; diff --git a/components/fpspreadsheet/fpstypes.pas b/components/fpspreadsheet/fpstypes.pas index b83e9a9c6..bc4c2fd94 100644 --- a/components/fpspreadsheet/fpstypes.pas +++ b/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 comma-separated-values file } STR_COMMA_SEPARATED_EXTENSION = '.csv'; + {@@ Default extension for HTML files } + STR_HTML_EXTENSION = '.html'; {@@ Default extension of wikitable files in pipes format} STR_WIKITABLE_PIPES_EXTENSION = '.wikitable_pipes'; {@@ Default extension of wikitable files in wikimedia 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 diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index 6cde5164b..c97cd5081 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/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; - WrkStr, AppoSt:ansistring; + Idx: Integer; + AppoSt:ansistring; begin - WrkStr:=''; - - for Idx:=1 to Length(AText) do + Result := ''; + idx := 1; + while idx <= Length(AText) do begin case AText[Idx] of '&': begin - AppoSt:=Copy(AText, Idx, 6); - + AppoSt := Copy(AText, Idx, 6); if (Pos('&', AppoSt) = 1) or (Pos('<', AppoSt) = 1) or (Pos('>', AppoSt) = 1) or @@ -1522,26 +1524,33 @@ begin (Pos('%', 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 + '&'; + Result := Result + '&'; end; end; - '<': WrkStr:=WrkStr + '<'; - '>': WrkStr:=WrkStr + '>'; - '"': WrkStr:=WrkStr + '"'; - '''':WrkStr:=WrkStr + '''; - '%': WrkStr:=WrkStr + '%'; + '<': Result := Result + '<'; + '>': Result := Result + '>'; + '"': Result := Result + '"'; + '''':Result := Result + '''; + '%': Result := Result + '%'; + #10: begin + Result := Result + '
'; + if (idx < Length(AText)) and (AText[idx+1] = #13) then inc(idx); + end; + #13: begin + Result := Result + '
'; + if (idx < Length(AText)) and (AText[idx+1] = #10) then inc(idx); + end; { #10: WrkStr := WrkStr + ' '; #13: WrkStr := WrkStr + ' '; } else - WrkStr:=WrkStr + AText[Idx]; + Result := Result + AText[Idx]; end; + inc(idx); end; - - Result:=WrkStr; end; {@@ ---------------------------------------------------------------------------- diff --git a/components/fpspreadsheet/laz_fpspreadsheet.lpk b/components/fpspreadsheet/laz_fpspreadsheet.lpk index ae6dfc717..2df0cae7c 100644 --- a/components/fpspreadsheet/laz_fpspreadsheet.lpk +++ b/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)."/> - + @@ -170,6 +170,10 @@ This package is all you need if you don't want graphical components (like grids + + + + diff --git a/components/fpspreadsheet/laz_fpspreadsheet.pas b/components/fpspreadsheet/laz_fpspreadsheet.pas index f1a5d79b3..debf32f1a 100644 --- a/components/fpspreadsheet/laz_fpspreadsheet.pas +++ b/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