Writing Excel Addons

Writing Excel add-ins with Delphi is a challenging project. In this article, David Bolton shows how it can be done, and highlights the various pitfalls waiting for the unwitting traveler in this largely unexplored frontier.

Contributed by
Rating: 5 stars5 stars5 stars5 stars5 stars / 10
December 14, 2004
Rate this Article:
MEH MEH++


SEARCH ASP FREE
TOOLS YOU CAN USE

advertisement

Despite Microsoft’s apparent unpopularity in some quarters, Excel really should place high on lists for "best software ever created." Of course, taking more than 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, you can also write add-in Dlls in C++ and Delphi. Those doing serious development need to buy the Excel 97 Developer’s Kit (ISBN 1-57231-498-2) (EDK) book, but of course it's 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 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. Let's get started, there's 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, 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 recognize 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.x
  • 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 functions 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 correspond 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. It's 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 initializing 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

The first and the second are the most common. The third is a bit weird and unless really needed, it is better to filter this out. 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're 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, 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. I.e., 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

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. It's very anti-social anyway: to just dump a bunch of values into a spreadsheet it might just overwrite a morning's 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.

The first memory allocation case occurs when you have called a routine that returns an xloper with data in it, e.g. 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.

In the second case, 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 around 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.

 

blog comments powered by Disqus
WINDOWS SCRIPTING ARTICLES

- More Windows Scripting Workarounds from Nilpo
- Overloading Methods and More in VBScript
- Improving MFC for Windows Vista
- Regular Expressions in VBScript
- Working with Dates in WMI
- Completing Calendars with VBScript Date Func...
- Building Calendars with VBScript Date Functi...
- Working With Dates and Times in VBScript
- Designing WCF DataContract Classes Using the...
- Understanding Dates and Times in VBScript
- Working With Arrays in VBScript
- Compressed Folders in WSH
- Using .NET Interops in VBScript
- Nilpo`s Scripting Secrets, Vol I
- Database operations using Silverlight 2.0 WC...

ASP Web Hosting ASP.Net Web Hosting Windows Web Hosting
ASP Free Forums 
 RSS  Tutorials RSS
 RSS  Forums RSS
 RSS  All Feeds
Site Map 
Request Media Kit
Write For Us Get Paid 
Weekly Newsletter
 
Developer Updates  
Free Website Content 
Privacy Policy 
Support 


© 2003-2012 by Developer Shed. All rights reserved. DS Cluster 8 - Follow our Sitemap
Most Popular Topics
All ASP.Net Tutorials