Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How do I make delphi functions available to Excel users Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
07-Jul-03
Category
OLE
Language
Delphi 2.x
Views
244
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			Author: Manuel Sarmiento

How do I make delphi functions available to Excel users? 

I have seen many articles telling how to control Excel from within Delphi. However, 
it is also appealing to give Excel users (which tend to be far less programming 
oriented guys) the power of tools built with Dephi, its flexibility and velocity.

Answer:

The idea is very simple and is based upon the variable types that are common to 
Excel's VBA and to Delphi. Those include 32 bit integer, double precision floating 
point and, mainly, Excel ranges. 

I found that Excel sometimes interprets incorrectly simple types when passed by 
reference and thus I limmited their usage to value parameters. 
On the other hand, ranges can only be passed by reference and can be read from but 
not written to. This means that, within Delphi, you must use the reserved word 
CONST instead of VAR. 

First, I defined within a simple unit a set of functions that convert simple 
Variant types to simple types and viceversa. Those are IntToVar,Double and 
VarTodouble (the real unit also includes a StrToVar function but not a VarToStr 
since this one is already included in the System unit), and are used within the 
procedures that do the real work (RangeToMatrix, RangeToVector,VectorToMatrix and 
VectortoRange). 
All these functions (along with some others that you might find useful) are put 
together in a unit called "_Variants" whose source code is copied here (with some 
slight modifications). 

In the real unit you will find that there fucntions that provide conversion between 
Excel ranges and SDL delphi component suite which I have found to be quite useful 
(refer to www.lohninger.com). 

I shall restrict the examples, however to standard types. 

Lets take first a simple function: 
This function, called gamma_alfa, takes as input the mean and the variance of a 
population and returns the alfa parameter of a gamma distribution. 

In Excel's VBA it is declared as 
Declare Function gamma_alfa Lib "c:\archivos\del_files\f_auxiliares_delphi" Alias 
"gamma_alfa_XL" (ByVal media As Double, ByVal varianza As Double) As Double 

note the lib statement that refers to name that the DLL actually has. 
note also the ByVal modifiers used for declaring the variables as well as the "as 
double" statements. 
These mean that both the input and the output will be simple types of type double. 

In Delphi, the function is declared as 
function gamma_alfa(media, varianza : double) : Double;stdcall; 

Note the stdcall at the end of the declaration. This is to ensure that Delphi will 
use the Microsoft calling convention 

Also note the inconsistency between the delphi function's name and the "alias" 
statement in VBA. 
This is set in the export clause of the DLL: 

1   exports ..., 
2           gamma_alfa     name 'gamma_alfa_XL', 
3           ...; 
4   
5   //Although irrelevant, the implementation of the function follows: 
6   
7   implementation
8   
9   function gamma_alfa(media, varianza: double): Double; stdcall;
10  begin
11    gamma_alfa := media * media / varianza;
12  end;


Now, let's go to the tough stuff: sending Excel ranges as parameters. 
Now, I will make use of a function that gets and returns excel ranges as 
parameters: 
This function is called gamma_parametros and takes as input an histogram (with 
frequencies and class markers) and returns the alfa and beta parameters for a 
gamma. Here is its VBA declaration: 

Declare Function gamma_parametros Lib "c:\archivos\del_files\f_auxiliares_delphi" 
Alias "gamma_parametros_XL" (ByRef marcas_de_clase As Variant, ByRef frecuencias As 
Variant) As Variant 

Now note hte "Byref" and the as "Variant" types. 

In Delphi, the function is declared as follows: 

function gamma_parametros_XL(const _marcas_de_clase, _frecuencias: Variant): 
Variant;
  stdcall;

and is implemented as: 

13  function gamma_parametros_XL(const _marcas_de_clase, _frecuencias: 
14  Variant): Variant;
15    stdcall;
16  var
17    marcas_de_clase, frecuencias, pars: TVector_;
18    pars_: Variant;
19  begin
20    RangeToVector(_marcas_de_clase, marcas_de_clase);
21    RangeToVector(_frecuencias, frecuencias);
22    pars := gamma_parametros(marcas_de_clase, frecuencias);
23    VectorToRange(pars, pars_);
24    gamma_parametros_XL := pars_;
25  end;


Note that the functions that does the real work is not gamma_parametros_XL but 
gamma_parametros. The former only does the job of converting Excel ranges to 
TVector_ and viceversa. 

the exports clause exports gamma_parametros_XL, since it's the one that is 
replicated in the VBA definition, and thus it does not need a 'name' clause. 

Here is the implementation of the gamma_parametros function: 

26  function gamma_parametros(const marcas_de_clase, frecuencias: TVector_): 
27  TVector_;
28  var
29    pars: TVector_;
30    mu, sigmac: double;
31  begin
32    SetLength(pars, 2);
33    mu := media_ponderada(marcas_de_clase, frecuencias);
34    sigmac := varianza_ponderada(marcas_de_clase, frecuencias);
35    pars[0] := gamma_alfa(mu, sigmac);
36    pars[1] := gamma_beta(mu, sigmac);
37    gamma_parametros := pars;
38  end;
39  
40  //Here is the listing of the _Variants unit: 
41  
42  interface
43  uses SysUtils,
44    excel97,
45    vector,
46    matrix,
47    Classes,
48    Dialogs,
49    registry,
50    windows;
51  
52  type
53  
54    tmatriz = array of array of double;
55    tvector_ = array of double;
56  
57  function IntToVar(dato: longint): variant;
58  function DoubleToVar(dato: double): variant;
59  
60  function VarToDouble(const dato: variant): double;
61  
62  procedure RangeToMatrix(const rango: variant; var matriz: tmatriz);
63  procedure RangeToVector(const rango: variant; var matriz: tvector_);
64  procedure MatrixToRange(const matriz: tmatriz; var rango: variant);
65  procedure VectorToRange(const matriz: tvector_; var rango: variant);
66  
67  procedure transpose(var matriz: tmatriz);
68  
69  implementation
70  
71  function IntToVar(dato: longint): variant;
72  var
73    temp: variant;
74  begin
75    tvardata(temp).vtype := VarInteger;
76    tvardata(temp).Vinteger := dato;
77    IntToVar := temp;
78  end;
79  
80  function DoubleToVar(dato: double): variant;
81  var
82    temp: variant;
83  begin
84    tvardata(temp).vtype := VarDouble;
85    tvardata(temp).VDouble := dato;
86    DoubleToVar := temp;
87  end;
88  
89  function VarToDouble(const dato: variant): double;
90  var
91    temp: variant;
92  begin
93    try
94      temp := varastype(dato, vardouble);
95    except
96      on EVariantError do
97      begin
98        tvardata(temp).vtype := vardouble;
99        tvardata(temp).vdouble := 0.0;
100     end;
101   end;
102   VarToDouble := tvardata(temp).vdouble;
103 end;
104 
105 procedure RangeToMatrix(const rango: variant; var matriz: tmatriz);
106 var
107   Rows, Columns: longint;
108   i, j: longint;
109 begin
110   if ((tvardata(rango).vtype and vararray) = 0) and
111     ((tvardata(rango).vtype and vartypemask) = vardispatch) then
112   begin
113     Rows := Rango.rows.count;
114     Columns := Rango.columns.count;
115     SetLength(matriz, Rows);
116     for i := 0 to Rows - 1 do
117       SetLength(matriz[i], Columns);
118     for i := 0 to Rows - 1 do
119       for J := 0 to Columns - 1 do
120         matriz[i, j] := VarToDouble(Rango.cells[i + 1, j + 1]);
121   end
122   else if ((tvardata(rango).vtype and vararray) <> 0) then
123   begin
124     rows := vararrayhighbound(rango, 1) - vararraylowbound(rango, 1) + 1;
125     if VarArrayDimCount(rango) = 2 then
126     begin
127       columns := vararrayhighbound(rango, 2) - vararraylowbound(rango, 2) + 1;
128       setLength(matriz, rows);
129       for i := 0 to Rows - 1 do
130         SetLength(matriz[i], Columns);
131       for i := 0 to Rows - 1 do
132         for J := 0 to Columns - 1 do
133           matriz[i, j] := vartodouble(rango[i + 1, j + 1]);
134     end
135     else
136     begin
137       setlength(matriz, 1);
138       setlength(matriz[0], rows);
139       for i := 0 to rows - 1 do
140         matriz[0, i] := vartodouble(rango[i + 1]);
141     end;
142   end
143   else
144   begin
145     rows := 1;
146     columns := 1;
147     setLength(matriz, rows);
148     setLength(matriz[0], columns);
149     matriz[0, 0] := vartodouble(rango);
150   end
151 end;
152 
153 procedure RangeToVector(const rango: variant; var matriz: tvector_);
154 var
155   Rows, columns: longint;
156   i, j: longint;
157 begin
158   if ((tvardata(rango).vtype and vararray) = 0) and
159     ((tvardata(rango).vtype and vartypemask) = vardispatch) then
160   begin
161     Rows := Rango.count;
162     SetLength(matriz, Rows);
163     for i := 0 to Rows - 1 do
164       matriz[i] := VarToDouble(Rango.cells[i + 1]);
165   end
166   else if ((tvardata(rango).vtype and vararray) <> 0) then
167   begin
168     rows := vararrayhighbound(rango, 1) - vararraylowbound(rango, 1) + 1;
169     if VarArrayDimCount(rango) = 1 then
170     begin
171       setLength(matriz, rows);
172       for i := 0 to rows - 1 do
173         matriz[i] := vartodouble(rango[i + 1]);
174     end
175     else
176     begin
177       columns := vararrayhighbound(rango, 2) - vararraylowbound(rango, 2) + 1;
178       setlength(Matriz, Columns * Rows);
179       for i := 1 to rows do
180         for j := 1 to columns do
181         try
182           matriz[(i - 1) * columns + j] := VarToDouble(rango[i, j]);
183         except
184           on EVariantError do
185             matriz[(i - 1) * columns + j] := 0;
186         end;
187     end
188   end
189   else
190   begin
191     rows := 1;
192     setLength(matriz, rows);
193     matriz[0] := vartodouble(rango);
194   end;
195 end;
196 
197 procedure MatrixToRange(const matriz: tmatriz; var rango: variant);
198 var
199   Rows, Columns: longint;
200   i, j: longint;
201 begin
202   Rows := high(matriz) - low(matriz) + 1;
203   Columns := high(matriz[0]) - low(matriz[0]) + 1;
204   rango := VarArrayCreate([1, Rows, 1, Columns], varDouble);
205   for i := 1 to Rows do
206     for j := 1 to Columns do
207       rango[i, j] := matriz[i - 1, j - 1];
208 end;
209 
210 procedure VectorToRange(const matriz: tvector_; var rango: variant);
211 var
212   Rows: longint;
213   i: longint;
214 begin
215   Rows := high(matriz) - low(matriz) + 1;
216   rango := VarArrayCreate([1, Rows], varDouble);
217   for i := 1 to Rows do
218     rango[i] := matriz[i - 1];
219 end;
220 
221 procedure transpose(var matriz: tmatriz);
222 var
223   Rows, Columns,
224     i, j: longint;
225   temp: double;
226 begin
227   Rows := high(matriz) - low(matriz) + 1;
228   Columns := high(matriz[0]) - low(matriz[0]) + 1;
229   for i := 0 to rows - 1 do
230     for j := i to columns - 1 do
231     begin
232       temp := matriz[i, j];
233       matriz[i, j] := matriz[j, i];
234       matriz[j, i] := temp;
235     end;
236 end;
237 
238 end.


One final warning note: 

Notice that the types' names in VBA are NOT the same as in Delphi. 
The two must obvious are BOOLEAN (which in VBA is a 2 byte type whereas in Delphi 
is a one byte type). Thus you MUST use WORDBOOL in Delphi. 
The other obvious type is INTEGER (in DElphi is a 4-byte type and in VBA a 2-byte 
type). To avoid confussion use LONGINT in Delphi and LONG in VBA 

I will be more than glad to send you the full source code of the _Variant unit

			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC