R
RB Smissaert
Made a C++ dll with MS VC6 and trying to call the dll from Excel VBA.
This is the code in the .cpp file:
#include "stdafx.h"
#include <string>
#include <math.h>
using namespace std;
BOOL APIENTRY DllMain( HANDLE hModule,
DWORD ul_reason_for_call,
LPVOID lpReserved
)
{
return TRUE;
}
//to compare case in-sensitive
//----------------------------
int CompareIgnoreCase(const string& s, const string& s2)
{
string::const_iterator p = s.begin(),
p2 = s2.begin();
while(p!= s.end() && p2!= s2.end()){
if(tolower(*p)!= tolower(*p2))return tolower(*p)< tolower(*p2) ? -1: 1;
++p; ++p2;
}
return s2.size()- s.size();
}
//round number n to d decimal points
//----------------------------------
double fround(double n, unsigned d)
{return floor(n * pow(10, d) + 0.5) / pow(10, d);}
double _stdcall Framingham2 (long Age,
long SysBP,
double TotChol,
double HDL,
string Sex,
string Diabetes,
string LVH,
string Smoke,
long Years = 10)
{
int x;
int btSex;
int btDiabetes;
int btLVH;
int btSmoke;
string sFEMALE = "FEMALE";
string sYES = "YES";
double dMu;
double dS;
double dU;
double dProb;
//exclude out of range input
//--------------------------
if ((Age < 35) ||
(Age > 75) ||
(SysBP < 50) ||
(SysBP > 300) ||
(TotChol < 1) ||
(TotChol > 30) ||
(HDL < 0.2) ||
(HDL > 10) ||
(Years > 10))
return 0;
x = CompareIgnoreCase(Sex,sFEMALE);
if (x == 0)
btSex = 1;
else
btSex = 0;
x = CompareIgnoreCase(Diabetes,sYES);
if (x == 0)
btDiabetes = 1;
else
btDiabetes = 0;
x = CompareIgnoreCase(LVH,sYES);
if (x == 0)
btLVH = 1;
else
btLVH = 0;
x = CompareIgnoreCase(Smoke,sYES);
if (x == 0)
btSmoke = 1;
else
btSmoke = 0;
dMu = 15.5305 +
28.4441 * btSex +
-1.4792 * log(Age) +
-14.4588 * log(Age) * btSex +
1.8515 * pow(log(Age), 2) * btSex +
-0.9119 * log(SysBP) +
-0.2767 * btSmoke +
-0.7181 * log(TotChol / HDL) +
-0.1759 * btDiabetes +
-0.1999 * btDiabetes * btSex +
-0.5865 * btLVH;
dS = exp(0.9145 + (-0.2784 * dMu));
dU = (log(Years) - dMu) / dS;
dProb = 1 - exp(-exp(dU));
return fround(dProb * 100,1);
}
I have included a .def file with this:
EXPORTS
Framingham2
It compiles (win32 release) nicely without any errors or warnings.
The function also shows nicely when I run DEPENDS.EXE.
I have checked the function in a C++ console app and that runs fine giving
the right
results. This is without input arguments though and with the values
hard-coded.
In Excel VBA I do this:
Option Explicit
Private Declare Function Framingham2 _
Lib "C:\Program Files\Microsoft Visual
Studio\MyProjects\Framingham\Release\Framingham.dll" _
(ByVal Age As Long, _
ByVal SysBP As Long, _
ByVal TotChol As Double, _
ByVal HDL As Double, _
ByVal Sex As String, _
ByVal Diabetes As String, _
ByVal LVH As String, _
ByVal Smoke As String, _
ByVal Years As Long) As Double
Sub test()
MsgBox Framingham2(50, 140, 5.6, 1.6, "male", "no", "no", "no", 10)
End Sub
This compiles fine, but when I run Sub test() I get Run-time error 49: Badd
DLL calling convention.
I have tried altering the datatypes both in the VBA declaration and in the
..cpp file but no success.
I am completely new to this, so I am sure I have done something stupid
somewhere, but I just can't find it.
Thanks for any advice.
RBS
This is the code in the .cpp file:
#include "stdafx.h"
#include <string>
#include <math.h>
using namespace std;
BOOL APIENTRY DllMain( HANDLE hModule,
DWORD ul_reason_for_call,
LPVOID lpReserved
)
{
return TRUE;
}
//to compare case in-sensitive
//----------------------------
int CompareIgnoreCase(const string& s, const string& s2)
{
string::const_iterator p = s.begin(),
p2 = s2.begin();
while(p!= s.end() && p2!= s2.end()){
if(tolower(*p)!= tolower(*p2))return tolower(*p)< tolower(*p2) ? -1: 1;
++p; ++p2;
}
return s2.size()- s.size();
}
//round number n to d decimal points
//----------------------------------
double fround(double n, unsigned d)
{return floor(n * pow(10, d) + 0.5) / pow(10, d);}
double _stdcall Framingham2 (long Age,
long SysBP,
double TotChol,
double HDL,
string Sex,
string Diabetes,
string LVH,
string Smoke,
long Years = 10)
{
int x;
int btSex;
int btDiabetes;
int btLVH;
int btSmoke;
string sFEMALE = "FEMALE";
string sYES = "YES";
double dMu;
double dS;
double dU;
double dProb;
//exclude out of range input
//--------------------------
if ((Age < 35) ||
(Age > 75) ||
(SysBP < 50) ||
(SysBP > 300) ||
(TotChol < 1) ||
(TotChol > 30) ||
(HDL < 0.2) ||
(HDL > 10) ||
(Years > 10))
return 0;
x = CompareIgnoreCase(Sex,sFEMALE);
if (x == 0)
btSex = 1;
else
btSex = 0;
x = CompareIgnoreCase(Diabetes,sYES);
if (x == 0)
btDiabetes = 1;
else
btDiabetes = 0;
x = CompareIgnoreCase(LVH,sYES);
if (x == 0)
btLVH = 1;
else
btLVH = 0;
x = CompareIgnoreCase(Smoke,sYES);
if (x == 0)
btSmoke = 1;
else
btSmoke = 0;
dMu = 15.5305 +
28.4441 * btSex +
-1.4792 * log(Age) +
-14.4588 * log(Age) * btSex +
1.8515 * pow(log(Age), 2) * btSex +
-0.9119 * log(SysBP) +
-0.2767 * btSmoke +
-0.7181 * log(TotChol / HDL) +
-0.1759 * btDiabetes +
-0.1999 * btDiabetes * btSex +
-0.5865 * btLVH;
dS = exp(0.9145 + (-0.2784 * dMu));
dU = (log(Years) - dMu) / dS;
dProb = 1 - exp(-exp(dU));
return fround(dProb * 100,1);
}
I have included a .def file with this:
EXPORTS
Framingham2
It compiles (win32 release) nicely without any errors or warnings.
The function also shows nicely when I run DEPENDS.EXE.
I have checked the function in a C++ console app and that runs fine giving
the right
results. This is without input arguments though and with the values
hard-coded.
In Excel VBA I do this:
Option Explicit
Private Declare Function Framingham2 _
Lib "C:\Program Files\Microsoft Visual
Studio\MyProjects\Framingham\Release\Framingham.dll" _
(ByVal Age As Long, _
ByVal SysBP As Long, _
ByVal TotChol As Double, _
ByVal HDL As Double, _
ByVal Sex As String, _
ByVal Diabetes As String, _
ByVal LVH As String, _
ByVal Smoke As String, _
ByVal Years As Long) As Double
Sub test()
MsgBox Framingham2(50, 140, 5.6, 1.6, "male", "no", "no", "no", 10)
End Sub
This compiles fine, but when I run Sub test() I get Run-time error 49: Badd
DLL calling convention.
I have tried altering the datatypes both in the VBA declaration and in the
..cpp file but no success.
I am completely new to this, so I am sure I have done something stupid
somewhere, but I just can't find it.
Thanks for any advice.
RBS