Excel user defined functions (UDF) (Delphi)
Overview
Here we will explore how to handle Excel files with UDFs. FlexCel has
full support for adding Excel UDFs to cells, retrieving UDFs from cells
or recalculating files containing UDFs. But you need to create Delphi/C++
functions that will mimic the UDF behavior, and add them to the FlexCel
recalculation engine.
Make sure you read Using Excel's User-defined Functions (UDF) in the API developers guide for a conceptual explanation
of what we are doing here.
Concepts
How to recalculate a sheet containing User Defined Functions (UDfs).
How to read and write UDFs from and to an Excel file.
In order to compare the results calculated by Excel and By FlexCel,
this demo will save two files: one pdf (that will not use Excel
recalculation) and one xls (that will be recalculated by Excel
when opened).
Files
UExcelUserDefinedFunctions.pas
unit UExcelUserDefinedFunctions;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, FlexCel.VCLSupport, FlexCel.Core, FlexCel.XlsAdapter,
{$IFDEF FPC} LResources,{$ENDIF}
{$if CompilerVersion >= 23.0} System.UITypes, {$IFEND}
ShellAPI;
type
TFExcelUserDefinedFunctions = class(TForm)
Memo1: TMemo;
btnGo: TButton;
SaveDialog: TSaveDialog;
procedure btnGoClick(Sender: TObject);
private
procedure AddData(const Xls: TExcelFile);
procedure AutoRun;
procedure LoadUdfs(const Xls: TExcelFile);
end;
var
FExcelUserDefinedFunctions: TFExcelUserDefinedFunctions;
implementation
uses IOUtils, UPaths, UUserFunctions;
{$R *.dfm}
{ TFExcelUserDefinedFunctions }
procedure TFExcelUserDefinedFunctions.btnGoClick(Sender: TObject);
begin
AutoRun;
end;
/// <summary>
/// Loads the user defined functions into the Excel recalculating engine.
/// </summary>
/// <param name="Xls"></param>
procedure TFExcelUserDefinedFunctions.LoadUdfs(const Xls: TExcelFile);
begin
Xls.AddUserDefinedFunction(TUserDefinedFunctionScope.Local, TUserDefinedFunctionLocation.Internal, TSumCellsWithSameColor.Create);
Xls.AddUserDefinedFunction(TUserDefinedFunctionScope.Local, TUserDefinedFunctionLocation.Internal, TIsPrime.Create);
Xls.AddUserDefinedFunction(TUserDefinedFunctionScope.Local, TUserDefinedFunctionLocation.Internal, TBoolChoose.Create);
Xls.AddUserDefinedFunction(TUserDefinedFunctionScope.Local, TUserDefinedFunctionLocation.Internal, TLowest.Create);
end;
procedure TFExcelUserDefinedFunctions.AddData(const Xls: TExcelFile);
var
Data: TXlsNamedRange;
r: Int32;
FmlaText: String;
o: TCellValue;
//pdf: TFlexCelPdfExport;
begin
LoadUdfs(Xls); //Register our custom functions. As we are using a local scope, we need to register them each time.
Xls.Open(TPath.Combine(DataFolder, 'udfs.xls')); //Open the file we want to manipulate.
//Fill the cell range with other values so we can see how the sheet is recalculated by FlexCel.
Data := Xls.GetNamedRange('Data', -1);
for r := Data.Top to Data.Bottom - 1 do
begin
Xls.SetCellValue(r, Data.Left, r - Data.Top);
end;
FmlaText := '=BoolChoose(TRUE,"This formula was entered with FlexCel!","It shouldn''t display this")'; //Add an UDF to the sheet. We can enter the function "BoolChoose" here because it was registered into FlexCel in LoadUDF()
//If it hadn't been registered, this line would raise an Exception of an unknown function.
Xls.SetCellValue(11, 1, TFormula.Create(FmlaText));
o := Xls.GetCellValue(11, 1); //Verify the UDF entered is correct. We can read any udf from Excel, even if it is not registered with AddUserDefinedFunction.
Assert(o.IsFormula, 'The cell must contain a formula');
if o.IsFormula then
Assert(o.AsFormula.Text = FmlaText, ((('Error in Formula: It should be "' + FmlaText) + '" and it is "') + o.AsFormula.Text) + '"');
//Recalc the sheet. As we are not saving it yet, we ned to make a manual recalc.
Xls.Recalc;
{//pdf exporting is not yet implemented
//Export the file to PDF so we can see the values calculated by FlexCel without Excel recalculating them.
pdf := FlexCelPdfExport.Create(Xls, true);
try
pdf.Export(TPath.ChangeExtension(SaveDialog.FileName, 'pdf'));
finally
FreeObj(pdf);
end; }
//Save the file as xls too so we can compare.
Xls.Save(SaveDialog.FileName);
end;
procedure TFExcelUserDefinedFunctions.AutoRun;
var
Xls: TExcelFile;
begin
if not SaveDialog.Execute then
exit;
Xls := TXlsFile.Create(true);
try
AddData(Xls);
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;
finally
Xls.Free;
end;
end;
end.
UUserFunctions.pas
unit UUserFunctions;
interface
uses FlexCel.VCLSupport, FlexCel.Core;
type
/// <summary>
/// Creates a new instance and registers the class in the FlexCel recalculating engine as "BoolChoose".
/// </summary>
TBoolChoose = class (TUserDefinedFunction)
public
constructor Create;
/// <summary>
/// Chooses between 2 different strings.
/// </summary>
/// <param name="arguments"></param>
/// <param name="parameters">In this case we expect 3 parameters: The first is a boolean, and the other 2 strings. We will return an error otherwise.</param>
/// <returns></returns>
function Evaluate(const arguments: TUdfEventArgs; const parameters: TFormulaValueArray): TFormulaValue; override;
end;
TSumCellsWithSameColor = class (TUserDefinedFunction)
public
constructor Create;
/// <summary>
/// Returns the sum of cells in a range that have the same color as a reference cell.
/// </summary>
/// <param name="arguments"></param>
/// <param name="parameters">In this case we expect 2 parameters, first the reference cell and then
/// the range in which to sum. We will return an error otherwise.</param>
/// <returns></returns>
function Evaluate(const arguments: TUdfEventArgs; const parameters: TFormulaValueArray): TFormulaValue; override;
end;
TIsPrime = class (TUserDefinedFunction)
public
/// <summary>
/// Creates a new instance and registers the class in the FlexCel recalculating engine as "IsPrime".
/// </summary>
constructor Create;
/// <summary>
/// Returns true if a number is prime.
/// </summary>
/// <param name="arguments"></param>
/// <param name="parameters">In this case we expect 1 parameter with the number. We will return an error otherwise.</param>
/// <returns></returns>
function Evaluate(const arguments: TUdfEventArgs; const parameters: TFormulaValueArray): TFormulaValue; override;
end;
TLowest = class (TUserDefinedFunction)
public
/// <summary>
/// Creates a new instance and registers the class in the FlexCel recalculating engine as "Lowest".
/// </summary>
constructor Create;
/// <summary>
/// Chooses the lowest element in an array.
/// </summary>
/// <param name="arguments"></param>
/// <param name="parameters">In this case we expect 1 parameter that should be an array. We will return an error otherwise.</param>
/// <returns></returns>
function Evaluate(const arguments: TUdfEventArgs; const parameters: TFormulaValueArray): TFormulaValue; override;
end;
implementation
constructor TBoolChoose.Create;
begin
inherited Create('BoolChoose');
end;
function TBoolChoose.Evaluate(const arguments: TUdfEventArgs; const parameters: TFormulaValueArray): TFormulaValue;
var
Err: TFlxFormulaErrorValue;
ChooseFirst: Boolean;
s1: String;
s2: String;
begin
if not CheckParameters(parameters, 3, Err) then
exit(Err);
//The first parameter should be a boolean.
if not TryGetBoolean(arguments.Xls, parameters[0], ChooseFirst, Err) then
exit(Err);
//The second parameter should be a string.
if not TryGetString(arguments.Xls, parameters[1], s1, Err) then
exit(Err);
//The third parameter should be a string.
if not TryGetString(arguments.Xls, parameters[2], s2, Err) then
exit(Err);
//Return s1 or s2 depending on ChooseFirst
if ChooseFirst then
Result := s1 else
Result := s2;
end;
{ TSumCellsWithSameColor }
constructor TSumCellsWithSameColor.Create;
begin
inherited Create('SumCellsWithSameColor');
end;
function TSumCellsWithSameColor.Evaluate(const arguments: TUdfEventArgs;
const parameters: TFormulaValueArray): TFormulaValue;
var
Err: TFlxFormulaErrorValue;
SourceCell: TXls3DRange;
SumRange: TXls3DRange;
fmt: TFlxFormat;
SourceColor: Int32;
_Result: double;
s: Int32;
r: Int32;
c: Int32;
XF: Int32;
val: TFormulaValue;
sumfmt: TFlxFormat;
begin
if not CheckParameters(parameters, 2, Err) then
exit(Err);
//The first parameter should be a range
if not TryGetCellRange(parameters[0], SourceCell, Err) then
exit(Err);
//The second parameter should be a range too.
if not TryGetCellRange(parameters[1], SumRange, Err) then
exit(Err);
//Get the color in SourceCell. Note that if Source cell is a range with more than one cell,
//we will use the first cell in the range. Also, as different colors can have the same rgb value, we will compare the actual RGB values, not the ExcelColors
fmt := arguments.Xls.GetCellVisibleFormatDef(SourceCell.Sheet1, SourceCell.Top, SourceCell.Left);
SourceColor := fmt.FillPattern.FgColor.ToColor(arguments.Xls).ToArgb;
_Result := 0;
//Loop in the sum range and sum the corresponding values.
for s := SumRange.Sheet1 to SumRange.Sheet2 do
begin
for r := SumRange.Top to SumRange.Bottom do
begin
for c := SumRange.Left to SumRange.Right do
begin
XF := -1;
val := arguments.Xls.GetCellValue(s, r, c, XF);
if val.IsNumber then //we will only sum numeric values.
begin
sumfmt := arguments.Xls.GetCellVisibleFormatDef(s, r, c);
if sumfmt.FillPattern.FgColor.ToColor(arguments.Xls).ToArgb = SourceColor then
begin
_Result:= _Result + val.AsNumber;
end;
end;
end;
end;
end;
Result := _Result;
end;
{ IsPrime }
constructor TIsPrime.Create;
begin
inherited Create('IsPrime');
end;
function TIsPrime.Evaluate(const arguments: TUdfEventArgs;
const parameters: TFormulaValueArray): TFormulaValue;
var
Err: TFlxFormulaErrorValue;
Number: double;
n: Int32;
i: Int32;
begin
if not CheckParameters(parameters, 1, Err) then
exit(Err);
//The parameter should be a double or a range.
if not TryGetDouble(arguments.Xls, parameters[0], Number, Err) then
exit(Err);
n := Trunc(Number); //Return true if the number is prime.
if n = 2 then
exit(true);
if (n < 2) or ((n mod 2) = 0) then
exit(false);
begin
i := 3;
while i <= Sqrt(n) do
try
if (n mod i) = 0 then
exit(false);
finally
i:= i + 2;
end;
end;
Result := true;
end;
{ TLowest }
constructor TLowest.Create;
begin
inherited Create('Lowest');
end;
function TLowest.Evaluate(const arguments: TUdfEventArgs;
const parameters: TFormulaValueArray): TFormulaValue;
var
Err: TFlxFormulaErrorValue;
SourceArray: TFormulaValueArray2;
sa: TSingleFormulaValueArray;
_Result: double;
First: Boolean;
o: TFormulaValue;
begin
if not CheckParameters(parameters, 1, Err) then
exit(Err);
//The first parameter should be an array.
if not TryGetArray(arguments.Xls, parameters[0], SourceArray, Err) then
exit(Err);
_Result := 0;
First := true;
for sa in SourceArray do
begin
for o in sa do
begin
if o.IsNumber then
begin
if First then
begin
First := false;
_Result := o.AsNumber;
end else
begin
if o.AsNumber < _Result then
_Result := o.AsNumber;
end;
end else
exit(TFlxFormulaErrorValue.ErrValue);
end;
end;
Result := _Result;
end;
end.