Working in virtual mode (Delphi)

Note

This demo is available in your FlexCel installation at <FlexCel Install Folder>\Demo\Delphi\Modules\10.API\22.Virtual Mode and also at https:​//​github.​com/​tmssoftware/​TMS-​FlexCel.​VCL-​demos/​tree/​master/​Delphi/​Modules/​10.​API/​22.​Virtual Mode

Overview

This example shows how to read or write Excel files without fully loading them in memory. See the FlexCel Performance Guide for more information in how Virtual Mode works.

Concepts

• How to read xls, xlsx or txt files without loading them into memory.

Files

UCellReader.pas

unit UCellReader;

interface
uses FlexCel.Core, USheetSelect, Controls, USparseArray;

type
  //A simple cell reader that will get the values from FlexCel and put them into a grid.
  TCellReader = class
  private
    Only50Rows: boolean;
    FormatValues: boolean;
    SheetData: TSparseCellArray;
    SheetToRead: integer;
  public
    StartSheetSelect, EndSheetSelect: TDateTime;
    constructor Create(const aOnly50Rows: boolean; const aSheetData: TSparseCellArray; const aFormatValues: boolean);
    procedure OnStartReading(const sender: TObject; const e: TVirtualCellStartReadingEventArgs);
    procedure OnCellRead(const sender: TObject; const e: TVirtualCellReadEventArgs);
  end;
implementation
uses SysUtils;
{ TCellReader }

constructor TCellReader.Create(const aOnly50Rows: boolean;
  const aSheetData: TSparseCellArray; const aFormatValues: boolean);
begin
  Only50Rows := aOnly50Rows;
  SheetData := aSheetData;
  FormatValues := aFormatValues;
end;

procedure TCellReader.OnCellRead(const sender: TObject;
  const e: TVirtualCellReadEventArgs);
var
  Clr: TUIColor;
begin
  if Only50Rows and (e.Cell.Row > 50) then
  begin
    e.NextSheet := ''; //Stop reading all sheets.
    exit;
  end;

  if e.Cell.Sheet <> SheetToRead then
  begin
    e.NextSheet := ''; //Stop reading all sheets.
    exit;
  end;

  if FormatValues then
  begin
    SheetData.AddValue(e.Cell.Row, e.Cell.Col,
       TFlxNumberFormat.FormatValue(e.Cell.Value,
       TExcelFile(Sender).GetFormat(e.Cell.XF).Format, Clr, TExcelFile(Sender)));
  end
  else
  begin
    SheetData.AddValue(e.Cell.Row, e.Cell.Col, e.Cell.Value.ToString);
  end;
end;

procedure TCellReader.OnStartReading(const sender: TObject;
  const e: TVirtualCellStartReadingEventArgs);
var
  SheetSelector: TFSheetSelect;
begin
  StartSheetSelect := now;
  SheetSelector := TFSheetSelect.Create(e.SheetNames);
  try
    if SheetSelector.ShowModal <> mrOk then
    begin
      EndSheetSelect := now;
      e.NextSheet := ''; //stop reading
      exit;
    end;
    EndSheetSelect := now;
    e.NextSheet := SheetSelector.SelectedSheet;
    SheetToRead := SheetSelector.SelectedSheetIndex + 1;
  finally
    SheetSelector.Free;
  end;
end;

end.

USheetSelect.pas

unit USheetSelect;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, StdCtrls, ExtCtrls;

type
  TFSheetSelect = class(TForm)
    SheetList: TListBox;
    Panel1: TPanel;
    btnOk: TButton;
    btnCancel: TButton;
    procedure SheetListDblClick(Sender: TObject);
  private
  public
    constructor Create(const Sheets: TArray<string>); reintroduce;
    function SelectedSheet: string;
    function SelectedSheetIndex: integer;
  end;

implementation

{$R *.dfm}

{ TFSheetSelect }

constructor TFSheetSelect.Create(const Sheets: TArray<string>);
var
  s: string;
begin
  inherited Create(nil);
  for s in Sheets do
  begin
    SheetList.AddItem(s, nil);
  end;
  SheetList.ItemIndex := 0;
end;

function TFSheetSelect.SelectedSheet: string;
begin
  if SheetList.ItemIndex < 0 then exit('');
  Result := SheetList.Items[SheetList.ItemIndex];
end;

function TFSheetSelect.SelectedSheetIndex: integer;
begin
  Result := SheetList.ItemIndex;

end;

procedure TFSheetSelect.SheetListDblClick(Sender: TObject);
begin
  ModalResult := mrOk;
end;

end.

USparseArray.pas

unit USparseArray;

interface
uses Generics.Collections, Generics.Defaults;

type
  TSparseCell = record
    Col: integer;
    Value: string;

    class function Create(const aCol: integer; const aValue: string): TSparseCell; static;
  end;

  TSparseRow = record
    Row: integer;
    Data: TList<TSparseCell>;

    class function Create(const aRow: integer): TSparseRow; static;
    procedure CreateData(const CellComparer: IComparer<TSparseCell>);
  end;

  TSparseRowComparer = class(TInterfacedObject, IComparer<TSparseRow>)
    function Compare(const Left, Right: TSparseRow): Integer;
  end;

  TSparseCellComparer = class(TInterfacedObject, IComparer<TSparseCell>)
    function Compare(const Left, Right: TSparseCell): Integer;
  end;

  ///  <summary>
  ///    This is a simple class that holds cell values. Items are supposed to
  ///    be entered in sorted order, and it isn't really production-ready, just
  ///    to be used in a demo.
  ///  </summary>
  TSparseCellArray = class
  private
    Data: TList<TSparseRow>;
    FColCount: integer;
    RowComparer: IComparer<TSparseRow>;
    CellComparer: IComparer<TSparseCell>;
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddValue(const Row, Col: integer; const Value: string);
    function GetValue(const Row, Col: integer): string;

    property ColCount: integer read FColCount;
    function RowCount: integer;
  end;
implementation

{ TSparseArray }

procedure TSparseCellArray.AddValue(const Row, Col: integer; const Value: string);
var
  Idx: integer;
  SpRow: TSparseRow;
  SpCell: TSparseCell;
begin
  if Col > FColCount then FColCount := Col;
  if Data = nil then Data := TList<TSparseRow>.Create(RowComparer);
  SpRow := TSparseRow.Create(Row);
  if not Data.BinarySearch(SpRow, Idx) then
  begin
    SpRow.CreateData(CellComparer);
    Data.Insert(Idx, SpRow);
  end
  else SpRow := Data[Idx];

  SpCell := TSparseCell.Create(Col, Value);
  if not SpRow.Data.BinarySearch(SpCell, Idx) then
  begin
    SpRow.Data.Insert(Idx, SpCell);
  end else
  begin
    SpRow.Data[Idx] := SpCell;
  end;

end;

constructor TSparseCellArray.Create;
begin
  FColCount := 0;
  RowComparer := TSparseRowComparer.Create;
  CellComparer := TSparseCellComparer.Create;
end;

destructor TSparseCellArray.Destroy;
var
  i: Integer;
begin
  if (Data <> nil) then
  begin
    for i := 0 to Data.Count - 1 do Data[i].Data.Free;
    Data.Free;
  end;

  inherited;
end;

function TSparseCellArray.GetValue(const Row, Col: integer): string;
var
  Idx: integer;
  SpRow: TSparseRow;
  SpCell: TSparseCell;
begin
  if Data = nil then exit('');

  SpRow := TSparseRow.Create(Row);
  if not Data.BinarySearch(SpRow, Idx) then exit('');
  SpRow := Data[Idx];
  SpCell := TSparseCell.Create(Col, '');
  if not SpRow.Data.BinarySearch(SpCell, Idx) then exit('');
  Result := SpRow.Data[Idx].Value;
end;

function TSparseCellArray.RowCount: integer;
begin
  if (Data = nil) or (Data.Count = 0) then exit(0);
  Result := Data[Data.Count - 1].Row;

end;

{ TSparseRow }

class function TSparseRow.Create(const aRow: integer): TSparseRow;
begin
  Result.Row := aRow;
  Result.Data := nil;
end;

procedure TSparseRow.CreateData(const CellComparer: IComparer<TSparseCell>);
begin
  Data := TList<TSparseCell>.Create(CellComparer);
end;

{ TSparseCell }

class function TSparseCell.Create(const aCol: integer;
  const aValue: string): TSparseCell;
begin
  Result.Col := aCol;
  Result.Value := aValue;
end;

{ TSparseRowComparer }

function TSparseRowComparer.Compare(const Left, Right: TSparseRow): Integer;
begin
  Result := Left.Row - Right.Row;
end;

{ TSparseCellComparer }

function TSparseCellComparer.Compare(const Left, Right: TSparseCell): Integer;
begin
  Result := Left.Col - Right.Col;
end;

end.

UVirtualMode.pas

unit UVirtualMode;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, ImgList, ActnList, StdCtrls,
  Tabs, Grids,ExtCtrls, ComCtrls, ToolWin, UPaths,
  FlexCel.VCLSupport, FlexCel.Core, FlexCel.XlsAdapter, UCellReader, USparseArray;

type
  TFVirtualMode = class(TForm)
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton4: TToolButton;
    ToolButton6: TToolButton;
    SheetData: TDrawGrid;
    Panel2: TPanel;
    Actions: TActionList;
    ActionOpen: TAction;
    ActionInfo: TAction;
    ActionClose: TAction;
    OpenDialog: TOpenDialog;
    ToolbarImages: TImageList;
    cbFirst50Rows: TCheckBox;
    cbIgnoreFormulaText: TCheckBox;
    cbFormatValues: TCheckBox;
    ToolbarImages_100Scale: TImageList;
    ToolbarImages_300Scale: TImageList;
    Panel1: TPanel;
    StatusBar: TStatusBar;
    procedure ActionCloseExecute(Sender: TObject);
    procedure ActionInfoExecute(Sender: TObject);
    procedure ActionOpenExecute(Sender: TObject);
    procedure SheetDataDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FormCreate(Sender: TObject);
  private
    CellData: TSparseCellArray; //For this demo we will store the data here, in your application you should use the data as you wish, send it to a db, etc.
    procedure ResizeGrid;
    procedure ImportFile(const FileName: string);
    function GetCellValue(const aCol, aRow: integer): string;
  public
    destructor Destroy; override;
  end;

var
  FVirtualMode: TFVirtualMode;

implementation
uses UFlexCelHDPI;

{$R *.dfm}

procedure TFVirtualMode.ActionCloseExecute(Sender: TObject);
begin
  Close;
end;

procedure TFVirtualMode.ActionInfoExecute(Sender: TObject);
begin
  ShowMessage('This demo shows how to read the contents of an xls file without loading the file in memory.' + #10 +
      'We will first load the sheet names in the file, then open just a single sheet, and read all or just the 50 first rows of it.')

end;

procedure TFVirtualMode.ActionOpenExecute(Sender: TObject);
begin
  if not OpenDialog.Execute then exit;
  ImportFile(OpenDialog.FileName);
end;

destructor TFVirtualMode.Destroy;
begin
  CellData.Free;
  inherited;
end;

procedure TFVirtualMode.FormCreate(Sender: TObject);
begin
  RegisterForHDPI(Self, ResizeGrid);
end;

procedure TFVirtualMode.ImportFile(const FileName: string);
var
  StartOpen: TDateTime;
  EndOpen: TDateTime;
  StartSheetSelect, EndSheetSelect: TDateTime;
  Xls: TExcelFile;
  CellReader: TCellReader;
begin
   //Open the Excel file.
  Xls := TXlsFile.Create(false);
  try
    FreeAndNil(CellData);
    CellData := TSparseCellArray.Create;
    StartOpen := Now;

    //By default, FlexCel returns the formula text for the formulas, besides its calculated value.
    //If you are not interested in formula texts, you can gain a little performance by ignoring it.
    //This also works in non virtual mode.
    xls.IgnoreFormulaText := cbIgnoreFormulaText.Checked;

    xls.VirtualMode := true;
    CellReader := TCellReader.Create(cbFirst50Rows.Checked, CellData, cbFormatValues.Checked);
    try
      xls.VirtualCellStartReading := CellReader.OnStartReading;
      xls.VirtualCellRead := CellReader.OnCellRead;

      xls.Open(FileName);
      StartSheetSelect := CellReader.StartSheetSelect;
      EndSheetSelect := CellReader.EndSheetSelect;
    finally
      CellReader.Free;
    end;
    EndOpen := Now;
  finally
    Xls.Free;
  end;

  if CellData <> nil then
  begin
    SheetData.ColCount := CellData.ColCount + 1;
    SheetData.RowCount := CellData.RowCount + 1;
  end
  else
  begin
    SheetData.ColCount := 1;
    SheetData.RowCount := 1;
  end;
  if (SheetData.ColCount > 1) and (SheetData.RowCount > 1) then
  begin
    SheetData.FixedRows := 1;
    SheetData.FixedCols := 1;
  end;
  StatusBar.SimpleText := 'Time to open file: ' + ElapsedTime(StartSheetSelect, StartOpen) +
                          '     Time to load file and fill grid: '
                          +  ElapsedTime(EndOpen, EndSheetSelect);
  Caption := 'Reading Files: ' + ExtractFileName(FileName);
  SheetData.Invalidate;
end;

procedure TFVirtualMode.ResizeGrid;
begin
  SheetData.DefaultColWidth := Round(64.0 * Font.PixelsPerInch / 96.0);
  SheetData.DefaultRowHeight := Round(18.0 * Font.PixelsPerInch / 96.0);
end;

procedure TFVirtualMode.SheetDataDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  SheetData.Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + 2, GetCellValue(ACol, ARow));
end;

function TFVirtualMode.GetCellValue(const aCol, aRow: integer): string;
begin
if ACol = 0 then
  begin
    if ARow = 0 then exit('');
    exit (IntToStr(aRow));
  end;
  if ARow = 0 then exit(TCellAddress.EncodeColumn(aCol));
  if CellData = nil then exit('');
  exit(CellData.GetValue(ARow, aCol));
end;

end.