User defined functions (Delphi)
Overview
Here we will see how to define a user function to calculate the number
of orders by employee and shipper. This example is similar to the
Pivot Tables example, but using only static normal cells.
Concepts
How to define user functions for non-standard needs. By the way: Try
to define only as little user functions as you really need. User
functions are on code, and a change on them means that you have to
recompile the code.
We defined two ranges here, one horizontal and one vertical. The
user defined function here will return a value for a couple of
those values, allowing us to create a "static" pivot table.
Files
UMainForm.pas
unit UMainForm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
FlexCel.VCLSupport, FlexCel.Core, FlexCel.XlsAdapter, FlexCel.Report, FlexCel.Render,
{$if CompilerVersion >= 23.0} System.UITypes, {$IFEND}
ShellApi,
Controls, Forms, Dialogs, StdCtrls, ExtCtrls;
type
TMainForm = class(TForm)
btnCancel: TButton;
btnGo: TButton;
SaveDialog: TSaveDialog;
Label1: TLabel;
procedure btnCancelClick(Sender: TObject);
procedure btnGoClick(Sender: TObject);
private
procedure RunReport;
function GetDataPath: string;
{ Private declarations }
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
uses IOUtils, DemoOrders, UOrdersImp;
{$R *.dfm}
procedure TMainForm.btnCancelClick(Sender: TObject);
begin
Close;
end;
procedure TMainForm.btnGoClick(Sender: TObject);
begin
RunReport;
end;
function TMainForm.GetDataPath: string;
begin
Result := TPath.Combine(TPath.GetDirectoryName(ParamStr(0)), '..\..');
end;
procedure TMainForm.RunReport;
var
Report: TFlexCelReport;
begin
if not SaveDialog.Execute then exit;
Report := TFlexCelReport.Create(true);
try
Report.AddTable('Employees', DemoTables.Employees);
Report.AddTable('Shippers', DemoTables.Shippers);
Report.SetUserFunction('Orders', TOrdersImp.Create(DemoTables.Orders));
Report.SetValue('Date', Now);
Report.Run(
TPath.Combine(GetDataPath, 'User Defined Functions.template.xls'),
SaveDialog.FileName);
finally
Report.Free;
end;
if MessageDlg('Do you want to open the generated file?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
ShellExecute(0, 'open', PCHAR(SaveDialog.FileName), nil, nil, SW_SHOWNORMAL);
end;
end;
end.
UOrdersImp.pas
unit UOrdersImp;
interface
uses DB, FlexCel.Core, FlexCel.Report, Generics.Collections;
type
TOrdersImp = class(TFlexCelUserFunction)
private
Orders: TDictionary<Int64, integer>;
function GetKey(const Employee, Shipper: integer): Int64;
public
constructor Create(const aOrders: TDataSet);
destructor Destroy; override;
function Evaluate(const parameters: TFormulaValueArray): TReportValue; override;
end;
implementation
uses SysUtils;
{ TOrdersImp }
constructor TOrdersImp.Create(const aOrders: TDataSet);
var
key: Int64;
count: integer;
begin
Orders := TDictionary<Int64, integer>.Create;
aOrders.Open;
try
aOrders.First;
while not aOrders.Eof do
begin
key := GetKey(aOrders['EmployeeId'], aOrders['ShipVia']);
if Orders.TryGetValue(Key, count) then
begin
Orders[Key] := count + 1;
end
else
begin
Orders.Add(Key, 1);
end;
aOrders.Next;
end;
finally
aOrders.Close;
end;
end;
destructor TOrdersImp.Destroy;
begin
Orders.Free;
inherited;
end;
function TOrdersImp.Evaluate(
const parameters: TFormulaValueArray): TReportValue;
var
Employee, ShipVia: Integer;
Ri: Integer;
i: Integer;
begin
if Length(Parameters) <> 2 then raise Exception.Create('Bad parameter count in call to Orders() user-defined function.');
for i := 0 to High(Parameters) do
begin
if not Parameters[i].IsNumber then exit(TReportValue.Empty); //might be null
end;
Employee := Round(Parameters[0].AsNumber);
ShipVia := Round(Parameters[1].AsNumber);
if not Orders.TryGetValue(GetKey(Employee, ShipVia), Ri) then exit(TReportValue.Empty);
Result := Ri;
end;
function TOrdersImp.GetKey(const Employee, Shipper: integer): Int64;
begin
//For simplicity, we'll just keep the key in an int64 with the employee in the high int32 and the shipper in the low int32
//To do this better, we should create a record with shipper and employee and define a GetHashCode.
Result := (Int64(Employee) shl 32) or Int64(Shipper);
end;
end.