ErosOlmi
25-08-2008, 15:45
Again some new things you will find in next thinBasic version.
TBGL power in a window control.
Please let us know if all is working fine.
Ciao
Eros
Updates
updated bundled exe with new TBGL module
fixed a problem occurring on some Intel graphic card drivers
Here the code preview of the attached executable.
Looking at the source code you can get an idea new TBGL control and dialog/controls callbacks functions.
Also note the new entry point function TBMain that will act like what "main" function is in C language.
'#MINVERSION 1.7.0.0
uses "TBGL", "UI"
global hCtrl as dword
global ExitProgram as long
global TBGL_TestFunction as string
' -- ID numbers of controls
Begin Const
%btnClose = 1000
%btnCanvasOn
%btnCanvasOff
%btn_test01
%btn_test02
%btn_test03
%gCanvas
%IDC_TIMER = 100
%TIMER_DELAY = 1 ' Timer delay (in milliseconds, not very accurate below about 100)
End Const
'------------------------------------------------------------
' Main function
'------------------------------------------------------------
function TBMAIN() as long
dim hDlg AS DWORD
DIALOG New 0, "Control test", 100, 100, 625, 390, _
%WS_POPUP Or %WS_VISIBLE Or _
%WS_CLIPCHILDREN Or %WS_CAPTION OR _
%WS_SYSMENU Or %WS_MINIMIZEBOX or %WS_THICKFRAME, 0 To hDlg
' -- Place controls here
hCtrl = CONTROL ADD label, hDlg, %gCanvas, "This is label control, press ON to use this label as TBGL canvas", 5, 5, 510, 380
control set color hDlg, %gCanvas, %YELLOW, %BLACK
CONTROL ADD BUTTON, hDlg, %btnCanvasOn , "On" , 520, 5, 100, 30,,, call CanvasButton
CONTROL ADD BUTTON, hDlg, %btnCanvasOff , "Off" , 520, 35, 100, 30,,, call CanvasButton
CONTROL ADD BUTTON, hDlg, %btn_test01 , "TBGL Test 1" , 520, 100, 100, 30,,, call cbChangeTest
CONTROL ADD BUTTON, hDlg, %btn_test02 , "TBGL Test 2" , 520, 130, 100, 30,,, call cbChangeTest
CONTROL ADD BUTTON, hDlg, %btn_test03 , "TBGL Test 3" , 520, 160, 100, 30,,, call cbChangeTest
CONTROL ADD BUTTON, hDlg, %btnClose , "Click to close", 520, 355, 100, 30,,, call CloseButton
' -- Set anchors
CONTROL Set RESIZE hDlg, %btnClose , 0, 1, 0, 1
CONTROL Set RESIZE hDlg, %btnCanvasOn , 0, 1, 1, 0
CONTROL Set RESIZE hDlg, %btnCanvasOff, 0, 1, 1, 0
CONTROL Set RESIZE hDlg, %gCanvas , 1, 1, 1, 1
CONTROL disable hDlg, %btnCanvasOff
CONTROL disable hDlg, %btn_test01, %btn_test02, %btn_test03
CONTROL Set RESIZE hDlg, %btn_test01 , 0, 1, 1, 0
CONTROL Set RESIZE hDlg, %btn_test02 , 0, 1, 1, 0
CONTROL Set RESIZE hDlg, %btn_test03 , 0, 1, 1, 0
dialog set minsize hDlg, 500, 400
TBGL_TestFunction = "Render_01"
DIALOG SHOW MODal hDlg, call DlgProc
End Function
'------------------------------------------------------------
' Callback function for main window
'------------------------------------------------------------
callback function DlgProc() as long
select case cbmsg
case %WM_CREATE
case %WM_INITDIALOG
dialog Set Timer cbhndl, %IDC_TIMER, %TIMER_DELAY
case %WM_SIZE
TBGL_UpdateCanvasProportions(hCtrl)
call TBGL_TestFunction
case %WM_SIZING
TBGL_UpdateCanvasProportions(hCtrl)
call TBGL_TestFunction
case %WM_TIMER
'---Dynamically call a function whose name is composed at run-time
'---In this case function name to be executed is inside TBGL_TestFunction string variable
call TBGL_TestFunction
case %WM_DESTROY
if TBGL_CanvasBound(hCtrl) then TBGL_ReleaseCanvas(hCtrl)
dialog Kill Timer cbhndl, %IDC_TIMER
end select
end function
'------------------------------------------------------------
' Callback function handling Close button
'------------------------------------------------------------
callback function CloseButton() as long
if CBMSG = %WM_COMMAND then
if cbctlmsg = %BN_CLICKED then DIALOG End cbhndl
end if
end function
'------------------------------------------------------------
' Callback function handling Canvas activation/deactivation
'------------------------------------------------------------
callback function CanvasButton() as long
if CBMSG = %WM_COMMAND then
if cbctlmsg = %BN_CLICKED then
select case cbctl
case %btnCanvasOn
TBGL_TestFunction = "Render_01"
CONTROL disable cbhndl, %btnCanvasOn
TBGL_BindCanvas(hCtrl)
CONTROL enable cbhndl, %btnCanvasOff, %btn_test02, %btn_test03
case %btnCanvasOff
CONTROL disable cbhndl, %btnCanvasOff
TBGL_ReleaseCanvas(hCtrl)
CONTROL disable cbhndl, %btn_test01, %btn_test02, %btn_test03
CONTROL enable cbhndl, %btnCanvasOn
end select
end if
end if
end function
'------------------------------------------------------------
' Callback function handling test type
'------------------------------------------------------------
callback function cbChangeTest() as long
if CBMSG = %WM_COMMAND then
if cbctlmsg = %BN_CLICKED then
select case cbctl
case %btn_test01
CONTROL disable cbhndl, %btn_test01
CONTROL enable cbhndl, %btn_test02, %btn_test03
TBGL_TestFunction = "Render_01"
TBGL_ReleaseCanvas(hCtrl)
TBGL_BindCanvas(hCtrl)
case %btn_test02
CONTROL disable cbhndl, %btn_test02
CONTROL enable cbhndl, %btn_test01, %btn_test03
TBGL_TestFunction = "Render_02"
TBGL_ReleaseCanvas(hCtrl)
TBGL_BindCanvas(hCtrl)
case %btn_test03
CONTROL disable cbhndl, %btn_test03
CONTROL enable cbhndl, %btn_test01, %btn_test02
TBGL_TestFunction = "Render_03"
TBGL_ReleaseCanvas(hCtrl)
TBGL_BindCanvas(hCtrl)
end select
end if
end if
end function
'------------------------------------------------------------
' TBGL render function 1
'------------------------------------------------------------
function Render_01() as long
static x, y, z as double
Static BoxColor as long
TBGL_UseLighting %TRUE
TBGL_UseLightSource %GL_LIGHT0, %TRUE
'TBGL_COLOR 255, 255, 255
if tbgl_GetwindowKeyState(hCtrl, %VK_R) then TBGL_COLOR 255,0,0
if tbgl_GetwindowKeyState(hCtrl, %VK_G) then TBGL_COLOR 0,255,0
if tbgl_GetwindowKeyState(hCtrl, %VK_B) then TBGL_COLOR 0,0,255
TBGL_ClearFrame
tbgl_Camera 0,0,5,0,0,0
tbgl_Rotate GetTickCount/100,1,1,1
tbgl_Box 1,1,1
tbgl_GetPixelInfo tbgl_MouseGetPosX, tbgl_MouseGetPosy, %TBGL_PINFO_XYZ, x, y, z
tbgl_Translate x,y,z
tbgl_Sphere 0.1
TBGL_DrawFrame
end function
'------------------------------------------------------------
' TBGL render function 2
'------------------------------------------------------------
function Render_02() as long
static i, j as long
TBGL_COLOR 255, 255, 255
TBGL_UseLighting %TRUE
TBGL_UseLightSource %GL_LIGHT0, %TRUE
' -- Erases previous frame
tbgl_ClearFrame
' -- Sets camera to look from 3,3,3 to 0,-1,0
tbgl_Camera 3, 3, 3, _
0, 0, 0
' -- All following geometry will be rotated around vector 0,1,0
' -- That is - Y axis
tbgl_Rotate gettickcount/100, 0, 1, 0
' -- Now we will try to render kind of spider
' -- It has ...
' .. One big head
tbgl_Color 255,196,0
tbgl_Sphere 0.25
' .. And eight legs
' .. We will draw them each 60°
for i = 0 to 359 step 45
tbgl_PushMatrix
tbgl_Rotate i, 0, 1, 0 ' 60, 120, 180, ...
' -- Legs will raise from bottom of head
tbgl_Translate 0, -0.25, 0
' -- With 3 part tentacle
tbgl_PushMatrix
for j = 1 to 3
tbgl_Color 255/j, 128/j, 0
' -- Some harmonic rotations will be provided by Sinus
tbgl_Rotate 70+sin(GetTickCount/1000+i+j)*20, 1, 0, 0
' -- Each tentacle part will be shorter and thinner than that before
tbgl_Cylinder ( 0.1/j, 0.1/(j+1), 1/j )
' -- When drawn, we need to move "cursor" at its end to bind new part
tbgl_Translate 0, 1/j, 0
next
tbgl_PopMatrix
tbgl_PopMatrix
next
' -- Finishes drawing
tbgl_DrawFrame
end function
'------------------------------------------------------------
' TBGL render function 3
'------------------------------------------------------------
function Render_03() as long
' Rotation Variable
static angle as single
' Timing Variables
static FrameRate as number
FrameRate = tbgl_GetFrameRate
tbgl_clearframe ' Clear Screen
tbgl_resetmatrix ' Reset the Current Matrix
tbgl_camera 0, 0, 1, 0, 0, 0 ' Default Camera Position
tbgl_translate 0, 0, -4 ' Move Pyramid to Centre of Screen
tbgl_rotate angle, 0.0, 1.0, 0.0 ' Rotation Setup
drawPyramid()
tbgl_drawframe ' Swap the Drawing Buffers
angle += 180.0/FrameRate
end function
'------------------------------------------------------------
' TBGL support to render function 3
'------------------------------------------------------------
sub drawPyramid()
tbgl_beginpoly %GL_TRIANGLE_FAN
tbgl_color 0, 128, 255 : tbgl_vertex 0.0, 1.0, 0.0
tbgl_color 255, 0, 0 : tbgl_vertex -1.0, -1.0, 1.0
tbgl_color 255, 255, 255 : tbgl_vertex 1.0, -1.0, 1.0
tbgl_color 0, 0, 255 : tbgl_vertex 1.0, -1.0, -1.0
tbgl_color 0, 255, 0 : tbgl_vertex -1.0, -1.0, -1.0
tbgl_color 255, 0, 0 : tbgl_vertex -1.0, -1.0, 1.0
tbgl_endpoly
end sub
TBGL power in a window control.
Please let us know if all is working fine.
Ciao
Eros
Updates
updated bundled exe with new TBGL module
fixed a problem occurring on some Intel graphic card drivers
Here the code preview of the attached executable.
Looking at the source code you can get an idea new TBGL control and dialog/controls callbacks functions.
Also note the new entry point function TBMain that will act like what "main" function is in C language.
'#MINVERSION 1.7.0.0
uses "TBGL", "UI"
global hCtrl as dword
global ExitProgram as long
global TBGL_TestFunction as string
' -- ID numbers of controls
Begin Const
%btnClose = 1000
%btnCanvasOn
%btnCanvasOff
%btn_test01
%btn_test02
%btn_test03
%gCanvas
%IDC_TIMER = 100
%TIMER_DELAY = 1 ' Timer delay (in milliseconds, not very accurate below about 100)
End Const
'------------------------------------------------------------
' Main function
'------------------------------------------------------------
function TBMAIN() as long
dim hDlg AS DWORD
DIALOG New 0, "Control test", 100, 100, 625, 390, _
%WS_POPUP Or %WS_VISIBLE Or _
%WS_CLIPCHILDREN Or %WS_CAPTION OR _
%WS_SYSMENU Or %WS_MINIMIZEBOX or %WS_THICKFRAME, 0 To hDlg
' -- Place controls here
hCtrl = CONTROL ADD label, hDlg, %gCanvas, "This is label control, press ON to use this label as TBGL canvas", 5, 5, 510, 380
control set color hDlg, %gCanvas, %YELLOW, %BLACK
CONTROL ADD BUTTON, hDlg, %btnCanvasOn , "On" , 520, 5, 100, 30,,, call CanvasButton
CONTROL ADD BUTTON, hDlg, %btnCanvasOff , "Off" , 520, 35, 100, 30,,, call CanvasButton
CONTROL ADD BUTTON, hDlg, %btn_test01 , "TBGL Test 1" , 520, 100, 100, 30,,, call cbChangeTest
CONTROL ADD BUTTON, hDlg, %btn_test02 , "TBGL Test 2" , 520, 130, 100, 30,,, call cbChangeTest
CONTROL ADD BUTTON, hDlg, %btn_test03 , "TBGL Test 3" , 520, 160, 100, 30,,, call cbChangeTest
CONTROL ADD BUTTON, hDlg, %btnClose , "Click to close", 520, 355, 100, 30,,, call CloseButton
' -- Set anchors
CONTROL Set RESIZE hDlg, %btnClose , 0, 1, 0, 1
CONTROL Set RESIZE hDlg, %btnCanvasOn , 0, 1, 1, 0
CONTROL Set RESIZE hDlg, %btnCanvasOff, 0, 1, 1, 0
CONTROL Set RESIZE hDlg, %gCanvas , 1, 1, 1, 1
CONTROL disable hDlg, %btnCanvasOff
CONTROL disable hDlg, %btn_test01, %btn_test02, %btn_test03
CONTROL Set RESIZE hDlg, %btn_test01 , 0, 1, 1, 0
CONTROL Set RESIZE hDlg, %btn_test02 , 0, 1, 1, 0
CONTROL Set RESIZE hDlg, %btn_test03 , 0, 1, 1, 0
dialog set minsize hDlg, 500, 400
TBGL_TestFunction = "Render_01"
DIALOG SHOW MODal hDlg, call DlgProc
End Function
'------------------------------------------------------------
' Callback function for main window
'------------------------------------------------------------
callback function DlgProc() as long
select case cbmsg
case %WM_CREATE
case %WM_INITDIALOG
dialog Set Timer cbhndl, %IDC_TIMER, %TIMER_DELAY
case %WM_SIZE
TBGL_UpdateCanvasProportions(hCtrl)
call TBGL_TestFunction
case %WM_SIZING
TBGL_UpdateCanvasProportions(hCtrl)
call TBGL_TestFunction
case %WM_TIMER
'---Dynamically call a function whose name is composed at run-time
'---In this case function name to be executed is inside TBGL_TestFunction string variable
call TBGL_TestFunction
case %WM_DESTROY
if TBGL_CanvasBound(hCtrl) then TBGL_ReleaseCanvas(hCtrl)
dialog Kill Timer cbhndl, %IDC_TIMER
end select
end function
'------------------------------------------------------------
' Callback function handling Close button
'------------------------------------------------------------
callback function CloseButton() as long
if CBMSG = %WM_COMMAND then
if cbctlmsg = %BN_CLICKED then DIALOG End cbhndl
end if
end function
'------------------------------------------------------------
' Callback function handling Canvas activation/deactivation
'------------------------------------------------------------
callback function CanvasButton() as long
if CBMSG = %WM_COMMAND then
if cbctlmsg = %BN_CLICKED then
select case cbctl
case %btnCanvasOn
TBGL_TestFunction = "Render_01"
CONTROL disable cbhndl, %btnCanvasOn
TBGL_BindCanvas(hCtrl)
CONTROL enable cbhndl, %btnCanvasOff, %btn_test02, %btn_test03
case %btnCanvasOff
CONTROL disable cbhndl, %btnCanvasOff
TBGL_ReleaseCanvas(hCtrl)
CONTROL disable cbhndl, %btn_test01, %btn_test02, %btn_test03
CONTROL enable cbhndl, %btnCanvasOn
end select
end if
end if
end function
'------------------------------------------------------------
' Callback function handling test type
'------------------------------------------------------------
callback function cbChangeTest() as long
if CBMSG = %WM_COMMAND then
if cbctlmsg = %BN_CLICKED then
select case cbctl
case %btn_test01
CONTROL disable cbhndl, %btn_test01
CONTROL enable cbhndl, %btn_test02, %btn_test03
TBGL_TestFunction = "Render_01"
TBGL_ReleaseCanvas(hCtrl)
TBGL_BindCanvas(hCtrl)
case %btn_test02
CONTROL disable cbhndl, %btn_test02
CONTROL enable cbhndl, %btn_test01, %btn_test03
TBGL_TestFunction = "Render_02"
TBGL_ReleaseCanvas(hCtrl)
TBGL_BindCanvas(hCtrl)
case %btn_test03
CONTROL disable cbhndl, %btn_test03
CONTROL enable cbhndl, %btn_test01, %btn_test02
TBGL_TestFunction = "Render_03"
TBGL_ReleaseCanvas(hCtrl)
TBGL_BindCanvas(hCtrl)
end select
end if
end if
end function
'------------------------------------------------------------
' TBGL render function 1
'------------------------------------------------------------
function Render_01() as long
static x, y, z as double
Static BoxColor as long
TBGL_UseLighting %TRUE
TBGL_UseLightSource %GL_LIGHT0, %TRUE
'TBGL_COLOR 255, 255, 255
if tbgl_GetwindowKeyState(hCtrl, %VK_R) then TBGL_COLOR 255,0,0
if tbgl_GetwindowKeyState(hCtrl, %VK_G) then TBGL_COLOR 0,255,0
if tbgl_GetwindowKeyState(hCtrl, %VK_B) then TBGL_COLOR 0,0,255
TBGL_ClearFrame
tbgl_Camera 0,0,5,0,0,0
tbgl_Rotate GetTickCount/100,1,1,1
tbgl_Box 1,1,1
tbgl_GetPixelInfo tbgl_MouseGetPosX, tbgl_MouseGetPosy, %TBGL_PINFO_XYZ, x, y, z
tbgl_Translate x,y,z
tbgl_Sphere 0.1
TBGL_DrawFrame
end function
'------------------------------------------------------------
' TBGL render function 2
'------------------------------------------------------------
function Render_02() as long
static i, j as long
TBGL_COLOR 255, 255, 255
TBGL_UseLighting %TRUE
TBGL_UseLightSource %GL_LIGHT0, %TRUE
' -- Erases previous frame
tbgl_ClearFrame
' -- Sets camera to look from 3,3,3 to 0,-1,0
tbgl_Camera 3, 3, 3, _
0, 0, 0
' -- All following geometry will be rotated around vector 0,1,0
' -- That is - Y axis
tbgl_Rotate gettickcount/100, 0, 1, 0
' -- Now we will try to render kind of spider
' -- It has ...
' .. One big head
tbgl_Color 255,196,0
tbgl_Sphere 0.25
' .. And eight legs
' .. We will draw them each 60°
for i = 0 to 359 step 45
tbgl_PushMatrix
tbgl_Rotate i, 0, 1, 0 ' 60, 120, 180, ...
' -- Legs will raise from bottom of head
tbgl_Translate 0, -0.25, 0
' -- With 3 part tentacle
tbgl_PushMatrix
for j = 1 to 3
tbgl_Color 255/j, 128/j, 0
' -- Some harmonic rotations will be provided by Sinus
tbgl_Rotate 70+sin(GetTickCount/1000+i+j)*20, 1, 0, 0
' -- Each tentacle part will be shorter and thinner than that before
tbgl_Cylinder ( 0.1/j, 0.1/(j+1), 1/j )
' -- When drawn, we need to move "cursor" at its end to bind new part
tbgl_Translate 0, 1/j, 0
next
tbgl_PopMatrix
tbgl_PopMatrix
next
' -- Finishes drawing
tbgl_DrawFrame
end function
'------------------------------------------------------------
' TBGL render function 3
'------------------------------------------------------------
function Render_03() as long
' Rotation Variable
static angle as single
' Timing Variables
static FrameRate as number
FrameRate = tbgl_GetFrameRate
tbgl_clearframe ' Clear Screen
tbgl_resetmatrix ' Reset the Current Matrix
tbgl_camera 0, 0, 1, 0, 0, 0 ' Default Camera Position
tbgl_translate 0, 0, -4 ' Move Pyramid to Centre of Screen
tbgl_rotate angle, 0.0, 1.0, 0.0 ' Rotation Setup
drawPyramid()
tbgl_drawframe ' Swap the Drawing Buffers
angle += 180.0/FrameRate
end function
'------------------------------------------------------------
' TBGL support to render function 3
'------------------------------------------------------------
sub drawPyramid()
tbgl_beginpoly %GL_TRIANGLE_FAN
tbgl_color 0, 128, 255 : tbgl_vertex 0.0, 1.0, 0.0
tbgl_color 255, 0, 0 : tbgl_vertex -1.0, -1.0, 1.0
tbgl_color 255, 255, 255 : tbgl_vertex 1.0, -1.0, 1.0
tbgl_color 0, 0, 255 : tbgl_vertex 1.0, -1.0, -1.0
tbgl_color 0, 255, 0 : tbgl_vertex -1.0, -1.0, -1.0
tbgl_color 255, 0, 0 : tbgl_vertex -1.0, -1.0, 1.0
tbgl_endpoly
end sub