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 create macros 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 cdfcalc;



uses

  SysUtils,

  windows,

  dialogs,

  forms,

  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='CDF Calc V1.02';

  AddInCategory='CDF 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.



-------------------------------------------

This article originally appeared in Delphi Developer.

 

Share this article!

Follow us!

Find more helpful articles: