Hello Charles..
Do you have any examples how to load an external freebasic DLL file with oxygen?
Freebasic
' file: batman32.bas
' compile as: fbc -dll batman32.bas
#include once "Batman32.bi"
function HelloBatman(ByVal s As string) as String Export
return "HelloBatman "+s
End function
This compiling with freebasic produces a batman32.dll File and all OK Here
But how to load the dll to oxygen with using the function ?
Batman32.bi File
' batman32.bi
declare function HelloBatman Alias "HelloBatman"(ByVal s As String) as String
Last Not least Test File
Freebasic
' test-batman32.bas file to test Batman32.dll
'
#include "batman32.bi"
#inclib "batman32"
Dim s As String
s="World!"
print HelloBatman(s) ' result HelloBatman World
Print "ok"
sleep
Hi Frank,
I have not used Freebasic since 2017 so I refer to my experiebce with eatlier O2 compilations.
First make sure your FreeBasic DLL declarations do not produce C-mangled names
Second, FreeBasic strings are not the same as OxygenBasic strings so you need to use a compatible type: zstring ptr / char ptr
' batman32.bi
#ifdef OS_MS
extern "Windows-MS"
#else
extern "C"
#endif
' file: batman32.bas
' compile as: fbc -dll batman32.bas
'#include once "Batman32.bi"
declare function HelloBatman Alias "HelloBatman"(ByVal s As zString ptr) as zString ptr
function HelloBatman(ByVal s As zstring ptr) as zstring ptr Export
return "HelloBatman "+s
End function
end extern
OxygenBasic client
extern lib "batman32.dll"
declare function HelloBatman (char*) as char*
end extern
char s[]="World!"
print HelloBatman(s) ' result HelloBatman World
Print "ok"
Hello Charles..
Perhaps you can Check my Code example If you are seeing a mistake on my Side.. I know its long time ago you have worked with freebasic :-) from my Side example must Work but I have Got an Error "Missing or unloadable Hello Batman"...
Thanks frank
'
uses console
' file: batman32.bas
' compile as: fbc -dll batman32.bas
' freebasic ------------------- >
'#include once "Batman32.bi"
'declare function HelloBatman Alias "HelloBatman"(ByVal s As zString ptr) as zString ptr
'function HelloBatman(ByVal s As zstring ptr) as zstring ptr Export
' return "HelloBatman "+s
'End function
'end extern
'' ------------------- > freebasic ends
'
' oxygen
#ifdef OS_MS
extern "Windows-MS"
#else
extern "C"
#endif
print "ok "
extern lib "batman32.dll"
declare function HelloBatman lib "batman32.dll" (s as zstring ptr) as zstring ptr
print " ok2 "
'declare function HelloBatman (s as zstring ptr) as zstring ptr
'declare function HelloBatman lib "batman32.dll" alias "HelloBatman" (byref s as zstring ptr) as zstring ptr
end extern
zstring s[]="World!"
'sys psz=strptr s
'print cast zstring HelloBatman *s ' result HelloBatman World
'--------------------- // problem
print HelloBatman s[] ' doesnt work error, missing or unloadable HelloBatman
'--------------------- // problem
'print s[] ' ok
Print " ok3 "
wait
I think this should go at the start of the FB DLL, not o2
#ifdef OS_MS
extern "Windows-MS"
#else
extern "C"
#endif
No Chance doesn't Work at all dont know why from my Side all is doing correct Here
Tried also with zstring ptr, then extern stdcall lib "batman32.dll." and much more.. after two hours to find a solution I give Up this construct
Freebasic Side is OK so far tested all.. thx
Looking through Oxygen.bas (inc\OXFBC\):
You could try adding this to your DLL:
'---------------------
sub ctor() constructor
'=====================
'print "attach"
end sub
'--------------------
sub dtor() destructor
'====================
'print "detach"
end sub
end extern
Yes.. I have Got it :-)
The Problem lies in extern... End extern in for example "mydll4.bas" file
And in this File you must Take the end extern below all other Code..
Need almost three hours to find this little Trick
Oxygen example Works Here fine now.. took another freebasic File AS a Test
Oxygen Test File
'
uses console
print "ok "
extern stdcall lib "mydll4.dll"
declare function AddNumbers lib "mydll4.dll"( byval a as integer, byval b as integer ) as integer
end extern
dim x as integer
dim y as integer
x=10
y=20
print AddNumbers (x,y) ' 30 -> yes!! work here
Print " ok2 "
wait
Freebasic Side: mydll4.bas File
'' freebasic mydll4.bas
' Compile AS: fbc -dll mydll4.bas
''
''#Include once "windows.bi"
'Extern "Windows-MS"
#Include Once "windows.bi"
#Ifdef OS_MS
extern "Windows-MS"
#Else
extern "C"
#endif
'---------------------
Sub ctor() constructor
'=====================
Print "attach"
End sub
'--------------------
Sub dtor() destructor
'====================
print "detach"
end sub
'end extern ' must be at the end of code example ! :-)
#Include once "mydll4.bi"
'' simple exported function, the full prototype is in mydll.bi.
'' (the EXPORT clause must be used here)
function AddNumbers( byval a as integer, byval b as integer) as integer export
function = a + b
end function
End extern
Forgotten mydll4.bi File
'' mydll4.bi
''
declare function AddNumbers alias "AddNumbers"( byval a as integer, byval b as integer ) as integer
I downloaded FB and looked at their DLL example:
extern "Windows-MS"
This prevents dll function names from being mangled in freebasic
"AddNumbers@8" becomes "AddNumbers"
This is required in general when using MS platforms and their DLLs
freebasuc mydll.bas
extern "Windows-MS"
#include once "mydll.bi"
'' simple exported function, the full prototype is in mydll.bi.
'' (the EXPORT clause must be used here)
function AddNumbers( byval a as integer, byval b as integer) as integer export
function = a + b
end function
end extern
freebasic test.bas
xtern "Windows-MS"
#inclib "mydll"
#include "mydll.bi"
end extern
randomize( timer( ) )
dim as integer x = rnd( ) * 10
dim as integer y = rnd( ) * 10
print x; " +"; y; " ="; AddNumbers( x, y )
Oxygen test.bas
extern lib "mydll.dll"
include "myDLL.bi"
end extern
print AddNumbers( 2, 3 ) cr
Hello Charles, Made another example for Testing with a Screen depth Test
Oxygen Test File:
' test: depth3dll.bas for oxygen basic
' 24-12-2024, frank bruebach
'
uses console
mbox "push return for next screen"
print "ok "
extern stdcall lib "depth3dll.dll"
declare function depth3 lib "depth3dll.dll"( byval a as integer, byval b as integer ) as integer
end extern
depth3(1,1) ' only a test, doesn't matter if I am using a function or a sub. it's working :-)
Print " ok2 "
print "push a key to exit"
wait
Depth3.bi File
'depth3.bi
Declare function depth3 Alias "depth3" (ByVal x AS Integer,ByVal y As Integer) AS INTEGER
Here the depth3dll.bas File (freebasic)
' test depth3dll.bas
'
#Include Once "windows.bi"
#Ifdef OS_MS
extern "Windows-MS"
#Else
extern "C"
#endif
'---------------------
Sub ctor() constructor
'=====================
Print "attach"
End sub
'--------------------
Sub dtor() destructor
'====================
print "detach"
end sub
#Include once "depth3.bi"
Function depth3(ByVal x As integer, ByVal y As integer) As Integer export
DIM key AS STRING, driver AS STRING
DIM AS INTEGER i, j, w, h, d, rate
DIM depth(3) AS INTEGER
depth(0) = 8
depth(1) = 16
depth(2) = 32
For i = 0 to 2
SCREEN 16, depth(i) '14
SCREENINFO w, h, d,,,rate, driver
LINE(0,0)-(w-1,h-1),IIF(i = 0, 40, CINT(RGB(255, 0, 0))),B
LOCATE 2,2: PRINT "Mode: " + STR(w) + "x" + STR(h) + "x" + STR(d);
IF (rate > 0) THEN
PRINT " @ " + STR(rate) + " Hz";
END IF
PRINT " (" + driver + ")"
IF (i = 0) THEN
FOR j = 0 TO 255: LINE(32+j, 100)-(32+j, 139), j : NEXT
ELSE
FOR j = 0 TO 255
LINE(32+j, 40)-(32+j, 79), j SHL 16
LINE(32+j, 100)-(32+j, 139), j SHL 8
LINE(32+j, 160)-(32+j, 199), j
NEXT
END IF
key = INKEY
WHILE key = "": key = INKEY: WEND
IF key = CHR(255) + "k" THEN END
NEXT i
Function = 1
End Function
End Extern
' ends
'depth2(1,1)
Good morning...
i have tested to load cWindow and afx headers from Jose Roca. Made a Test with freebasic AS a function and then build a DLL in freebasic. After that I load the fcWindmainDll.dll to oxygen.. IT Works :-)
oxygen test File
' test: cWind.bas for oxygen basic
' -> just a first test for cWindow Class (Afx) from jose roca
'
' 24+25-12-2024, frank bruebach
'
uses console
print "ok "
extern stdcall lib "fcWindowdll.dll"
declare function fWindMain lib "fcWindowdll.dll"(ByVal hInstance As sys, ByVal hPrevInstance AS sys,BYVAL szCmdLine AS ZSTRING Ptr,BYVAL nCmdShow AS Long ) As LONG
declare function fWndProc lib "fcWindowdll.dll"(BYVAL hWnd AS sys, BYVAL uMsg AS INT, BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG 'LRESULT
end extern
sys command
fWindMain(1, 1, COMMAND, 1) 'calls only the fWindMain function
Print " ok2 "
print "push a key to exit"
wait
Freebasic Side:
Creates a cWindow DLL File. I gave this File another Name fcWindowDll.bas for Testing purpose.
fcWindowDll.bas
' test fcWindowDll.bas / creates one .dll
' compile as: fbc -dll -> fcWindowDll.bas
' 24+25-12-2024, frank bruebach for translation to oxygenbasic
'
#Define UNICODE
#INCLUDE ONCE "Afx/CWindow.inc"
USING Afx
#Include Once "windows.bi"
#Ifdef OS_MS
extern "Windows-MS"
#Else
extern "C"
#endif
'---------------------
Sub ctor() constructor
'=====================
Print "attach"
End sub
'--------------------
Sub dtor() destructor
'====================
print "detach"
end sub
#Include once "cWind.bi"
'
Function fWindMain(ByVal hInstance As HINSTANCE, ByVal hPrevInstance AS HINSTANCE,BYVAL szCmdLine AS ZSTRING Ptr,BYVAL nCmdShow AS Long ) As LONG 'export
' // Set process DPI aware
AfxSetProcessDPIAware
' // Create the main window
DIM pWindow AS CWindow
'pWindow.Create(NULL, "CWindow Hello World with gradient", @fWndProc)
pWindow.Create(NULL, "CWindow Hello World with gradient", Cast(WndProc, @fWndProc) )
pWindow.Brush = GetStockObject(WHITE_BRUSH)
pWindow.SetClientSize(600, 420)
pWindow.Center
' // Adds a button
pWindow.AddControl("Button", , IDCANCEL, "&Close", 350, 250, 75, 23)
' // Display the window
FUNCTION = pWindow.DoEvents(nCmdShow)
End Function
'
Sub DrawGradient (BYVAL hwnd AS HWND, BYVAL hDC AS HDC)
DIM rc AS RECT, vertex(1) AS TRIVERTEX
GetClientRect hwnd, @rc
vertex(0).x = 0
vertex(0).y = 0
vertex(0).Red = &hFF00
vertex(0).Green = &hFF00
vertex(0).Blue = &h0000
vertex(0).Alpha = &h0000
vertex(1).x = rc.Right - rc.Left
vertex(1).y = rc.Bottom - rc.Top
vertex(1).Red = &h8000
vertex(1).Green = &h0000
vertex(1).Blue = &h0000
vertex(1).Alpha = &h0000
DIM gRect AS GRADIENT_RECT
gRect.UpperLeft = 0
gRect.LowerRight = 1
GradientFill hDc, @vertex(0), 2, @gRect, 1, GRADIENT_FILL_RECT_H
END SUB
'
FUNCTION fWndProc (BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT EXPORT
STATIC hNewFont AS HFONT
SELECT CASE uMsg
CASE WM_CREATE
' // Get a pointer to the CWindow class from the CREATESTRUCT structure
DIM pWindow AS CWindow PTR = AfxCWindowPtr(lParam)
' // Create a new font scaled according the DPI ratio
IF pWindow->DPI <> 96 THEN hNewFont = pWindow->CreateFont("Tahoma", 9)
EXIT FUNCTION
CASE WM_COMMAND
SELECT CASE GET_WM_COMMAND_ID(wParam, lParam)
CASE IDCANCEL
' // If ESC key pressed, close the application by sending an WM_CLOSE message
IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
END SELECT
CASE WM_PAINT
' // Draw the text
DIM ps AS PAINTSTRUCT, hOldFont AS HFONT
DIM hDC AS HDC = BeginPaint(hwnd, @ps)
DrawGradient hwnd, hdc
IF hNewFont THEN hOldFont = CAST(HFONT, SelectObject(hDC, CAST(HGDIOBJ, hNewFont)))
DIM rc AS RECT
GetClientRect hwnd, @rc
SetBkMode hDC, TRANSPARENT
SetTextColor hDC, &HFFFFFF
DrawTextW hDC, "Hello, Freebasic and OxygenBasic World!", -1, @rc, DT_SINGLELINE OR DT_CENTER OR DT_VCENTER
IF hNewFont THEN SelectObject(hDC, CAST(HGDIOBJ, CAST(HFONT, hOldFont)))
EndPaint hwnd, @ps
FUNCTION = CTRUE
EXIT FUNCTION
CASE WM_ERASEBKGND
' // Draw the gradient
DIM hDC AS HDC = CAST(HDC, wParam)
DrawGradient hwnd, hDC
FUNCTION = CTRUE
EXIT FUNCTION
Case WM_SIZE
' // Optional resizing code
IF wParam <> SIZE_MINIMIZED THEN
' // Retrieve a pointer to the CWindow class
DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
' // Move the position of the button
IF pWindow THEN pWindow->MoveWindow GetDlgItem(hwnd, IDCANCEL), _
pWindow->ClientWidth - 120, pWindow->ClientHeight - 50, 75, 23, CTRUE
END IF
CASE WM_DESTROY
' // Destroy the new font
IF hNewFont THEN DeleteObject(CAST(HGDIOBJ, hNewFont))
' // End the application by sending an WM_QUIT message
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
' // Default processing of Windows messages
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
End Extern
' important for display cWindow frame here
END fWindMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)
' ends
The cwind.bi File
'cWind.bi
Declare Function fWindMain Alias "fWindMain"(ByVal hInstance As HINSTANCE, ByVal hPrevInstance AS HINSTANCE,BYVAL szCmdLine AS ZSTRING Ptr,BYVAL nCmdShow AS Long ) As LONG
Declare Function fWndProc Alias "fWndProc"(BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
Freebasic Side:
To Control if the fcWindowDll.dll is working correct I Made this example with dylib
''
''
#Include Once "windows.bi"
dim library as any ptr
Dim hwnd As HWND
Dim fWindMain As Function (ByVal hInstance As hwnd, ByVal hPrevInstance AS hwnd,BYVAL szCmdLine AS ZSTRING Ptr,BYVAL nCmdShow AS Long ) As LONG 'export
library = dylibload( "fcwindowDll.dll" )
if( library = 0 ) then
print "Cannot load the fcwindowDll dynamic library"
sleep
end 1
end if
fWindMain = dylibsymbol( library, "fWindMain" )
if( fWindMain = 0 ) then
print "Could not get fWindMain()'s address from fWindMain library"
end 1
end if
Dim as HWND x
dim as HWND y
Dim As Long b
Dim w As ZString Ptr
fWindMain( x,y,w,b )
'Print "push a key to exit"
dylibfree library
Print "ends"
sleep
After this succesfully Test I load fcWindiw.dll to oxygen Basic. And thats working! :-)