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.