Exporting Excel files to HTML (Delphi)
Note
This demo is available in your FlexCel installation at <FlexCel Install Folder>\Demo\Delphi\Modules\25.Printing and Exporting\40.Export HTML and also at https://github.com/tmssoftware/TMS-FlexCel.VCL-demos/tree/master/Delphi/Modules/25.Printing and Exporting/40.Export HTML
Overview
FlexCel can natively export an Excel file to HTML, in many formats like XHTML 1.1, HTML 3.2, HTML 4.1 strict or HTML 5.
Concepts
HTML is a format that makes emphasis in semantics over presentation, and because of this reason the HTML file will not be as faithful to the original file as a PDF. PDF are targeted especially for handling presentation. Anyway, the output is very similar and in many ways better (and more cross-browser) than the HTML generated by Excel itself when saving to HTML.
Among the things that are not exported you can find:
ActiveX objects
3D Charts (They will be rendered as 2d)
Not common AutoShapes (most used Autoshapes, as rectangles, rounded rectangles, ellipses, etc are exported)
Files
UExportHTML.pas
unit UExportHTML;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, ImgList, ActnList, StdCtrls,
Tabs, Grids,ExtCtrls, ComCtrls, ToolWin,
{$if CompilerVersion >= 23.0} System.UITypes, {$IFEND}
ShellAPI, UMailDialog,
FlexCel.VCLSupport, FlexCel.Core, FlexCel.XlsAdapter, FlexCel.Render;
type
TFExportHTML = class(TForm)
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton6: TToolButton;
Actions: TActionList;
ActionOpen: TAction;
ActionExportAsHTML: TAction;
ActionExportAsMHTML: TAction;
ActionClose: TAction;
OpenDialog: TOpenDialog;
ToolbarImages: TImageList;
ToolButton5: TToolButton;
Panel1: TPanel;
Label1: TLabel;
cbExportObject: TComboBox;
cbSheet: TComboBox;
Label2: TLabel;
Panel2: TPanel;
Label3: TLabel;
chGridLines: TCheckBox;
chPrintHeadings: TCheckBox;
Panel3: TPanel;
Label4: TLabel;
cbImages: TCheckBox;
cbComments: TCheckBox;
cbHyperlinks: TCheckBox;
cbHeadersFooters: TCheckBox;
Panel4: TPanel;
Label5: TLabel;
cbOutlook2007: TCheckBox;
cbIe6Png: TCheckBox;
Panel5: TPanel;
Label6: TLabel;
cbLeft: TCheckBox;
cbTop: TCheckBox;
cbRight: TCheckBox;
cbBottom: TCheckBox;
Panel6: TPanel;
Label7: TLabel;
Label8: TLabel;
cbHtmlVersion: TComboBox;
cbFileFormat: TComboBox;
Panel7: TPanel;
Label9: TLabel;
edTop: TEdit;
Label10: TLabel;
Label11: TLabel;
edBottom: TEdit;
Label12: TLabel;
edLeft: TEdit;
edRight: TEdit;
Label13: TLabel;
Label14: TLabel;
Panel8: TPanel;
Label15: TLabel;
edSheetSeparator: TEdit;
Panel9: TPanel;
Label16: TLabel;
edBodyStart: TEdit;
Panel10: TPanel;
Label17: TLabel;
edImages: TEdit;
Panel11: TPanel;
edCss: TEdit;
cbCss: TCheckBox;
cbReplaceFonts: TCheckBox;
chFormulaText: TCheckBox;
ExportDialog: TSaveDialog;
sbSVG: TCheckBox;
Label18: TLabel;
cbEmbedImages: TCheckBox;
ToolbarImages_100Scale: TImageList;
ToolbarImages_300Scale: TImageList;
procedure ActionCloseExecute(Sender: TObject);
procedure ActionOpenExecute(Sender: TObject);
procedure cbSheetChange(Sender: TObject);
procedure ActionExportAsHTMLExecute(Sender: TObject);
procedure cbExportObjectChange(Sender: TObject);
procedure cbCssClick(Sender: TObject);
procedure ActionExportAsMHTMLExecute(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
Html: TFlexCelHtmlExport;
procedure LoadSheetConfig;
function HasFileOpen: Boolean;
function LoadPreferences: Boolean;
procedure HtmlFont(const sender: TObject; const e: THtmlFontEventArgs);
function GenerateMHTML: string;
public
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
{ Public declarations }
end;
var
FExportHTML: TFExportHTML;
implementation
uses IOUtils, UFlexCelHDPI;
{$R *.dfm}
constructor TFExportHTML.Create(aOwner: TComponent);
begin
inherited;
Html := TFlexCelHtmlExport.Create;
Html.AllowOverwritingFiles := true;
Html.HtmlFont := HtmlFont;
end;
destructor TFExportHTML.Destroy;
begin
Html.Workbook.Free;
FreeAndNil(Html);
inherited;
end;
procedure TFExportHTML.FormCreate(Sender: TObject);
begin
RegisterForHDPI(Self, nil);
end;
procedure TFExportHTML.HtmlFont(const sender: TObject; const e: THtmlFontEventArgs);
begin
if cbReplaceFonts.Checked then
begin
e.FontFamily := 'arial, sans-serif';
end;
end;
procedure TFExportHTML.ActionCloseExecute(Sender: TObject);
begin
Close;
end;
procedure TFExportHTML.ActionExportAsHTMLExecute(Sender: TObject);
var
CssFileName: String;
FileNameToOpen: String;
SelectorPosition: TSheetSelectorPositionSet;
GeneratedFiles: TArray<String>;
begin
if not HasFileOpen then
exit;
if not LoadPreferences then
exit;
if cbFileFormat.ItemIndex = 1 then
begin
Html.HtmlFileFormat := THtmlFileFormat.MHtml;
ExportDialog.FilterIndex := 2;
end else
begin
Html.HtmlFileFormat := THtmlFileFormat.Html;
ExportDialog.FilterIndex := 1;
end;
if not ExportDialog.Execute then exit;
Html.AllowOverwritingFiles := true;
Html.SavedImagesFormat := THtmlImageFormat.Png;
CssFileName := '';
if cbCss.Checked then
CssFileName := edCss.Text;
FileNameToOpen := ExportDialog.FileName;
case cbHtmlVersion.ItemIndex of
0: Html.HtmlVersion := THtmlVersion.Html_32;
2: Html.HtmlVersion := THtmlVersion.XHTML_10;
3: Html.HtmlVersion := THtmlVersion.Html_5;
else Html.HtmlVersion := THtmlVersion.Html_401;
end;
if edBodyStart.Text <> '' then
Html.ExtraInfo.BodyStart := TArray<String>.Create(edBodyStart.Text);
case cbExportObject.ItemIndex of
0:
begin
SelectorPosition := [];
if cbTop.Checked then
SelectorPosition:= SelectorPosition + [TSheetSelectorPosition.Top];
if cbLeft.Checked then
SelectorPosition:= SelectorPosition + [TSheetSelectorPosition.Left];
if cbBottom.Checked then
SelectorPosition:= SelectorPosition + [TSheetSelectorPosition.Bottom];
if cbRight.Checked then
SelectorPosition:= SelectorPosition + [TSheetSelectorPosition.Right];
Html.ExportAllVisibleSheetsAsTabs(TPath.GetDirectoryName(ExportDialog.FileName),
TPath.GetFileNameWithoutExtension(ExportDialog.FileName),
TPath.GetExtension(ExportDialog.FileName),
edImages.Text, CssFileName, TStandardSheetSelector.Create(SelectorPosition), true);
FileNameToOpen := TPath.Combine(TPath.GetDirectoryName(ExportDialog.FileName), TPath.GetFileNameWithoutExtension(ExportDialog.FileName));
FileNameToOpen := TPath.Combine(FileNameToOpen, Html.Workbook.SheetName);
FileNameToOpen := TPath.Combine(FileNameToOpen, TPath.GetExtension(ExportDialog.FileName));
end;
1:
begin
Html.ExportAllVisibleSheetsAsOneHtmlFile(ExportDialog.FileName, edImages.Text, CssFileName, edSheetSeparator.Text);
end;
2:
begin
begin
Html.Export(ExportDialog.FileName, edImages.Text, CssFileName);
end;
end;
end;
GeneratedFiles := Html.GeneratedFiles.GetHtmlFiles;
if Length(GeneratedFiles) = 0 then
begin
ShowMessage('Error: No file has been generated');
end else
begin
if MessageDlg('Do you want to open the generated file?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
ShellExecute(0, 'open', PCHAR(GeneratedFiles[0]), nil, nil, SW_SHOWNORMAL);
end;
end;
end;
procedure TFExportHTML.ActionExportAsMHTMLExecute(Sender: TObject);
var
dr: TModalResult;
begin
if not HasFileOpen then
exit;
if not Html.FixOutlook2007CssSupport then
begin
dr := MessageDlg('You have not checked "Outlook 2007 support". If any of your clients has Outlook express, you should turn this on.'#$000A#$000A'Use Outlook 2007 fix?',
TMsgDlgType.mtWarning, [mbYes, mbNo, mbCancel], 0);
if dr = mrCancel then
exit;
if dr = mrYes then
begin
cbOutlook2007.Checked := true;
Html.FixOutlook2007CssSupport := true;
end;
end;
MailDialog.GetMHTML := GenerateMHTML;
MailDialog.ShowModal;
end;
procedure TFExportHTML.ActionOpenExecute(Sender: TObject);
var
Xls: TExcelFile;
i: Int32;
begin
if not OpenDialog.Execute then exit;
if Html.Workbook = nil then Html.Workbook := TXlsFile.Create;
Html.Workbook.Open(OpenDialog.FileName);
Caption := 'Export: ' + OpenDialog.FileName;
Xls := Html.Workbook;
cbSheet.Items.Clear;
for i := 1 to Xls.SheetCount do
begin
cbSheet.Items.Add(Xls.GetSheetName(i));
end;
cbSheet.ItemIndex := Xls.ActiveSheet - 1;
LoadSheetConfig;
end;
procedure TFExportHTML.cbCssClick(Sender: TObject);
begin
edCss.Enabled := cbCss.Checked;
end;
procedure TFExportHTML.cbExportObjectChange(Sender: TObject);
begin
edSheetSeparator.Enabled := cbExportObject.ItemIndex = 1;
cbTop.Enabled := cbExportObject.ItemIndex = 0;
cbLeft.Enabled := cbExportObject.ItemIndex = 0;
cbRight.Enabled := cbExportObject.ItemIndex = 0;
cbBottom.Enabled := cbExportObject.ItemIndex = 0;
cbSheet.Enabled := cbExportObject.ItemIndex = 2;
end;
procedure TFExportHTML.cbSheetChange(Sender: TObject);
begin
Html.Workbook.ActiveSheet := cbSheet.ItemIndex + 1;
LoadSheetConfig;
end;
procedure TFExportHTML.LoadSheetConfig;
var
Xls: TExcelFile;
begin
Xls := Html.Workbook;
chGridLines.Checked := Xls.PrintGridLines;
chPrintHeadings.Checked := Xls.PrintHeadings;
chFormulaText.Checked := Xls.ShowFormulaText;
end;
function TFExportHTML.HasFileOpen: Boolean;
begin
if Html.Workbook = nil then
begin
ShowMessage('You need to open a file first.');
exit(false);
end;
Result := true;
end;
function TFExportHTML.LoadPreferences: Boolean;
var
Xls: TExcelFile;
begin
//NOTE: THERE SHOULD BE *A LOT* MORE VALIDATION OF VALUES ON THIS METHOD.
//(For example, validate that margins are between bounds)
// As this is a simple demo, they are not included.
try
Xls := Html.Workbook;
//Note: In this demo we will only apply this things to the active sheet.
//If you want to apply the settings to all the sheets, you should loop in the sheets and change them here.
Xls.PrintGridLines := chGridLines.Checked;
Xls.PrintHeadings := chPrintHeadings.Checked;
Xls.ShowFormulaText := chFormulaText.Checked;
Html.PrintRangeLeft := StrToInt(edLeft.Text);
Html.PrintRangeTop := StrToInt(edTop.Text);
Html.PrintRangeRight := StrToInt(edRight.Text);
Html.PrintRangeBottom := StrToInt(edBottom.Text);
if (sbSVG.Checked) then Html.SavedImagesFormat := THtmlImageFormat.Svg else Html.SavedImagesFormat := THtmlImageFormat.Png;
Html.EmbedImages := cbEmbedImages.Checked;
Html.FixOutlook2007CssSupport := cbOutlook2007.Checked;
Html.FixIE6TransparentPngSupport := cbIe6Png.Checked;
Html.HidePrintObjects := [];
if not cbImages.Checked then
Html.HidePrintObjects:= Html.HidePrintObjects + [THidePrintObjects.Images];
if not cbHyperlinks.Checked then
Html.HidePrintObjects:= Html.HidePrintObjects + [THidePrintObjects.Hyperlynks];
if not cbComments.Checked then
Html.HidePrintObjects:= Html.HidePrintObjects + [THidePrintObjects.Comments];
if not cbHeadersFooters.Checked then
Html.HidePrintObjects:= Html.HidePrintObjects + [THidePrintObjects.Headers, THidePrintObjects.Footers];
except
on e: Exception do
begin
ShowMessage('Error: ' + e.Message);
exit(false);
end;
end;
Result := true;
end;
function TFExportHTML.GenerateMHTML: string;
var
ms: TBytesStream;
writer: TStreamWriter;
preambleLen: integer;
begin
LoadPreferences;
Html.HtmlFileFormat := THtmlFileFormat.MHtml;
Html.AllowOverwritingFiles := true;
Html.SavedImagesFormat := THtmlImageFormat.Png;
Html.HtmlVersion := THtmlVersion.Html_401;
if edBodyStart.Text <> '' then
Html.ExtraInfo.BodyStart := TArray<String>.Create(edBodyStart.Text);
ms := TBytesStream.Create;
try
writer := TStreamWriter.Create(ms, TEncoding.UTF8);
try
Html.Export(writer, Html.Workbook.ActiveFileName, nil);
finally
FreeAndNil(writer);
end;
PreambleLen := Length(TEncoding.UTF8.GetPreamble);
exit(TEncoding.UTF8.GetString(ms.Bytes, preambleLen, ms.Size - preambleLen));
finally
FreeAndNil(ms);
end;
end;
end.
UMailDialog.pas
unit UMailDialog;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, StdCtrls, ExtCtrls,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdExplicitTLSClientServerBase, IdMessageClient, IdSMTPBase, IdSMTP, IdMessage,
{$if CompilerVersion >= 23.0} System.UITypes, {$IFEND}
IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL, StrUtils;
type
TMailDialog = class(TForm)
edFrom: TLabeledEdit;
edTo: TLabeledEdit;
edSubject: TLabeledEdit;
edOutServer: TLabeledEdit;
btnSend: TButton;
btnCancel: TButton;
Mailer: TIdSMTP;
Msg: TIdMessage;
edPort: TLabeledEdit;
edUserName: TLabeledEdit;
edPassword: TLabeledEdit;
cbUseTLS: TCheckBox;
SSLHandler: TIdSSLIOHandlerSocketOpenSSL;
procedure btnSendClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure edFromExit(Sender: TObject);
procedure cbUseTLSClick(Sender: TObject);
private
OriginalTo, OriginalFrom, OriginalServer: string;
function ValidateFields: Boolean;
procedure FillServer;
procedure FillMsgBody;
{ Private declarations }
public
GetMHTML: TFunc<string>;
{ Public declarations }
end;
var
MailDialog: TMailDialog;
implementation
{$R *.dfm}
procedure TMailDialog.cbUseTLSClick(Sender: TObject);
begin
edPort.Visible := cbUseTLS.Checked;
edUserName.Visible := cbUseTLS.Checked;
edPassword.Visible := cbUseTLS.Checked;
end;
procedure TMailDialog.edFromExit(Sender: TObject);
begin
if (OriginalTo = edTo.Text) and (OriginalFrom <> edFrom.Text) then
begin
edTo.Text := edFrom.Text;
end;
FillServer;
if edUserName.Text = '' then edUserName.Text := edFrom.Text;
end;
procedure TMailDialog.FillServer;
var
AtPos: Int32;
Server: String;
begin
if (OriginalServer = edOutServer.Text) and (OriginalFrom <> edFrom.Text) then
begin
AtPos := Pos('@', edFrom.Text);
if AtPos > 1 then
begin
Server := copy(edFrom.Text, AtPos + 1, Length(edFrom.Text));
edOutServer.Text := 'smtp.' + Server;
end;
end;
end;
procedure TMailDialog.FormCreate(Sender: TObject);
begin
OriginalTo := edTo.Text;
OriginalFrom := edFrom.Text;
OriginalServer := edOutServer.Text;
end;
function TMailDialog.ValidateFields: Boolean;
begin
if OriginalFrom = edFrom.Text then
begin
ShowMessage('Please change the ''From'' field to the user you are using to send the email');
edFrom.SetFocus;
exit(false);
end;
if OriginalTo = edTo.Text then
begin
ShowMessage('Please change the ''TO'' field to the user you want to send the email');
edTo.SetFocus;
exit(false);
end;
if OriginalServer = edOutServer.Text then
begin
ShowMessage('Please change the ''Outgoing Mail Server'' field to the pop3 server you will use to send the email.');
edOutServer.SetFocus;
exit(false);
end;
Result := true;
end;
procedure TMailDialog.FillMsgBody;
var
p, p0: integer;
s: string;
begin
//FlexCel returns both headers and body, as this is the MHTML standard. We need to separate
//them to add headers to headers and body to body. Maybe other smtp component different from
//indy could allow to just write the raw block.
s := GetMHTML;
p0 := 1;
while true do
begin
p := PosEx(#13#10, s, p0);
if (p < 1) or(p >= Length(s) - 3) then exit;
Msg.Headers.Add(Copy(s, p0, p - p0));
p0 := p + 2;
if s[p0] = #13 then break; //double enter.
end;
Msg.Body.Text := copy(s, p0 + 2, Length(s));
end;
procedure TMailDialog.btnSendClick(Sender: TObject);
begin
if not ValidateFields then
exit;
if MessageDlg('Now we will try to send the email using the server ''' + edOutServer.Text +
''''#$000A + 'Note that this is a very simple implementation, and it might not work if the SMTP server needs to login. GMail accounts should work.',
mtInformation,
[mbOk, mbCancel], 0) <> mrOK then exit;
Msg.Clear;
Msg.NoEncode := true;
Msg.Headers.Add('From: ' + Trim(edFrom.Text));
Msg.Recipients.Add.Text := Trim(edTo.Text);
Msg.Headers.Add('Subject: ' + Trim(edSubject.Text));
FillMsgBody;
Mailer.Host := Trim(edOutServer.Text);
if cbUseTLS.Checked then
begin
Mailer.Port := StrToInt(Trim(edPort.Text));
Mailer.Username := Trim(edUserName.Text);
Mailer.Password := Trim(edPassword.Text);
Mailer.UseTLS := TIdUseTLS.utUseExplicitTLS;
end
else
begin
Mailer.Port := 25;
Mailer.Username := '';
Mailer.Password := '';
Mailer.UseTLS := TIdUseTLS.utNoTLSSupport;
end;
try
Mailer.Connect;
try
Mailer.Send(Msg);
finally
Mailer.Disconnect;
end;
except
on ex: Exception do
begin
ShowMessage('Error trying to send the message: ' + ex.Message);
exit;
end;
end;
ShowMessage('Message has been sent. Please verify your JUNK folder or any filters, since it might be filtered as spam');
ModalResult := mrOk;
end;
end.