Here is a new and revised version. There are some Functions have been added.
////////////////////////////////////////////////////////////
// Direct3D Function Snippet // Code by Jukuma // 06/2009 //
////////////////////////////////////////////////////////////
InitD3D()
// MakeObjectTeapot(object)
MakeObjectTeapot(1)
gosub RotateObject
// Set3DTextFont(font$, bold, italic, charset)
// MakeObject3DText(object, text$, deviation, extrusion)
Set3DTextFont("Comic Sans MS", 1, 0, 1)
MakeObject3DText(1, "3D Text", 0.001, 0.50)
gosub RotateObject
Set3DTextFont("Impact", 0, 1, 1)
MakeObject3DText(1, "3D Text", 0.001, 0.25)
gosub RotateObject
Set3DTextFont("Arial", 0, 0, 2)
MakeObject3DText(1, "ABCDEFG", 0.001, 0.25)
gosub RotateObject
Set3DTextFont("Times New Roman", 1, 1, 1)
MakeObject3DText(1, "3D Text", 0.001, 0.01)
gosub RotateObject
// MakeObjectTorus(object, radius1#, radius2#, sides, rings)
MakeObjectTorus(1, 1, 2, 32, 32)
gosub RotateObject
MakeObjectTorus(1, 1, 2, 3, 32)
gosub RotateObject
MakeObjectTorus(1, 1, 5, 32, 4)
gosub RotateObject
MakeObjectTorus(1, 1, 5, 32, 3)
gosub RotateObject
// MakeObjectCylinder(object, radius1#, radius2#, length#, slices, stacks)
MakeObjectCylinder(1, 1, 1, 3, 32, 32)
gosub RotateObject
MakeObjectCylinder(1, 1, 2, 2, 32, 32)
gosub RotateObject
MakeObjectCylinder(1, 0, 1, 2, 32, 32)
gosub RotateObject
MakeObjectCylinder(1, 0, 1, 1, 4, 1)
gosub RotateObject
// MakeObjectPolygon(object, length#, sides)
MakeObjectPolygon(1, 1, 32)
gosub RotateObject
MakeObjectPolygon(1, 1, 8)
gosub RotateObject
MakeObjectPolygon(1, 1, 4)
gosub RotateObject
MakeObjectPolygon(1, 1, 3)
gosub RotateObject
FreeD3D()
end
RotateObject:
repeat
set cursor 0, 0
print "FPS: ", screen fps()
print "Press a mouse button ..."
turn object left 1, mousemovex() * 0.2
pitch object up 1, mousemovey() * 0.2
until mouseclick()
while mouseclick() : endwhile
delete object 1
return
////////////////////////
// Direct3D Functions //
////////////////////////
function InitD3D()
global g_D3DX9, g_pD3DDevice, g_pMesh, g_pFont, g_pFace
g_D3DX9 = GetFreeDLL()
load dll "d3dx9_31.dll", g_D3DX9
dbpsetup = GetFreeDLL()
load dll "dbprosetupdebug.dll", dbpsetup
g_pD3DDevice = call dll(dbpsetup, "?GetDirect3DDevice@@YAPAUIDirect3DDevice9@@XZ")
delete dll dbpsetup
g_pMesh = make memory(4)
g_pFont = make memory(56)
g_pFace = make memory(32)
Set3DTextFont("", 0, 0, 0)
endfunction
function FreeD3D()
delete dll g_D3DX9
delete memory g_pMesh
delete memory g_pFont
delete memory g_pFace
endfunction
function MakeObjectBox(object, width#, height#, depth#)
call dll g_D3DX9, "D3DXCreateBox", g_pD3DDevice, width#, height#, depth#, g_pMesh, 0
CreateObject(object)
endfunction
function MakeObjectCylinder(object, radius1#, radius2#, length#, slices, stacks)
call dll g_D3DX9, "D3DXCreateCylinder", g_pD3DDevice, radius1#, radius2#, length#, slices, stacks, g_pMesh, 0
CreateObject(object)
endfunction
function MakeObjectPolygon(object, length#, sides)
call dll g_D3DX9, "D3DXCreatePolygon", g_pD3DDevice, length#, sides, g_pMesh, 0
CreateObject(object)
set object cull object, 0
endfunction
function MakeObjectSphere(object, radius#, slices, stacks)
call dll g_D3DX9, "D3DXCreateSphere", g_pD3DDevice, radius#, slices, stacks, g_pMesh, 0
CreateObject(object)
endfunction
function MakeObjectTeapot(object)
call dll g_D3DX9, "D3DXCreateTeapot", g_pD3DDevice, g_pMesh, 0
CreateObject(object)
endfunction
function MakeObjectTorus(object, radius1#, radius2#, sides, rings)
call dll g_D3DX9, "D3DXCreateTorus", g_pD3DDevice, radius1#, radius2#, sides, rings, g_pMesh, 0
CreateObject(object)
endfunction
function Set3DTextFont(font$, bold, italic, charset)
restore FontDefault
p = g_pFace
for i = 1 to len(font$)
*p = asc(mid$(font$, i))
inc p
next i
p = g_pFont
for i = 1 to 13
read d : *p = d : inc p, 4
next i
*p = g_pFace
if bold then p = g_pFont + 16 : *p = 700
if italic then p = g_pFont + 20 : *p = 1
p = g_pFont + 32 : *p = charset
FontDefault:
data 0, 0, 0, 0, 400, 0, 0, 0, 1, 7, 0, 4, 0
endfunction
function MakeObject3DText(object, text$, deviation#, extrusion#)
user32 = GetFreeDLL()
load dll "user32.dll", user32
hWin = call dll(user32, "GetActiveWindow")
hDC = call dll(user32, "GetDC", hWin)
gdi32 = GetFreeDLL()
load dll "gdi32.dll", gdi32
hFont = call dll x(gdi32, "CreateFontA", g_pFont, 14)
call dll gdi32, "SelectObject", hDC, hFont
call dll g_d3dx9, "D3DXCreateTextA", g_pD3DDevice, hDC, text$, deviation#, extrusion#, g_pMesh, 0, 0
call dll gdi32, "DeleteObject", hFont
call dll user32, "ReleaseDC", hWin, hDC
delete dll user32
delete dll gdi32
CreateObject(object)
endfunction
function CreateObject(object)
call dll g_D3DX9, "D3DXSaveMeshToXA", str$(*g_pMesh), *g_pMesh, 0, 0, 0, 0, 0
mesh = GetFreeMesh()
load mesh str$(*g_pMesh), mesh
make object object, mesh, 0
delete file str$(*g_pMesh)
delete mesh mesh
endfunction
function GetFreeDLL()
for i = 255 to 1 step -1
if not dll exist(i) then exit
next i
endfunction i
function GetFreeMesh()
for i = 65535 to 1 step -1
if not mesh exist(i) then exit
next i
endfunction i
InitD3D()
Call this first to get the DBP Direct3D Device.
FreeD3D()
Cleans all the D3D and global stuff.
MakeObjectTeapot(object)
Creats a teapot object.
Set3DTextFont(font$, bold, italic, charset)
Sets the font and the look of it.
charset: 0 = ansi / 1 = default / 2 = symbol
MakeObject3DText(object, text$, deviation, extrusion)
Creats the 3D-Text object.
deviation: Maximum chordal deviation from TrueType font outlines.
extrusion: Extrude text in the negative z-direction.
MakeObjectTorus(object, radius1#, radius2#, sides, rings)
Creats a torus object.
radius1#: inner radius / radius2#: outer radius
MakeObjectCylinder(object, radius1#, radius2#, length#, slices, stacks)
Creats a cylinder or cone object.
MakeObjectPolygon(object, length#, sides)
Creats a polygone or plain object.
MakeObjectBox(object, width#, height#, depth#)
The same as the DBP function.
MakeObjectSphere(object, radius#, slices, stacks)
The same as the DBP function.
