robinnixon
Programmer
I was trying to find here some example of calling Delphi procedures from VFP and I didn't found anything. That's why I spent last weekend with VFP a Delphi together.
Before I'll show you my solution I want to tell you taht my task was to display 4-byte single data type in VFP. That's why I used it that way. I don't know how usefull it can be for you, but you can see in this example returning integer values, working with pointers and some other stuff...
Jakub
jakub.kasse@seznam.cz
------ Delphi source "dllProject.pas" ------
------ VFP source "dllFox.prg" ------
------ end of example ------
Before I'll show you my solution I want to tell you taht my task was to display 4-byte single data type in VFP. That's why I used it that way. I don't know how usefull it can be for you, but you can see in this example returning integer values, working with pointers and some other stuff...
Jakub
jakub.kasse@seznam.cz
------ Delphi source "dllProject.pas" ------
Code:
library dllProject;
uses
SysUtils, dialogs;
var
dllShowMessages : integer; // 0 = don't show messageboxes;
procedure dllMessage(strMess:string);
begin
if dllShowMessages<>0 then ShowMessage(strMess);
end;
procedure dllStr(p:pointer); cdecl;
// p should point to single-type variable and dllStr puts there PChar
// calling application must prepare enough space before calling dllStr
var
pSingle : ^single;
sNum : single;
pString : PChar;
strNum : string;
begin
dllMessage('begin dllStr()');
pSingle := p;
sNum := pSingle^;
dllMessage('str in: '+FloatToStr(sNum));
pString := p;
str(sNum,strNum);
dllMessage('str out: '+strNum);
strcopy(pString,pchar(strNum));
dllMessage('end dllStr()');
end;
function dllVal(p:pointer):integer; cdecl;
// p should point to and dllVal puts there 4-byte Single
// dllVal also returns error code
var
pString : PChar;
valCode : integer;
sNum : single;
pSingle : ^single;
begin
dllMessage('begin dllVal()');
pString := p;
dllMessage('val in: '+pString);
val(pString,sNum,valCode);
dllVal := valCode;
if valCode=0 then begin
dllMessage('val out: '+FloatToStr(sNum));
pSingle := p;
pSingle^ := sNum;
end else dllMessage('chyba pri prevodu '+pString);
dllMessage('end dllVal()');
end;
procedure dllShow(p:pointer); cdecl;
// p should point to 4-byte Single and dllShow shows number in messagebox
var
pNum : ^single;
sNum : single;
begin
dllMessage('begin dllShow()');
pNum := p;
sNum := pNum^;
ShowMessage(FloatToStr(sNum));
dllMessage('end dllShow()');
end;
procedure dllSetDebug(iSet:integer); cdecl;
begin
dllShowMessages := iSet;
end;
function dllGetDebug:integer; cdecl;
begin
dllGetDebug := dllShowMessages;
end;
exports
dllStr index 1,
dllVal index 2,
dllShow index 3,
dllSetDebug index 4,
dllGetDebug index 5;
begin
dllShowMessages := 0; // initially don't show debugging messages
end.
Code:
** jakub.kasse@seznam.cz
** delphi dll
dllFile = "d:\jakub\delphi\dll\dllProject.dll"
declare dllStr in (dllFile) string
declare integer dllVal in (dllFile) string
declare dllShow in (dllFile) string
declare dllSetDebug in (dllFile) integer
declare integer dllGetDebug in (dllFile)
local cString, nError
cString = "1.256e30" + ; && number we want to store in 4 bytes
+ chr(0) + ; && zero-end for delphi PChar
+ space(50) && and some space at the end, because I need it for dllStr
MessageBox(cString,"leaving VFP...")
nError = dllVal(@cString)
if nError#0 then
MessageBox("error at position: "+ltrim(str(nError)),"...delphi returned error")
else
&& now we have single variable stored in first four bytes of cString
dllSetDebug(1)
dllShow(@cString)
dllSetDebug(0)
dllStr(@cString)
endif
MessageBox(cString,"...back in VFP")
clear dlls