Writing Excel Addons - An example Add-In

(Page 8 of 8 )

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.

 

DISCLAIMER: The content provided in this article is not warranted or guaranteed by Developer Shed, Inc. The content provided is intended for entertainment and/or educational purposes in order to introduce to the reader key ideas, concepts, and/or product reviews. As such it is incumbent upon the reader to employ real-world tactics for security and implementation of best practices. We are not liable for any negative consequences that may result from implementing any information covered in our articles or tutorials. If this is a hardware review, it is not recommended to open and/or modify your hardware.

Comments On: Writing Excel Addons

>>> Be the FIRST to comment on this article!