Features (Delphi)

Note

This demo is available in your FlexCel installation at <FlexCel Install Folder>\Demo\Delphi\Modules\20.Reports\B0.Features Page and also at https:​//​github.​com/​tmssoftware/​TMS-​FlexCel.​VCL-​demos/​tree/​master/​Delphi/​Modules/​20.​Reports/​B0.​Features Page

Overview

This is a real world demo, showing how we create the "features" HTML sheet you can find at

https://www.tmssoftware.com/flexcel/featuresflexcel.htm

Concepts

• Everything in this demo is shown in more detail somewhere else. This is just a showcase of a real application of a FlexCel report, but anyway there are some ideas worth noting.

• We use the Image Fit tag in the image to autofit the containing cell to the height of the image. Bus as we also need to autofit the whole row, we need to do an autofit with a "Dont Shrink" option on the rows. If we didn't, when autofitting the rows the images would get outside their cells again.

• We use Intelligent Page Breaks to have a nice PDF output.

• As we wanted to use Access so we can distribute this demo easily to you, we did not store the images in the database. (Access is not good at storing images). So we saved the images in a folder, and used an user defined function to load them and feed the report.

Files

UFeaturesData.pas

unit UFeaturesData;

interface

uses
  SysUtils, Classes, DB, ADODB;

type
  TFeaturesDataModule = class(TDataModule)
    Categories: TADODataSet;
    ADOConnection: TADOConnection;
    Features: TADODataSet;
    Hyperlinks: TADODataSet;
    DsCategories: TDataSource;
    DsFeatures: TDataSource;
    procedure DataModuleCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FeaturesDataModule: TFeaturesDataModule;

implementation
uses IOUtils;

{%CLASSGROUP 'System.Classes.TPersistent'}

{$R *.dfm}

function DBFile: string;
begin
  Result := TPath.Combine(TPath.GetDirectoryName(ParamStr(0)), '..\..\features.mdb');
end;

procedure TFeaturesDataModule.DataModuleCreate(Sender: TObject);
begin
  ADOConnection.ConnectionString := StringReplace(ADOConnection.ConnectionString, 'features.mdb', DbFile, []);
end;

end.

UImagesImpl.pas

unit UImagesImpl;

interface
uses FlexCel.Core, FlexCel.Report;

type
  TImagesImpl = class(TFlexCelUserFunction)
  private
    DataPath: string;
  public
    constructor Create(const aDataPath: string);
    function Evaluate(const parameters: TFormulaValueArray): TReportValue; override;
  end;

implementation
uses SysUtils, IOUtils, Classes;

{ TImagesImpl }

constructor TImagesImpl.Create(const aDataPath: string);
begin
  DataPath := aDataPath;
end;

function TImagesImpl.Evaluate(
  const parameters: TFormulaValueArray): TReportValue;
var
  ImageFileName: string;
  fs: TFileStream;
  Bytes: TBytes;
begin
  if Length(parameters) <> 1 then raise Exception.Create('Bad parameter count in call to Images() user-defined function');

  ImageFilename := TPath.Combine(TPath.Combine(DataPath, 'images'), 'Features' + parameters[0].ToStringInvariant + '.png');
  if (TFile.Exists(ImageFilename)) then
  begin
    fs := TFileStream.Create(ImageFilename, fmOpenRead);
    try
      SetLength(Bytes, fs.Size);
      fs.Read(Bytes[0], Length(Bytes));
      exit(Bytes);
    finally
      fs.Free;
    end;
  end;

  Result := TReportValue.Empty;
end;

end.

UMainForm.pas

unit UMainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, StdCtrls,
 {$if CompilerVersion >= 23.0} System.UITypes, {$IFEND}
  FlexCel.VCLSupport, FlexCel.Core, FlexCel.XlsAdapter, FlexCel.Report, FlexCel.Render, FlexCel.Pdf;

type
  TMainForm = class(TForm)
    btnExportPdf: TButton;
    btnExportExcel: TButton;
    btnExportHTML: TButton;
    btnCancel: TButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure btnExportExcelClick(Sender: TObject);
    procedure btnExportPdfClick(Sender: TObject);
    procedure btnExportHTMLClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
  private
    function ExportData: TXlsFile;
    procedure SheetSelector_SheetSelectorEntry(const sender: TObject;
      const e: TSheetSelectorEntryEventArgs);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation
uses UFeaturesData, IOUtils, UImagesImpl, ShellAPI;

{$R *.dfm}

function DataPath: string;
begin
  Result := TPath.Combine(TPath.GetDirectoryName(ParamStr(0)), '..\..\');
end;

function ResultPath: string;
begin
  Result := TPath.Combine(TPath.GetDirectoryName(ParamStr(0)), 'Features')
end;

procedure TMainForm.btnCancelClick(Sender: TObject);
begin
  Close;
end;

function TMainForm.ExportData: TXlsFile;
var
  Report: TFlexCelReport;
begin
  Result := TXlsFile.Create(true);
  try
    Result.Open(TPath.Combine(DataPath, 'Features Page.template.xls'));
    Report := TFlexCelReport.Create(true);
    try
      Report.AddTable(FeaturesDataModule);
      Report.SetUserFunction('Images', TImagesImpl.Create(DataPath));
      Report.Run(Result);

    finally
      Report.Free;
    end;

  except
    Result.Free;
    raise;
  end;

end;

procedure TMainForm.btnExportExcelClick(Sender: TObject);
var
  XlsPath: string;
  Xls: TXlsFile;
begin
  XlsPath := TPath.Combine(ResultPath, 'FeaturesFlexCel.xls');
  Xls := ExportData;
  try
    TDirectory.CreateDirectory(ResultPath);
    Xls.Save(XlsPath);
  finally
    Xls.Free;
  end;

  if MessageDlg('Do you want to open the generated file?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  begin
    ShellExecute(0, 'open', PCHAR(XlsPath), nil, nil, SW_SHOWNORMAL);
  end;

end;

procedure TMainForm.btnExportHTMLClick(Sender: TObject);
var
  MainHtmlPath: String;
  Xls: TXlsFile;
  html: TFlexCelHtmlExport;
  SheetSelector: TStandardSheetSelector;
  Sheets: TArray<String>;
begin
  MainHtmlPath := TPath.Combine(ResultPath, 'featuresflexcel.htm');

  Xls := ExportData;
  try
    TDirectory.CreateDirectory(ResultPath);
    html := TFlexCelHtmlExport.Create(Xls, true);
    try
      html.ImageResolution := 192;
      html.ImageBackground := Colors.White; //Since we are not setting html.FixIE6TransparentPngSupport, we must ensure tehre are no transparent images.
      SheetSelector := TStandardSheetSelector.Create([TSheetSelectorPosition.Top]);
      try
        SheetSelector.SheetSelectorEntry := SheetSelector_SheetSelectorEntry;
        SheetSelector.CssGeneral.Main := 'font-family:Verdana;font-size:10pt;';

        html.ExportAllVisibleSheetsAsTabs(ResultPath, 'Features', '.htm', '', '', SheetSelector, false);

        //Rename the first tab so it is "featuresflexcel.htm";
        Sheets := html.GeneratedFiles.GetHtmlFiles();
        TFile.Delete(MainHtmlPath);
        TFile.Move(Sheets[0], MainHtmlPath);
      finally
        SheetSelector.Free;
      end;

    finally
      html.Free;
    end;
  finally
    Xls.Free;
  end;

  if MessageDlg('Do you want to open the generated file?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  begin
    ShellExecute(0, 'open', PCHAR(MainHtmlPath), nil, nil, SW_SHOWNORMAL);
  end;

end;

procedure TMainForm.SheetSelector_SheetSelectorEntry(const sender: TObject; const e: TSheetSelectorEntryEventArgs);
begin
  //We will rename the first sheet, so we need to update the links here.
  if (e.ActiveSheet = 1) then e.Link := 'featuresflexcel.htm';
end;

procedure TMainForm.btnExportPdfClick(Sender: TObject);
var
  PdfPath: String;
  Xls: TXlsFile;
  pdf: TFlexCelPdfExport;
  pdfStream: TFileStream;
begin
  PdfPath := TPath.Combine(ResultPath, 'FeaturesFlexCel.pdf');

  Xls := ExportData;
  try
    TDirectory.CreateDirectory(ResultPath);

    pdf := TFlexCelPdfExport.Create(Xls, true);
    try
      pdfStream := TFileStream.Create(PdfPath, fmCreate);
      try
        pdf.BeginExport(pdfStream);
        pdf.FontMapping := TFontMapping.ReplaceAllFonts;

        pdf.Properties.Subject := 'A list of FlexCel features';
        pdf.Properties.Author := 'TMS Software';
        pdf.Properties.Title := 'List of FlexCel features';
        pdf.PageLayout := TPageLayout.Outlines;
        pdf.ExportAllVisibleSheets(false, 'Features');
        pdf.EndExport();

      finally
        pdfStream.Free;
      end;
    finally
      pdf.Free;
    end;
  finally
    Xls.Free;
  end;

  if MessageDlg('Do you want to open the generated file?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  begin
    ShellExecute(0, 'open', PCHAR(PdfPath), nil, nil, SW_SHOWNORMAL);
  end;

end;

end.