[Solved] :Function pointers , Conversion from C , see last posting

[grindstone]

The "type defined as a function" is simply a callback routine.

Here a little illustration how it's used:

Code: Select all

Sub cb_proc(parameter As Integer) 'callback - routine
   Print "CallbackParameter ";parameter
End Sub

Type cb_fn As Sub(parameter As Integer) ' "Type" instead of "Dim" for use as a type member

Type type_with_callback
   As Integer value
   As cb_fn callback 'callback - routine as a type member
End Type

Dim As type_with_callback cbv

With cbv
   .callback = @cb_proc 'set pointer to callback - routine
   .value = 5 'set value for parameter

   .callback(.value) 'call callback - routine
End With

Dim As cb_fn cbr 'can also be used as "normal" callback - routine
cbr = @cb_proc
cbr(8)

Print "OK"
Sleep

[E Dingsor]

Hi,
Couldn't spend more time on trying to get it going. Used too much time already. Maybe I'll revisit task later.
Had to throw in the towel and compile xlcall.cpp file into an .o file and then convert .o file into .a static lib lib with ar.exe.

thanks again for all help and suggestions.
\E

[E Dingsor]

Hi,
Just got time to revisit my challenge. Couldn't just give in and continue using a static library with compiled C code.
Found the culprit: typedef int (PASCAL *EXCEL12PROC) (int xlfn, int coper, LPXLOPER12 *rgpxloper12, LPXLOPER12 xloper12Res)
Pascal should be translated into STDCALL convention and not PASCAL in Freebasic.

Here 's the converted code.
Updated zip file for making generic XLL addins for Excel will be posted here:
https://www.planetsquires.com/protect/f ... 0#msg31620
Eigil

Code: Select all

'**
'**  File:           SRC\XLCALL.CPP
'**  Description:    Code file for Excel callbacks
'**  Platform:       Microsoft Windows
'**
'**  This file defines the entry points 
'**  which are used in the Microsoft Excel C API.
'**
'*/

'#ifndef _WINDOWS_
'#include <windows.h>
'#endif

'#include "xlcall.h"

'/*
'** Excel 12 entry points backwards compatible with Excel 11
'**
'** Excel12 and Excel12v ensure backwards compatibility with Excel 11
'** and earlier versions. These functions will return xlretFailed when
'** used to callback into Excel 11 and earlier versions
'*/
extern "C"
const cxloper12Max  = 255
#define EXCEL12ENTRYPT "MdCallBack12"

'typedef int (PASCAL *EXCEL12PROC) (int xlfn, int coper, LPXLOPER12 *rgpxloper12, LPXLOPER12 xloper12Res)
type EXCEL12PROC as function stdcall(xlfn as long , coper as long, rgpxloper12 as LPXLOPER12 ptr, xloper12Res as LPXLOPER12 ) as long

extern     hmodule as HMODULE
dim shared hmodule as HMODULE
extern     pexcel12 as EXCEL12PROC 
dim shared  pexcel12 as EXCEL12PROC

#macro FetchExcel12EntryPt()

	if pexcel12 = NULL  then
	
		hmodule = GetModuleHandle(NULL)
		if hmodule <> NULL then
		
			pexcel12 = cast(EXCEL12PROC,GetProcAddress(hmodule, EXCEL12ENTRYPT))
		end if
	end if
#endmacro

'/*
'** This function explicitly sets EXCEL12ENTRYPT.
'**
'** If the XLL is loaded not by Excel.exe, but by a HPC cluster container DLL,
'** then GetModuleHandle(NULL) would return the process EXE module handle.
'** In that case GetProcAddress would fail, since the process EXE doesn't
'** export EXCEL12ENTRYPT ( since it's not Excel.exe).
'**
'** First try to fetch the known good entry point,
'** then set the passed in address.
'*/
'#ifdef __cplusplus
'extern "C"
'#endif	
'__declspec(dllexport)
sub  SetExcel12EntryPt stdcall (pexcel12New as EXCEL12PROC)  export
	FetchExcel12EntryPt()
	if pexcel12 = NULL  then	
		pexcel12 = pexcel12New
	end if
end sub

function Excel12 cdecl alias "Excel12"(lxlfn as long, operRes as LPXLOPER12 , count as long, ...) as long
	dim rgxloper12(cxloper12Max)  as LPXLOPER12  
   Dim ap As any PTR  
	dim as long ioper
	dim as long mdRet
  
	FetchExcel12EntryPt()
	if pexcel12 = NULL then      
		mdRet = xlretFailed	
	else	
		mdRet = xlretInvCount
		if (count >= 0  and  count <= cxloper12Max) then 
         ap = VA_FIRST() 
			for ioper = 0  to count - 1
            rgxloper12(ioper) = VA_ARG(ap, LPXLOPER12) 
				ap = VA_NEXT(ap, LPXLOPER12)
			next
			mdRet = pexcel12(lxlfn, count, @rgxloper12(0), operRes)
		end if
	end if
return mdRet
	
end function
end extern 

extern "Windows"

function EXCEL12V stdcall ALIAS "Excel12v"(lxlfn as long, operRes as LPXLOPER12 , icount as long, opers() as LPXLOPER12 ) as long
	dim  as long mdRet
	FetchExcel12EntryPt()
	if pexcel12 = NULL  then	
		mdRet = xlretFailed	
	else
		mdRet = pexcel12(lxlfn, icount, @opers(0), operRes)
	end if
	return mdRet

end function
end extern