Embedded Files
Mấódsa
Mấódsa
Writing (Non Com) Excel Add-ins in Delphi
Writing Excel add-ins with Delphi is a challenging project. I show how it can be done, and highlight the various pitfalls waiting for the unwitting traveller in this largely unexplored frontier.
Writing Excel add-ins with Delphi is a challenging project. Here where I show how it can be done, and highlight the various pitfalls waiting for the unwitting traveller in this largely unexplored frontier.
Despite Microsoft's apparent unpopularity in some quarters, Excel really should place high on lists for 'best software ever created'. Of course taking well over ten years to get it right helped. I think that a particular strength of Excel is its relatively open API, allowing developers to createmacros and use Visual Basic For Excel/VBA for apps.
One of the lesser known Excel features is add-ins. Though you can create them with VBA, but you can also write add-in Dlls in C++ and Delphi. For those doing serious development you need to buy the Excel 97 Developer's Kit (ISBN 1-57231-498-2) (EDK) book, but of course its C/C++ oriented and there are some traps for the Delphi programmer. In this article I show you enough to get you going. As a developer in an Excel work environment I have successfully developed many add-ins with Delphi 3, and I know of know of no one else doing this. There is Financial CAD, a Canadian firm whose add-ins can be used from Delphi but I think they're written in C++. Hey I might be the only person in the world doing this!
Delphi add-ins make it easy for you to extend Excel in many ways- such as data capture from serial ports, data feeds, all with the speed of Delphi compiled code which is significantly faster than interpreted Excel VBA. Lets get started, theres a lot to cover.
Huge Strings are a Huge Mistake
As the add-in is a DLL and Excel uses short strings, you must ensure that the Huge Strings compiler option is clear (or $H- used). You could probably use long strings internally but make sure you convert before passing them to Excel. For further safety feature use ShortString or String[n] types where n is 1-255. Even if you have Hugestrings enabled, you can use string[n] for parameter passing as these are always of type shortstring. Just remember the golden rule, no long strings in passed parameters or records.
Recognition at last
Excel will only recognise your DLL as an add-in if certain functions are exported. You must always provide these functions, as well as those for the user. These xlAuto family of functions are listed in the table below and documented in the Edk book and in the example code with this article. All of your exported functions must use the STDCALL calling convention.
Function Purpose
xlAutoFree Called by Excel to free the Addin's allocated memory.
XlAutoAdd Called when the Addin is first registered.
XlAutoOpen Called when Excel loads.
XlAutoClose Called when Excel exits.
XlAutoRemove Called when the Addin is removed from Excel.
XlAutoRegister Only called if a function hasn't been registered.
XlAddInManagerInfo Provides a text string description of the Addin.
To use any built in Excel function your function calls the Excel function Excel4V. This is defined as
function Excel4v(
xlfn : word;
operRes : lpxloper;
count : integer;
opers : array of lpxloper):integer;
stdcall; external 'xlcall32.dll';
xlfn is the 'Function number' of the Excel Function called.
Operfn is the result and is a pointer to an xloper called an lpxloper (see next section)
Count is the number of elements in Opers.
Opers is an array of lpxloper, i.e. an array of pointers to xlopers.
Note: For many function you can pass a null array for the Opers parameter. Under D3, the empty array construction [] is not allowed, .as it is in D4 so use [nil] under D3.
My development emphasis has been to give users new functions. The EDK documents how to add buttons and controls to Excel but those are a little bit more work and I don't deal with them here. If you wish to push data into Excel there are two other approaches, both shareware based- the TadvExcel component has very fast data transfer using DDE. The TxlsReadWrite read components can output data formatting and formulas direct into Excel workbook files.
Before you start calling Excel functions, you have to know about the XLOper type. This is a pascal record (C struct) some 10 bytes in size, aligned on 16 byte paragraphs in arrays which corresponds to cells in an Excel spreadsheet. The definition is shown below. Blame Microsoft for the brief field names. The Tval type uses the old pascal variant record type, not to be confused with Windows OLE variants, though used in a similar way. The xltype field of XlOper specifies which of the 9 types used is in play. So if the xloper has a type of 1, val.num has a valid double precision number.
I've found that types 1, 2, and 8 are the most used. Type 4 is returned by Excel when you get something wrong. There is an integer type (5) but num (1) seems far more common. Type 6 is used for ranges, with type 9 for collections of separate cells where you hold the Ctrl key down when selecting cells. There is no type 7.
Xloper Definition
TVal = packed Record
Case Byte of
1: (num: Double); (* xltypeNum *)
2: (str: ^ShortString); (* xltypeStr *)
3: (bool: Word); (* xltypeBool *)
4: (err: Word); (* xltypeErr *)
5: (w: Integer); (* xltypeInt *)
6: (sref : packed record
count:word;
ref: Xlref;
end);
8: (_array : packed Record (* xltypeMulti *)
lparray: LPXLOPERArray;
rows: WORD;
columns: WORD;
End);
9: (mref : packed record // xltyperef
lpmref : lpxlmref;
idsheet : integer;
End);
End; // tval
XlOper = packed Record
val: TVal;
xltype: WORD;
dummy:array[0..5] of byte; // pads to 16 byte size
End;
lpxloper = ^xloper;
Problem with Excel calls
From Delphi the big stumbling block with add-ins is the extra parameter after the return address on the stack. This comes free with every call to Excel. I've never found out what it holds, but so long as you throw it away, your add-in will work fine. Add the line asm pop variable;end; after every call where variable can be any global, local or object variable that is at least 4 bytes long- integer is fine. To repeat- THIS MUST BE INCLUDED after every Excel4v call. Otherwise you are constructing a time-bomb.
Example
Eresult:= Excel4V(xlfCaller,@xres,0,[nil]);
asm pop sink; end; // Never Remove
Note that with Delphi syntax, if xres is an xloper, you can use @xres to define an lpxloper.
Caution- Recalculation Alert!
If the inputs to your function are calculated in any way, your code should check the status of the Excel call (Eresult in the example above) as well as the result of the Excel function call which will be in xres above. Remember, you call Excel4V to cals the specified function.
Eresult gives 0 if ok, or a bit set to indicate errors. You should always handle the values 1 and 64. 1 is xlabort indicating the user pressed the esc key. 64 is an uncalculated cell reference. Its not an error, but happens when your function uses functions or calculations on the worksheet that are fully evaluated after your routine is first called. If this happens, you code must free up any memory already allocated in the call and exit. Excel will call your function again.
Structure your code like this
1. Get Input Parameters
2. If an error 64 or 1 (abort key) occurs, exit after freeing up any memory already allocated (if any) in this function.
3. Do main function processing.
If step 3 is going to be very time consuming, say more than 1/10th of a second, your code should check the abort status by calling xlAbort periodically.
Startup
When the Add-in is first added to Excel, each of the exported functions must be registered. This involves calling the Excel Register routine for each routine. There are eight parameters passed as XlOpers.
Parameter Type Use
Module text String Full name of DLL with path
Procedure String or number Function name or number to call
Type Text String Argument and return types
Function Text String Function name in function Wizard
Argument Text String Optional Text String that describes parameters in function Wizard
Macro Type Number 0,1, or 2
Category String or Number Category under which function appears
Shortcut Text String Only used for commands, pass in null for function
The most important parameter to register is the text type. This uses the letters A-R to represent the return value and the supplied parameters. Values are passed as you'd expect in a C Api by reference (i.e. pointer- which is always an lpxloper) or by value.
E.g. the Excel spreadsheet =MyFunction(a1:b1) passes a reference while =InterestRate("GBP") uses a value.
Example
DLLName :=GetName; // function to return name/path from Excel
pxModuleText.SetStr(s); // Note (1)
pxProcedure.SetStr('AddDate'); // Function Name
pxTypeText.SetStr('JJDD!'); // (2) Type Return = J, Input = JDD
pxFunctionText.setStr('AddDate'); // Name in Fx Wizard
pxArgumentText.SetStr('Date,Period,Currency'); // Parm text in FX Wiz
pxMacrotype.SetNum(1); // Type = Sinmple func (3)
pxCategory.SetStr(AddInCategory); // Category for Func. wiz
EResult:=Excel4V(xlfregister,@res,8, // Pass in 8 parms
[pxModuletext.thelpxloper,
pxProcedure.thelpxloper,
pxTypeText.thelpxloper,
pxFunctionText.thelpxloper,
pxArgumentText.thelpxloper,
pxMacroType.thelpxloper,
pxCategory.thelpxloper,
zlpxloper]); // Null
asm pop sink; end; // Never Remove
Result := trunc(res.val.num); // ID Code (4)
The px variables are all of the txloper class which simplifies initialising xlopers.
Notes
(1) The DLLName and path should be obtained from Excel, via the XlGetName function- you can see this used in the example code. Do not hardcode it as it includes the path.
(2) See Register (page 219 in EdK) for fuller details of Text Type. The first parameter is the return parameter (J=32 bit integer) the next 3 are inputs (JDD = Integer, String, String) and the ! means that Excel always calls the function when it recalculates. Without the !, Excel calls the function once, latches the result and uses the latched result on later calls.
(3) Type 1 = Function. Other types include unlisted function (type 0) and commands (type 2). If you want functions that don't show up in the Function Wizard, use 0.
(4) After successful registering, the numeric value in res (res.val.num) contains an integer id code for this function- the handle. Save this and pass it to the Unregister function when the DLL is closed. Forget this and you'll have trouble using newer versions of the library..
Getting Values from an Excel Spreadsheet
Values can be passed in, in three ways.
1. As a passed-by-value. Eg =CalcMean(4,5,8); xltypenum or xltypestr
2. As a Simple reference, say a cell a1 or range a3:b56. xltypesref
3. As a composite Reference. Basically a collection of disjoint cell references. xltypemref
1 and 2 are the most common. 3 is a bit weird and unless really needed, it is better to filter out this. If you want to use it, the input is an array of cell references (type 2), so you have to use each one.
Excel will filter the data type if you specify it (number, string etc) but if you expecting a range then you should fully check the type and ranges of values, reporting errors if appropriate..
Returning Errors
Your function must return an lpxloper (type R) if you wish to return Excel Error codes. To set an error in Res (an xloper) just do
res.xltype := xltypeerr;
res.val.err := number; // returns following values then just return @res from your function
Number Excel Err
0 #NULL
7 #DIV/0
15 #VALUE
23 #REF
29 #NAME
36 #NUM
42 #N/A
With complicated, many parameter functions I think that standard excel errors are a little unfriendly and so I strongly suggest a GetlastError() function which returns the last error string. Any function which returns an error should set the error string returned by GetLastError(). This will save users a lot of time when they are using your functions for the first time.
Reading Cell Values
Having been passed a cell reference (xltypeSref) you want to get at the values contained in the cells. To do this you must 'coerce' the cell reference xloper. This coerce (an Excel function) forces Excel to construct a vector of xlopers, with exactly (#Rows * #Cols) xlopers. Ie for a 2 x 3 array of cells, you get six xlopers. The target xloper becomes a header with the xltype field = 64 (xltypearray). The val._array member contains the number of rows and columns and a pointer to the body xloper.
These xlopers are arranged in row order so the six cells in two rows by 3 columns is stored as
1 2 3
4 5 6
Each will have the fundamental type (xltype num or Str) and the value.
Example of Coercion
Desttype.xltype := xltypeInt;
Desttype.val.w := xltypeMulti;
Eresult := Excel4v(xlcoerce,@Xval,2,[Values,@desttype]);
asm pop sink; end; // Never Remove
The xlopers/lpxlopers used here are
Desttype - An xloper that specifies the coercion destination type (xltypemulti- Excels name for an array of xlopers)
Values - The passed in cell reference- an lpxloper
Xval - The target xloper. After a successful coerce, this is the header of an array. With the 2 x 3 array, there will be six xlopers, each holding a cell value.
Excel has allocated memory on your behalf and this has to be dealt with, but more on that later..
Example of using the values
This example checks the
if xval.val._array.rows<>1 then
begin
Error('Should only have one row');
goto myexit;
end;
xlar := xval.val._array.lparray;
index:=0;
for col:= 1 to xr.NumCols do
begin
if xlar^[index].xltype <> xltypenum then
begin
Error('Element '+inttostr(row)+' Not a number');
break;
end;
Value[col] := xlar^[index].val.num;
inc(index);
end;
xlar is a pointer to an array of xlopers. In this example this checks that there is one row of non-numeric data. It then copies the values into the Value[] array.
Putting values into Excel Cells
Although there is an equivalent (sort of) of xlcoerce, called xlset, it can only be called from a command (menu or toolbar button) and not from a function. Its very anti social anyway to just dump a bunch of values into a spreadsheet it might just overwrite a mornings unsaved work and won't that improve your popularity!
A not so well known feature of Excel called Function Arrays (or formula arrays) is what is needed. If you aren't familiar with them, try this on an empty Excel sheet.
1. Select a rectangular area with the mouse. Now click on the editing line (just below the toolbars, above the cells) and type in =g1. At this point you should see =g1 in the edit line and the selected area should still be selected. If you cleared the selection by mistake, go back and try it again.
2. Now hold down ctrl and shift keys and press enter. The =g1 should be pasted into all cells in the previously selected area.
You should also notice some things about this if you click on any cell in this area.
1. The edit line shows the equation in brackets.
2. You cannot change or clear the cell.
3. It didn't adjust the cell reference.
This is the only way (so far as I could work out) to put values into Excel cells. Your excel function must build up an array of xlopers, with the header pointing to the body. If your function returns an array, you must use a Function Array to show the result. Excel is quite clever with this. If you return a 3 x 5 area and the user pastes a Function Array into a 4 x 6 rectangle, the extra cells will all show N/A.
Memory Management
If an Excel4v call returns an xloper with a pointer (strings or xltypemulti for instance) then, when your code has finished with the value your code must always call xlfree on the xloper. In fact as a general rule, calling xlfree on any xloper does no harm at all.
There are two memory allocation cases that your code MUST handle..
1. You have called a routine that returns an xloper with data in it, eg xlcoerce to convert a xltypesref/xltyperef to an xltypemulti (array). Excel allocates its own memory and when you are finished with the data, you should OR in the value $1000 (4096 decimal) to the xltype- this $1000 value is known as xlbitXLfree. When you call xlfree, it frees up the 'Excel allocated' memory.
2. If your code returns an array of xlopers which Excel shows as a function array, you must OR in the value $4000 (16384 decimal) to the xltype field, before the function exits. After copying the values Excel will do a call-back to your xlAutoFree function (you did implement one didn't you?) with an lpxloper to your data. You can then free it. If you created the array with n elements, in (n+1) xlopers, where arrayname[0] is the header which points to arrayname[1] then the pointer returned points to arrayname[0] and freemem(call back pointer) will then free the correct pointer.
An example Add-In
The example accompanying this article is self-contained in about 650 lines of code with no non delphi components or units needed. It implements a Cumulative Distribution Function GetCDF that takes a number in the range -4 to 4 as input and returns the height under the ogive curve. I know that Excel comes with several Normal distribution functions but it serves as an example. It has been tested on Excel 95 and 97 with Delphi 3 on win 95/98 and NT and proved to be rock solid. I cannot stress how important it is to check all inputs and try and get your code as rugged as possible. Anything nasty will probably bomb or hang Excel and users will rapidly become abusers. Don't forget the Stdcalls on all exported functions!
Apart from the obligatory xlauto family of functions, it includes five other functions, two of which are invisible. These two GetXlStack and FreeRam are meant for use by the developer only. The other three (GetCDF, LastError and Version) are for the user. You can use both types of functions directly but only visible ones will be seen in the Function Wizard. And don't forget the brackets on function calls. Excel will happily take =Version (without ()) and return a value of -30408699 (I've no idea) when you actually meant =Version().
I've included just the main excel function numbers used in the program, the full list has nearly 400. The EDK has the whole lot and includes C headers that can easily be edited.
In many ways this is a bit of an old fashioned, non-OOP program. I chose that way originally as I was feeling my way round excel add-ins and I didn't want to have problems with Objects at the same time. The only class I've used here is Txloper for simplifying creating Xlopers but that was to keep it concise. Send your queries and work offers to david@darkgames.com.
The file below is complete - source for a dll. Make sure the extension is .xll
$A+,B-,C+,D+,E-,F-,G+,H-,I+,J+,K-,L+,M-,N+,O-,P+,Q+,R-,S-,T-,U-,V+,W+,X+,Y-,Z1}
library delphixll;
uses
SysUtils,
windows,
vcl.forms,
vcl.Dialogs,
Classes,
Math;
// XLREF structure
type
xlref = packed record
rwFirst: smallint;
rwLast: smallint;
colFirst: byte;
colLast: byte;
end;
// Returns a range of selection
XlRangeRecord = packed record
Count: word; // should always be $1
Sref: xlref;
end;
xlmref = packed record
Count: word;
RefTbl: array [0 .. 1000] of xlref;
end;
lpxloper = ^XLOPER;
lpxloperArray = ^XLArray;
lpxlmref = ^xlmref;
TVal = packed Record
Case byte of
1:
(num: Double); // xltypeNum
2:
(str: ^ShortString); // xltypeStr
3:
(bool: word); // xltypeBool
4:
(err: word); // xltypeErr
5:
(w: Integer); // xltypeInt
6:
(Sref: packed record
Count: word;
ref: xlref;
end);
8:
(_array: packed Record // xltypeMulti
lparray: lpxloperArray;
rows: word;
columns: word;
End);
9:
(mref: packed record // xltyperef
lpmref: lpxlmref;
idsheet: Integer;
End);
End; // tval
XLOPER = packed Record
val: TVal;
xltype: word;
dummy: array [0 .. 5] of byte; // filler
End;
XLArray = array [0 .. 1000] of XLOPER;
lpxlarray = ^XLArray;
txloper = class // Simple xloper support class
private
fxloper: XLOPER;
fActualStr: ShortString;
function Getlpxloper: lpxloper;
public
constructor Create;
Destructor Destroy; override;
Constructor Create_Str(NewStr: ShortString);
procedure SetStr(NewStr: ShortString);
procedure SetNum(NewNumber: Integer);
procedure SetInt(NewNumber: Integer);
procedure SetErr;
property thelpxloper: lpxloper read Getlpxloper;
end;
// Excel
function Excel4v(xlfn: word; operRes: lpxloper; Count: Integer;
opers: array of lpxloper): Integer;
stdcall; external 'xlcall32.dll';
// XLMREF structure Describes multiple rectangular references.
const
xltypeNum = $0001;
xltypeStr = $0002;
xltypeBool = $0004;
xltypeRef = $0008;
xltypeErr = $0010;
xltypeFlow = $0020;
xltypeMulti = $0040;
xltypeMissing = $0080;
xltypeNil = $0100;
xltypeSRef = $0400;
xltypeInt = $0800;
xlbitXLFree = $1000;
xlbitDLLFree = $4000;
xltypeBigData = xltypeStr or xltypeInt;
// Error codes Used for val.err field of XLOPER structure
xlerrNull = 0;
xlerrDiv0 = 7;
xlerrValue = 15;
xlerrRef = 23;
xlerrName = 29;
xlerrNum = 36;
xlerrNA = 42;
// Return codes
xlretSuccess = 0; // success
xlretAbort = 1; // macro halted
xlretInvXlfn = 2; // invalid function number
xlretInvCount = 4; // invalid number of arguments
xlretInvXloper = 8; // invalid OPER structure
xlretStackOvfl = 16; // stack overflow
xlretFailed = 32; // command failed
xlretUncalced = 64; // uncalced cell
// Function number bits
xlCommand = $8000;
xlSpecial = $4000;
xlIntl = $2000;
xlPrompt = $1000;
// Special function numbers
xlFree = (0 or xlSpecial);
xlStack = (1 or xlSpecial);
xlCoerce = (2 or xlSpecial);
xlSet = (3 or xlSpecial);
xlSheetId = (4 or xlSpecial);
xlSheetNm = (5 or xlSpecial);
xlAbort = (6 or xlSpecial);
xlGetInst = (7 or xlSpecial);
xlGetHwnd = (8 or xlSpecial);
xlGetName = (9 or xlSpecial);
xlEnableXLMsgs = (10 or xlSpecial);
xlDisableXLMsgs = (11 or xlSpecial);
xlDefineBinaryName = (12 or xlSpecial);
xlGetBinaryName = (13 or xlSpecial);
// User defined functions, needed for calling Excel functions
xlfCaller = 89;
xlfRegister = 149;
xlfUnregister = 201;
//
DLLversion: ShortString = 'KWRU Calc V1.02';
AddInCategory = 'Kien WRU Calculator';
const
zlpxloper = lpxloper(nil);
type
retarray = array [0 .. 1000] of XLOPER;
pretarray = ^retarray;
var // Global data
res: XLOPER;
GetCDF_Id: Integer;
xlStack_Id: Integer;
EResult: Integer;
sink: Integer;
GetStack_Id: Integer;
LastError_Id: Integer;
FreeRam_Id: Integer;
Version_Id: Integer;
LastErrorxl: XLOPER;
LastErrorStr: ShortString;
brc: Integer;
FuncName: String[64];
pxModuleText, pxProcedure, pxTypetext, pxFunctiontext,
pxArgumentText, pxMacroType, pxCategory, pxShortcutText: txloper;
HaveRegistered: boolean;
xvalue: XLOPER;
procedure setxlcols(var head: array of XLOPER; numrows, numcols: word);
begin
fillchar(head[0], sizeof(head[0]), 0);
fillchar(head[1], sizeof(head[1]), 0);
head[0].xltype := 64;
head[0].val._array.rows := numrows; //
head[0].val._array.columns := numcols; //
head[0].val._array.lparray := @head[1];
end;
procedure setval(var v: XLOPER; numval: Double);
begin
fillchar(v, sizeof(v), 0);
v.xltype := 1;
v.val.num := numval;
end;
procedure SetFunctionName(S: String);
begin
FuncName := S;
end;
procedure Error(S: ShortString);
begin
If LastErrorStr <> S then
LastErrorStr := FuncName + ':' + S;
end;
function GetSheetName: ShortString;
var
xres, xsheetname: XLOPER;
ResStr: ShortString;
begin
ResStr := '';
EResult := Excel4v(xlfCaller, @xres, 0, [nil]);
asm pop sink;
end; // Never Remove
if EResult = 16 then
ResStr := 'No Caller ID'
else
begin
EResult := Excel4v(xlSheetNm, @xsheetname, 1, [@xres]);
asm pop sink;
end; // Never Remove
if EResult = 0 then
begin
ResStr := xsheetname.val.str^;
end
end;
EResult := Excel4v(xlFree, nil, 1, [@xres]);
asm pop sink;
end; // Never Remove
EResult := Excel4v(xlFree, nil, 1, [@xsheetname]);
asm pop sink;
end; // Never Remove
Result := ResStr;
end;
// Returns full path & name of DLL
function GetName: ShortString;
begin
EResult := Excel4v(xlGetName, @res, 1, [nil]);
asm pop sink;
end; // Never Remove
Result := res.val.str^;
EResult := Excel4v(xlFree, nil, 1, [@res]);
asm pop sink;
end; // Never Remove
end;
CONST
X1 = -4.0; // left end point
X2 = +4.0; // right end point
NUMINV = 40000; // number of increments
TYPE
Vector = ARRAY [-NUMINV .. NUMINV] of Double;
VAR
K: Integer; // counter
DELTA: Double; // step size
X: Double; // actual interval point
ABSCISSA: ^Vector; // vector of the values of the interval points
FX: ^Vector; // vector of the values of the density function
CDF: Vector; // vector of the values of the cumulative density function
// Generates one value of the standard Gaussian density function }
FUNCTION F(X: Double): Double;
BEGIN
F := EXP(-X * X / 2) / SQRT(PI + PI);
END;
PROCEDURE Gaussian; { get the normal density function }
BEGIN
fillchar(CDF, sizeof(CDF), 0);
CDF[0] := 0.5;
CDF[-1] := 0.5;
CDF[1] := 0.5;
DELTA := NUMINV * 2;
DELTA := (X2 - X1) / DELTA; { highest possible screen resolution }
X := X1 - DELTA;
K := -NUMINV;
REPEAT
inc(K);
X := X + DELTA;
ABSCISSA^[K] := X; { values of the X-axes }
FX^[K] := F(X); { values of the Y-axes }
UNTIL K = NUMINV;
END;
procedure generateCDF;
Const
gamma = 0.2316419;
a1 = 0.319381530;
a2 = -0.356563782;
a3 = 1.781477937;
a4 = -1.821255987;
a5 = 1.330274429;
VAR
k1, k2, k3, k4, k5: Double;
I: Integer;
BEGIN
new(FX);
new(ABSCISSA);
Gaussian;
FOR I := 0 TO NUMINV DO
IF ABSCISSA^[I] > 0.0 THEN
BEGIN
k1 := 1.0 / (1.0 + gamma * ABSCISSA^[I]);
k2 := SQR(k1);
k3 := k1 * k2;
k4 := SQR(k2);
k5 := k4 * k1;
CDF[I] := 1.0 - FX^[I] * (a1 * k1 + a2 * k2 + a3 * k3 + a4 * k4 +
a5 * k5);
END;
for I := -NUMINV to -1 do
CDF[I] := 1 - CDF[-I];
dispose(ABSCISSA);
dispose(FX);
END;
// enter with -4 < x < 4.0
function GetCDF(xd: Double): Double; stdcall;
var
X: Double;
begin
X := xd;
if X > 4.0 then
X := 4.0;
if X < -4.0 then
X := -4.0;
Result := CDF[round(X * 10000)];
end;
// Main function
Function Register_GetCDF: Integer;
var
S: ShortString;
begin
res.xltype := xltypeErr;
res.val.err := xlerrValue;
S := GetName;
pxModuleText.SetStr(S);
pxProcedure.SetStr('GetCDF');
pxTypetext.SetStr('BB!'); // Double, Double
pxFunctiontext.SetStr('GetCDF');
pxArgumentText.SetStr('Value');
pxMacroType.SetNum(1);
pxCategory.SetStr(AddInCategory);
EResult := Excel4v(xlfRegister, @res, 8,
[pxModuleText.thelpxloper,
pxProcedure.thelpxloper,
pxTypetext.thelpxloper,
pxFunctiontext.thelpxloper,
pxArgumentText.thelpxloper,
pxMacroType.thelpxloper,
pxCategory.thelpxloper,
zlpxloper]);
asm pop sink;
end; // Never Remove
Result := trunc(res.val.num);
end;
// Shows value of Excel Stack
function LastError: lpxloper; stdcall;
begin
LastErrorxl.xltype := xltypeStr;
LastErrorxl.val.str := @LastErrorStr;
Result := @LastErrorxl;
end;
Function Register_LastError: Integer;
var
S: ShortString;
begin
res.xltype := xltypeErr;
res.val.err := xlerrValue;
S := GetName;
pxModuleText.SetStr(S);
pxProcedure.SetStr('LastError');
pxTypetext.SetStr('R!'); // lpxloper
pxFunctiontext.SetStr('LastError');
pxArgumentText.SetStr('');
pxMacroType.SetNum(1);
pxCategory.SetStr(AddInCategory);
EResult := Excel4v(xlfRegister, @res, 8,
[pxModuleText.thelpxloper,
pxProcedure.thelpxloper,
pxTypetext.thelpxloper,
pxFunctiontext.thelpxloper,
pxArgumentText.thelpxloper,
pxMacroType.thelpxloper,
pxCategory.thelpxloper,
zlpxloper]);
asm pop sink;
end; // Never Remove
Result := trunc(res.val.num);
end;
// Exported Invisible Function Shows value of Excel Stack
function GetXlStack: lpxloper; stdcall;
begin
EResult := Excel4v(xlStack, @res, 1, [nil]);
asm pop sink;
end; // Never Remove
Result := @res;
end;
Function Register_GetXLStack: Integer;
var
S: ShortString;
begin
res.xltype := xltypeErr;
res.val.err := xlerrValue;
S := GetName;
pxModuleText.SetStr(S);
pxProcedure.SetStr('GetXlStack');
pxTypetext.SetStr('R!');
pxFunctiontext.SetStr('GetXlStack');
pxArgumentText.SetStr('');
pxMacroType.SetNum(0); // 0 = Invisible, 1 = visible
pxCategory.SetStr(AddInCategory);
EResult := Excel4v(xlfRegister, @res, 8,
[pxModuleText.thelpxloper,
pxProcedure.thelpxloper,
pxTypetext.thelpxloper,
pxFunctiontext.thelpxloper,
pxArgumentText.thelpxloper,
pxMacroType.thelpxloper,
pxCategory.thelpxloper,
zlpxloper]);
asm pop sink;
end; // Never Remove
Result := trunc(res.val.num);
end;
// Exported Function
function Version: lpxloper; stdcall;
begin
xvalue.xltype := xltypeStr;
xvalue.val.str := @DLLversion;
Result := @xvalue;
end;
Function Register_Version: Integer;
var
S: ShortString;
begin
res.xltype := xltypeErr;
res.val.err := xlerrValue;
S := GetName;
pxModuleText.SetStr(S);
pxProcedure.SetStr('Version');
pxTypetext.SetStr('R!');
pxFunctiontext.SetStr('Version');
pxArgumentText.SetStr('');
pxMacroType.SetNum(1);
pxCategory.SetStr(AddInCategory);
EResult := Excel4v(xlfRegister, @res, 8,
[pxModuleText.thelpxloper,
pxProcedure.thelpxloper,
pxTypetext.thelpxloper,
pxFunctiontext.thelpxloper,
pxArgumentText.thelpxloper,
pxMacroType.thelpxloper,
pxCategory.thelpxloper,
zlpxloper]);
asm pop sink;
end; // Never Remove
Result := trunc(res.val.num);
end;
// exported Function
function FreeRam: Integer; stdcall;
begin
Result := GetHeapStatus.TotalFree;
end;
Function Register_FreeRam: Integer;
var
S: ShortString;
begin
res.xltype := xltypeErr;
res.val.err := xlerrValue;
S := GetName;
pxModuleText.SetStr(S);
pxProcedure.SetStr('FreeRam');
pxTypetext.SetStr('J!');
pxFunctiontext.SetStr('FreeRam');
pxArgumentText.SetStr('');
pxMacroType.SetNum(0); // 0 = invisible
pxCategory.SetStr(AddInCategory);
EResult := Excel4v(xlfRegister, @res, 8,
[pxModuleText.thelpxloper,
pxProcedure.thelpxloper,
pxTypetext.thelpxloper,
pxFunctiontext.thelpxloper,
pxArgumentText.thelpxloper,
pxMacroType.thelpxloper,
pxCategory.thelpxloper,
zlpxloper]);
asm pop sink;
end; // Never Remove
Result := trunc(res.val.num);
end;
procedure Register_All;
begin
if HaveRegistered then
exit;
HaveRegistered := true;
pxModuleText := txloper.Create;
pxProcedure := txloper.Create;
pxTypetext := txloper.Create;
pxFunctiontext := txloper.Create;
pxArgumentText := txloper.Create;
pxMacroType := txloper.Create;
pxCategory := txloper.Create;
pxShortcutText := txloper.Create;
GetCDF_Id := Register_GetCDF;
GetStack_Id := Register_GetXLStack;
FreeRam_Id := Register_FreeRam;
LastError_Id := Register_LastError;
Version_Id := Register_Version;
pxShortcutText.Free;
pxCategory.Free;
pxMacroType.Free;
pxArgumentText.Free;
pxFunctiontext.Free;
pxTypetext.Free;
pxProcedure.Free;
pxModuleText.Free;
end;
// Removes all Registered Functions
procedure UnRegister_All;
var
Module: txloper;
procedure DeRegister(Id: Integer);
begin
Module.SetNum(Id);
EResult := Excel4v(xlfUnregister, @res, 1, [Module.thelpxloper]);
asm pop sink;
end; // Never Remove
end;
begin
Module := txloper.Create;
DeRegister(GetCDF_Id);
DeRegister(xlStack_Id);
DeRegister(FreeRam_Id);
DeRegister(LastError_Id);
DeRegister(Version_Id);
Module.Free;
end;
// -----------All xlRoutines here needed for recognition as Excel Add-In ------------
function xlAutoClose: Integer; stdcall;
begin
UnRegister_All;
Result := 1;
end;
function xlAutoOpen: Integer; stdcall;
begin
Register_All;
brc := 0;
generateCDF;
Result := 1;
end;
function xlAddInManagerInfo(xl: lpxloper): lpxloper; stdcall;
var
xint, xintval: XLOPER;
begin
xint.xltype := xltypeInt; // Always used to specify type of input
xint.val.w := xltypeInt; // Conversion type is set here
EResult := Excel4v(xlCoerce, @xintval, 2, [xl, @xint]);
asm pop sink;
end; // Never Remove
if (xintval.val.w = 1) then
begin
res.xltype := xltypeStr;
res.val.str := @DLLversion;
end
else
begin
res.xltype := xltypeErr;
res.val.err := 15;
end;
Result := @res;
end;
function xlAutoRegister(pXName: lpxloper): lpxloper; stdcall;
begin
Result := @res;
end;
function xlAutoRemove: Integer; stdcall;
begin
ShowMessage('CDF DLL Removed.');
// Tidy Up code here
Result := 1;
end;
function xlAutoAdd: Integer; stdcall;
begin
Register_All;
ShowMessage('CDF Calc DLL Added.');
Result := 1;
end;
procedure xlAutoFree(ramptr: lpxloper); stdcall;
begin
Freemem(ramptr);
end;
constructor txloper.Create;
begin
inherited Create;
fillchar(fActualStr, sizeof(fActualStr), 0);
fillchar(fxloper, sizeof(fxloper), 0);
end;
Destructor txloper.Destroy;
begin
inherited Destroy;
end;
Constructor txloper.Create_Str(NewStr: ShortString);
begin
inherited Create;
fillchar(fxloper, sizeof(fxloper), 0);
fillchar(fActualStr, sizeof(fActualStr), 0);
SetStr(NewStr);
end;
procedure txloper.SetStr(NewStr: ShortString);
begin
fillchar(fActualStr, sizeof(fActualStr), 0);
fActualStr := NewStr;
fxloper.xltype := xltypeStr;
fxloper.val.str := addr(fActualStr);
end;
procedure txloper.SetErr;
begin
fxloper.xltype := xltypeErr;
fxloper.val.err := xlerrValue;
end;
procedure txloper.SetNum(NewNumber: Integer);
begin
fxloper.xltype := xltypeNum;
fxloper.val.num := NewNumber;
end;
procedure txloper.SetInt(NewNumber: Integer);
begin
fxloper.xltype := xltypeInt;
fxloper.val.num := NewNumber;
end;
function txloper.Getlpxloper: lpxloper;
begin
Result := addr(fxloper);
end;
exports
// Excel Recognition functions
xlAutoFree,
xlAutoAdd,
xlAutoOpen,
xlAutoClose,
xlAutoRemove,
xlAutoRegister,
xlAddInManagerInfo,
// Exported Invisible Functions
GetXlStack,
FreeRam,
// Exported Visible Functions go here
GetCDF,
LastError,
Version;
begin
HaveRegistered := false;
end.
Page updated
Google Sites
Report abuse