Oxygen Basic
Programming => Example Code => Graphics => Topic started by: Frankolinox on April 18, 2013, 07:22:46 AM
-
from charles: Hi Frank, Got your rotating pyramid and also drag-and-drop so far. I'll get to the crate examples ASAP.
A combination of dragandDrop and Opengl Sceenes would offer great possibilities.
I must split this post, as the maximum length of character was filled up (20000).
a) I've done last week this experiment that's working here with "drag'n'drop" and openGL (viewport) window and you can start a new sdk window by button from viewport window. you can drag'n'drop folders to openGL window AND sdk window frame.
b) open second "openGL" window from first openGL window doesn't work yet. either the torus is gone or the whole grid scene. I haven't explored more about that time is missing here for that example.
example as attachement.
best regards, frank
X
-
post two:
the code example for this edit window is too long (character length is limited to 20.000 characters)..
'OPENGL /WINDOWS API Example
' Revised 9 July 2010
' Charles Pegge
' Frank Brübach, 17.April.2013
$ filename "t.exe"
'#file "t.exe"
'#include "../../inc/RTL32.inc"
'#include "../../inc/RTL64.inc"
#include "../../inc/minwin.inc"
'include "ViewPorts_2openGL.inc"
%Buttoni=1001
%Buttoni2=1002
s=error()
'
if s then
print s
end
end if
'--------------------------------------------
' $ filename "dragNdrop_Window1x.exe"
'#include "../../inc/RTL32.inc"
'#include "../../inc/RTL64.inc"
' #include "../../inc/MinWin.inc"
' #lookahead ' for procedures
' s=error()
'
' if s then
' print s
' end
' end if
'%WM_DROPFILES = &H0233???
'%WM_DROPFILES = &H233
% WM_DROPFILES = 0x0233
Dim myDroppedFiles(10) As String
Declare Function DragQueryFile Lib "shell32" Alias "DragQueryFileA" ( _
ByVal wHandle As sys, _
ByVal NumFiles As sys, _
ByVal NameBuffer As sys, _
ByVal BufferLen As Long) As sys
Declare Sub DragFinish Lib "shell32" Alias "DragFinish" (ByVal wHandle As Long)
DECLARE SUB DragAcceptFiles LIB "shell32.DLL" ALIAS "DragAcceptFiles" ( _
BYVAL hWnd AS SYS _ ' __in HWND hWnd
, BYVAL fAccept AS LONG _ ' __in BOOL fAccept
) ' void
'=========
'MAIN CODE
'=========
dim cmdline as asciiz ptr, inst as sys
&cmdline=GetCommandLine
inst=GetModuleHandle 0
'
'WINDOWS START
'=============
'
'WinMainer inst,0,cmdline,SW_NORMAL
'end
'--------------------------------------------------------------------
Function WinMainer(sys inst, prevInst, asciiz*cmdline, sys show) as sys
'====================================================================
WndClass wc
MSG wm
sys hwnd, wwd, wht, wtx, wty, tax
wc.style = CS_HREDRAW or CS_VREDRAW
wc.lpfnWndProc = @WndProx
wc.cbClsExtra =0
wc.cbWndExtra =0
wc.hInstance =inst
wc.hIcon=LoadIcon 0, IDI_APPLICATION
wc.hCursor=LoadCursor 0,IDC_ARROW
wc.hbrBackground = GetStockObject WHITE_BRUSH
wc.lpszMenuName =null
wc.lpszClassName = strptr "Demo"
RegisterClass (@wc)
Wwd = 420 : Wht = 300
Tax = GetSystemMetrics SM_CXSCREEN
Wtx = (Tax - Wwd) /2
Tax = GetSystemMetrics SM_CYSCREEN
Wty = (Tax - Wht) /2
hwnd = CreateWindowEx 0,wc.lpszClassName,"drag and Drop Test + sdk win api!",WS_OVERLAPPEDWINDOW,300+Wtx,Wty,Wwd,Wht,0,0,inst,0
ShowWindow hwnd,SW_SHOW
UpdateWindow hwnd
'---------------------------- this line is IMPORTANT ! ------
DragAcceptFiles(hwnd, TRUE)
'---------------------------- this line is IMPORTANT ! ------
'
sys bRet
'
do while bRet := GetMessage (@wm, 0, 0, 0)
if bRet = -1 then
'show an error message
else
TranslateMessage @wm
DispatchMessage @wm
end if
wend
End Function
Function Alternative_GetDropFiles(ByVal hDropParam As SYS) As String
Local sDropFiles As String, sFile As String, i As Long
for i = 1 To DragQueryFile(hDropParam, &HFFFFFFFF&, "", 0)-1
sFile = space(DragQueryFile(hDropParam, i, "", 0)+1)
'sFile = SPACE$(DragQueryFile(hDropParam, i, "", 0)+1)
'DragQueryFile(hDropParam, i, ByVal StrPtr(sFile), Len(sFile))
DragQueryFile(hDropParam, i, StrPtr(sFile), Len(sFile))
sFile = LEFT$(sFile, Len(sFile)-1)
' RIGHT(sFile,4) doesn't exists
If Ucase(LEFT$(sFile, 4)) = ".LNK" Then sFile = "" 'GetLinkInfo(sFile, 1)
sDropFiles = sDropFiles + sFile + "|"
next i
FUNCTION = RTrim(sDropFiles) ', "|")
End Function
dim as rect crect 'for WndProc and TimerProc
'--------------------------------------------------------------
function WndProx ( sys hWnd, wMsg, wParam, lparam ) as sys callback
'==============================================================
static as sys hdc
static as String txt
static as PaintStruct Paintst
dim myButton,hFont,inst as sys
'==========
select wMsg
'==========
'--------------
case WM_CREATE
'==============
mbox "here it comes second win api :)"
myButton = CreateWindowEx(0, _
"Button", _
"push me2!", _
%WS_CHILD OR %WS_VISIBLE OR _
%BS_PUSHBUTTON OR %BS_FLAT, _
22, 20, _
90, 44, _
hWnd, %Buttoni2, _
inst, 0)
SendMessage myButton, WM_SETFONT, hFont, TRUE '1
Case WM_DROPFILES
mbox "here I am after dropfiled"
'
'test one
'
pDrop = wparam 'CBWPARAM
sFiles = Alternative_GetDropFiles(pDrop)
' Free handle...
DragFinish(wparam)
'
'test two
'
If Alternative_GetDropFiles(wparam) Then "" 'myListDroppedFiles(1)
DragFinish (wparam)
mbox "test: here's to drag something"
'MessageBox hwnd, "Files dropped onto the dialog: " + $CRLF + $CRLF + sFiles, "frankos_dragDrop_test", %MB_ICONINFORMATION
'--------------
case WM_COMMAND
'==============
if wparam = %Buttoni2 then
print "test another button"
end if
'--------------
case WM_DESTROY
'===============
PostQuitMessage 0
DragAcceptFiles(hwnd, TRUE)
'------------
case WM_PAINT
'============
'TEXT
'http://msdn.microsoft.com/en-us/library/dd144821(v=VS.85).aspx
'DRAWING AND PAINTING
'http://msdn.microsoft.com/en-us/library/dd162760(v=VS.85).aspx
GetClientRect hWnd,&cRect
hDC=BeginPaint hWnd,&Paintst
'style
'0x20 DT_SINGLELINE
'0x04 DT_VCENTER
'0x01 DT_CENTER
'0x25
SetBkColor hdc,yellow
SetTextColor hdc,red
DrawText hDC,"Hello Drag'n'Drop Oxygen_World!",-1,&cRect,0x25
EndPaint hWnd,&Paintst
'--------------
case WM_KEYDOWN
'==============
'============
Select wParam
'============
Case 27 : SendMessage hwnd, WM_CLOSE, 0, 0 'ESCAPE
End Select
'--------
case else
'========
function=DefWindowProc hWnd,wMsg,wParam,lParam
end select
end function ' WndProc
'print "test ok"
'--------------------------------------------
/*
Window size wWidth wHeight
Active view:
0 = none
1 = upper left
2 = upper right
3 = lower left
4 = lower right
*/
'OPENGL HEADERS
'==============
#define WINGDIAPI
#define APIENTRY
#define const
typedef word wchar_t
typedef sys ptrdiff_t
'
includepath "..\..\inc\glo2\"
library "opengl32.dll"
include once "gl\gl.h"
'include once "gl\glext.h"
library "glu32.dll"
include once "gl\glu.h"
library ""
'
'
include once "gl\wgl.inc"
dim as sys a
dim gmf(256) AS GLYPHMETRICSFLOAT
dim as quad
'
'TIMING
'
grtic1,grtic2,freq
dim as double
'
'TIMING
'
fps,grlap
dim as sys
'
'STATE VARIABLES
'
refresh,bselect,kselect,keyd,cha,ReqShutDown,
bLeft,bMid,bRight,bWheel,
wWidth,wHeight,
'
'GL CONTEXT
'
hDC,hRC,
'
shadows,shadowable,
antialias, multisampling,
nPixelFormat,ReqNewMode,arbMultisampleFormat,
arbMultisampleSupported,
'
'TIMING
'
timerval, doredraw,
'
'POSITIONAL
'
xpos, ypos,
sposx,sposy,mposx,mposy,eposx,eposy,
'
'Rotation around each axis
'
rot_x, rot_y, rot_z,
active_view
'====================================================================
' DrawTorus() - Draw a solid torus (use a display list for the model)
'====================================================================
sub DrawTorus
finit
static as double
twopi = pi()*2,
torus_major = 1.5,
torus_minor = 0.5,
torus_major_res= 32,
torus_minor_res= 32
static as sys
torus_list, i,j,k
static as single
a, b, s, t, x, y, z, nx, ny, nz, gscale,tmc,tmd,tme
if not torus_list
'
'Record the Torus plot list
'--------------------------
'
torus_list = glGenLists 1
glNewList( torus_list, GL_COMPILE_AND_EXECUTE )
'
'Draw the torus
'
for i = 0 to TORUS_MINOR_RES-1
'
glBegin GL_QUAD_STRIP
'
for j = 0 to TORUS_MAJOR_RES
'
for k = 1 to 0 STEP -1
'
s = mod( i+k,TORUS_MINOR_RES + 0.5)
t = mod(j,TORUS_MAJOR_RES)
'
'CALCULATE POINT ON SURFACE
'--------------------------
'
tmd=s*twopi/TORUS_MINOR_RES
tme=t*twopi/TORUS_MAJOR_RES
tmc=TORUS_MAJOR+TORUS_MINOR * cos tmd
'
x = tmc * cos tme
y = TORUS_MINOR * sin tmd
z = tmc * sin tme
'
'CALCULATE SURFACE NORMAL
'------------------------
'
a=TORUS_MAJOR * cos tme
nx = x - a
ny = y
a=TORUS_MAJOR * sin tme
nz = z - a
'
'SCALING OF NORMALS
'
gscale = recip ( SQR( nx*nx + ny*ny + nz*nz ))
nx*=gscale
ny*=gscale
nz*=gscale
'
glNormal3f nx, ny, nz
glVertex3f x, y, z
'
next
'
next
'
glEnd()
'
next
'
glEndList()
'
else
'
'Playback displaylist
'
glCallList( torus_list )
end if
end sub
''================================================
'' DrawScene() - Draw the scene (a rotating torus)
''================================================
sub DrawScene
static as single,
model_diffuse(4) => (1.0, 0.8, 0.0, 1.0),
model_specular(4) => (0.0, 0.0, 1.0, 1.0),
model_shininess=0.1
glPushMatrix
'Rotate the object
glRotatef rot_x*0.5, 1.0, 0.0, 0.0
glRotatef rot_y*0.5, 0.0, 1.0, 0.0
glRotatef rot_z*0.5, 0.0, 0.0, 1.0
'Set model color (used for orthogonal views, lighting disabled)
'
glColor4fv model_diffuse
'Set model material (used for perspective view, lighting enabled)
'
glMaterialfv GL_FRONT, GL_DIFFUSE, model_diffuse
glMaterialfv GL_FRONT, GL_SPECULAR, model_specular
glMaterialf GL_FRONT, GL_SHININESS, model_shininess
'
DrawTorus
glPopMatrix
end sub
'============================================================
' DrawBorder() - Draw a 2D border (used for orthogonal views)
'============================================================
sub DrawBorder( byval gscale as single, st as sys )
dim as single x,y
glPushMatrix
'Setup modelview matrix (flat XY view)
'
glLoadIdentity
gluLookAt _
0.0, 0.0, 1.0,
0.0, 0.0, 0.0,
0.0, 1.0, 0.0
'We don't want to update the Z-buffer
'
glDepthMask GL_FALSE
'Set color
'---------
glDisable GL_LIGHTING
glColor3f 0.7, 0.7, 0.4
glBegin GL_LINES
dim h as sys
'h=gsteps*0.5
h=st*0.5
x = gscale * h
y = gscale * h
'Horizontal lines
'----------------
glVertex3f -x, -y, 0.0
glVertex3f x, -y, 0.0
glVertex3f -x, y, 0.0
glVertex3f x, y, 0.0
'Vertical lines
glVertex3f -x, -y, 0.0
glVertex3f -x, y, 0.0
glVertex3f x, -y, 0.0
glVertex3f x, y, 0.0
glEnd
'Enable Z-buffer writing again
'
glDepthMask GL_TRUE
glPopMatrix
end sub
'========================================================
' DrawGrid() - Draw a 2D grid (used for orthogonal views)
'========================================================
sub DrawGrid( BYVAL gscale AS SINGLE, BYVAL gsteps AS INTEGER )
dim as sys i
dim as single x,y
glPushMatrix
'Set background color
'
glClearColor 0.15, 0.15, 0.3, 0.0
glClear GL_COLOR_BUFFER_BIT
'Setup modelview matrix (flat XY view)
'
glLoadIdentity
gluLookAt _
0.0, 0.0, 1.0,
0.0, 0.0, 0.0,
0.0, 1.0, 0.0
'
'We don't want to update the Z-buffer
'
glDepthMask GL_FALSE
'
'Set grid color
glDisable GL_LIGHTING
glColor3f 0.0, 0.5, 0.5
glBegin GL_LINES
dim g,h as sys
g=gsteps
h=g*0.5
'' Horizontal lines
x = gscale * h
y = (-gscale) * h
'
for i = 0 to g
glVertex3f -x, y, 0.0
glVertex3f x, y, 0.0
y+=gscale
next
'' Vertical lines
x = -gscale * h
y = gscale * h
'
for i = 0 to g
glVertex3f x, -y, 0.0
glVertex3f x, y, 0.0
x+=gscale
next
glEnd
'Enable Z-buffer writing again
'
glDepthMask GL_TRUE
glPopMatrix
end sub
sys e
'part two as followed...
-
'second part, copy and paste to first part :-)
'===============
' DrawAllViews( )
'===============
sub DrawAllViews( )
sys bb
static as single,
light_position(4) => (0.0, 8.0, 8.0, 1.0),
light_diffuse (4) => (0.5, 0.5, 0.5, 1.0),
light_specular(4) => (0.5, 0.5, 0.5, 1.0),
light_ambient (4) => (0.5, 0.5, 0.5, 1.0)
static as double aspect
'
'Calculate aspect of window
'
if ( wheight > 0 )
aspect = wwidth / wheight
else
aspect = 1.0
end if
'
glClearColor 0.1, 0, 0.5, 0
glClear GL_COLOR_BUFFER_BIT OR GL_DEPTH_BUFFER_BIT
'
glEnable GL_SCISSOR_TEST
'
glEnable GL_DEPTH_TEST
glDepthFunc GL_LEQUAL
'======================
'** ORTHOGONAL VIEWS **
'======================
'For orthogonal views, use wireframe rendering
'---------------------------------------------
glPolygonMode GL_FRONT_AND_BACK, GL_LINE
'Enable line anti-aliasing
'
glEnable GL_LINE_SMOOTH
glEnable GL_BLEND
glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA
'Setup orthogonal projection matrix
glMatrixMode GL_PROJECTION
glLoadIdentity
dim as sys a
glOrtho -3*aspect, 3.0*aspect, -3.0, 3.0, 1.0, 50
dim w,h as sys
w=wwidth : h=wheight
sar w : sar h
glMatrixMode GL_MODELVIEW
glLoadIdentity
'Upper left view (TOP VIEW)
'--------------------------
'
glViewport 0,h,w,h
glScissor 0,h,w,h
DrawGrid 0.4,12
if active_view=1 then DrawBorder 0.45,12
glMatrixMode GL_MODELVIEW
glLoadIdentity
gluLookAt _
0.0, 10.0, 0.1, 'Eye-position (above)
0.0, 0.0, 0.0, 'View-point
0.0, 1.0, 0.0 'Up-vector
DrawScene
'Lower left view (FRONT VIEW)
'----------------------------
'
glViewport 0,0,w,h
glScissor 0,0,w,h
'glMatrixMode GL_MODELVIEW
'
DrawGrid 0.4, 12
if active_view=3 then DrawBorder 0.45,12
glLoadIdentity
'
gluLookAt _
0.0, 0.0, 10.0, 'Eye-position (in front of)
0.0, 0.0, 0.0, 'View-point
0.0, 1.0, 0.0 'Up-vector
'
DrawScene
'Lower right view (SIDE VIEW)
'----------------------------
'
glViewport w,0,w,h
glScissor w,0,w,h
DrawGrid 0.4, 12
if active_view=4 then DrawBorder 0.45,12
glMatrixMode GL_MODELVIEW
glLoadIdentity
gluLookAt _
10.0, 0.0, 0.0, 'Eye-position (to the right)
0.0, 0.0, 0.0, 'View-point
0.0, 1.0, 0.0 'Up-vector
DrawScene
'Disable line anti-aliasing
'
glDisable GL_LINE_SMOOTH
glDisable GL_BLEND
'======================
'** PERSPECTIVE VIEW **
'======================
'For perspective view, use solid rendering
'
glPolygonMode GL_FRONT_AND_BACK, GL_FILL
'Enable face culling (faster rendering)
'
glEnable GL_CULL_FACE
glCullFace GL_BACK
glFrontFace GL_CW
'Setup perspective projection matrix
'
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective 65.0, aspect, 1.0, 50.0
'Upper right view (PERSPECTIVE VIEW
'
glViewport w, h, w, h
glScissor w, h, w, h
glMatrixMode GL_MODELVIEW
glLoadIdentity
gluLookAt _
3.0, 1.5, 3.0, 'Eye-position
0.0, 0.0, 0.0, 'View-point
0.0, 1.0, 0.0 'Up-vector
'
'Configure and enable light source 1
'
glLightfv GL_LIGHT1, GL_POSITION, light_position
glLightfv GL_LIGHT1, GL_AMBIENT, light_ambient
glLightfv GL_LIGHT1, GL_DIFFUSE, light_diffuse
glLightfv GL_LIGHT1, GL_SPECULAR, light_specular
glEnable GL_LIGHT1
glEnable GL_LIGHTING
DrawScene
glDisable GL_LIGHTING
glDisable GL_CULL_FACE
glDisable GL_DEPTH_TEST
glDisable GL_SCISSOR_TEST
end sub
'dim keys(256) as sys
'dim mapref(16) as sys
'dim cameraProjectionMatrix(16) as single
dim as double,
modelview(16),
projection(16)
sub do_the_next_frame(byval hWnd as sys ) ' construct each frame
'
static as sys signal = 0
' timing
QueryPerformanceCounter &grtic2
grlap=(grtic2-grtic1)*1e6/freq
' fps=0.99*fps+10000/grlap ' moving average frames per sec
' screen refresh
' if bselect+kselect+refresh=0 then grtic1=grtic2: GOTO xdo_frame ' no need to update frame
refresh=0
'glClear(GL_COLOR_BUFFER_BIT OR GL_DEPTH_BUFFER_BIT)
'=============
DrawAllViews()
'=============
glFinish ' wait until all operations complete
SwapBuffers HDC
'IF firstframe=0 THEN SetWindowPos hWnd,HWND_TOP,100,100,500,500,0: firstframe=1
grtic1=grtic2
'
xdo_frame:
end sub '
'----------------------------------------------------------------
function WndProc (sys hWnd, wMsg, wParam, lparam) as sys callback
'================================================================
static cxClient as sys
static cyClient as sys
dim hdc as sys
'sys myButton,hWnd,hFont,inst
dim myButton,hFont,inst as sys
dim viewport(4) AS LONG
dim as sys a,b,c,i,j
dim as sys x,y,z
if wmsg=wm_paint then refresh=1
'==========
select wMsg
'==========
'
'---------------
case WM_ACTIVATE
'===============
if HIword(wParam) then exit function
'--------------
case WM_DESTROY
'==============
goto termination
'------------
case WM_TIMER
'============
if wParam=1
do_the_next_frame (hWnd)
if ReqShutDown then goto termination
end if
'---------------
case WM_KEYDOWN
'==============
wParam=wParam AND 255
'keys(wParam) = 1: keyd=wParam: kselect=wParam
if wParam=27 then ReqShutDown=1 : goto termination
'---------------
case WM_DESTROY
'===============
goto termination1
'----------------
case WM_MOUSEMOVE
'================
bselect=bselect OR 1
mPosX = LOword(lParam)
mPosY = HIword(lParam)
'
if bleft=1
'
x=mPosX : y=mPosY
'
'Depending on which view was selected, rotate around different axes
'
'=================
select active_view
'=================
'-----
case 1
'=====
'
rot_x = rot_x + y - ypos
rot_z = rot_z + x - xpos
'
'-----
case 3
'=====
rot_x = rot_x + y - ypos
rot_y = rot_y + x - xpos
'
'-----
case 4
'=====
'
rot_y = rot_y + x - xpos
rot_z = rot_z + y - ypos
'
'--------
case else
'========
'
'Do nothing for perspective view, or if no view is selected
'
'=========
end select
'=========
'
'Remember mouse position
'
xpos = x
ypos = y
'
end if
'----------------
case WM_LBUTTONUP
'================
bLeft = 0:ePosX=mPosX:ePosY=mPosy
'
'Deselect any previously selected view
'
active_view = 0
'----------------
case WM_MBUTTONUP
'================
bMid = 0:ePosX=mPosX:ePosY=mPosy
'----------------
case WM_RBUTTONUP
'================
bRight = 0:ePosX=mPosX:ePosY=mPosy
'------------------
case WM_LBUTTONDOWN
'==================
bLeft = 1:sPosX=mPosX:sPosY=mPosy
bSelect = bselect OR 2
xpos = LOword(lParam)
ypos = HIword(lParam)
'
' Detect which of the four views was clicked
'
active_view = 1
if ( xpos >= wwidth\2 )
active_view+=1
end if
if ( ypos >= wheight\2 )
active_view = active_view + 2
end if
doredraw = TRUE
'------------------
case WM_MBUTTONDOWN
'==================
bMid = 1 : sPosX=mPosX:sPosY=mPosy
bSelect = bselect OR 2
'------------------
case WM_RBUTTONDOWN
'==================
bRight = 1:sPosX=mPosX:sPosY=mPosY
bSelect = bselect OR 2
'-----------------
case WM_MOUSEWHEEL
'=================
bWheel = HIword(wParam)
bselect=1
case WM_CREATE
myButton = CreateWindowEx(0, _
"Button", _
"push me!", _
%WS_CHILD OR %WS_VISIBLE OR _
%BS_PUSHBUTTON OR %BS_FLAT, _
22, 20, _
80, 24, _
hWnd, %Buttoni, _
inst, 0)
SendMessage myButton, WM_SETFONT, hFont, TRUE '1
'------------
case %WM_SIZE
'============
wWidth = loword lParam
wHeight = hiword lParam
'
'Set the viewport to new dimensions
'
if wHeight > 0 and wWidth > 0
glViewport 0, 0, wWidth, wHeight
viewport(1)=>0,0,wWidth,wHeight
'
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective 45, wWidth/wHeight, 1.0, 100
glMatrixMode GL_MODELVIEW
glGetDoublev GL_MODELVIEW_MATRIX, modelview
glGetDoublev GL_PROJECTION_MATRIX, projection
end if
'---------------
case %WM_COMMAND
'===============
if wparam = %Buttoni then
WinMainer inst,0,cmdline,SW_NORMAL
'case %Buttoni
print "Hello openGL button"
end if
'------------------
case %WM_ERASEBKGND
'==================
function = 1
'--------
case else
'========
function=DefWindowProc hWnd,wMsg,wParam,lParam
'=========
end select
'=========
;
exit function
;
termination:
'
if ReqShutDown<0 THEN exit function ' dont terminate
'
termination1:
'
KillTimer hWnd,1
'CLOSE
glDeleteLists 1000, 255 ' font
wglMakeCurrent hDC, NULL
wglDeleteContext hRC
ReleaseDC hWnd,hDC
PostQuitMessage 0
end function ' WndProc
'--------------------------------------------
sub initialise_OpenGL ( sys hWnd, hDC, hRC )
'===========================================
'BuildFont
dim glFont as LOGFONT
dim glFontHandle as sys
'
glFont.lfHeight = 1 'Height Of Font
glFont.lfWeight = FW_BOLD 'Font Weight
glFont.lfCharSet = ANSI_CHARSET 'Character Set Identifier
glFont.lfOutPrecision = OUT_TT_PRECIS 'Output Precision
glFont.lfClipPrecision = CLIP_DEFAULT_PRECIS 'Clipping Precision
glFont.lfQuality = ANTIALIASED_QUALITY 'Output Quality
glFont.lfPitchAndFamily = FF_DONTCARE OR DEFAULT_PITCH 'Family And Pitch
copy0 &glFont.lfFaceName, `Arial` '`Comic Sans MS` 'Font Name
'
glFontHandle = CreateFontIndirect(&glFont)
glFontHandle = SelectObject(hDC, glFontHandle)
'
'wglUseFontOutlines hDC, 0, 255, 1000, 0.0, 0.2, WGL_FONT_POLYGONS, ?gmf)
'
DeleteObject(glFontHandle)
end sub
'------------------------- 1. WinMain sdk window frame --------------------- //
Function WinMain
(
byval inst as sys,
byval prevInst as sys,
byval cmdline as sys,
byval show as sys
)
as sys
'=========================
; window handle
dim a,b,c,npixelformat,hWnd as sys
dim wc as WNDCLASSEX
dim wm as MSG
with wc.
cbsize=sizeof WNDCLASSEX
style=CS_HREDRAW or CS_VREDRAW
lpfnWndProc=@WndProc
cbClsExtra=0
cbWndExtra=0
hInstance=inst
hIcon=LoadIcon 0, IDI_APPLICATION
hCursor=LoadCursor 0,IDC_ARROW
hbrBackground=GetStockObject WHITE_BRUSH
lpszMenuName=0
lpszClassName=@"Opengl"
end with
if not RegisterClassEx @wc
MessageBox 0,`Registration failed`,`Problem`,MB_ICONERROR
exit function
end if '
hWnd=CreateWindowEx 0,wc.lpszClassName,"4 Port Viewer Demo",
WS_OVERLAPPEDWINDOW,
CW_USEDEFAULT,CW_USEDEFAULT,480,480,
0,0,inst,0
'----------------------------- //
DragAcceptFiles(hwnd, TRUE)
'----------------------------- //
if not hWnd
MessageBox 0,`Unable to create window`,`problem`,MB_ICONERROR
exit function
end if
'setup pixel format
dim pfd AS PIXELFORMATDESCRIPTOR
'
pfd.nSize = SIZEOF PIXELFORMATDESCRIPTOR 'Size of UDT structure
pfd.nVersion = 1 'Version. Always set to 1.
pfd.dwFlags = PFD_DRAW_TO_WINDOW OR _ 'Support Window
PFD_SUPPORT_OPENGL OR _ 'Support OpenGL
PFD_DOUBLEBUFFER 'Support Double Buffering
pfd.iPixelType = PFD_TYPE_RGBA 'Red, Green, Blue, & Alpha Mode
pfd.cColorBits = 32 '32-Bit Color Mode
pfd.cRedBits = NULL 'Ignore Color and Shift Bits...
pfd.cRedShift = NULL '...
pfd.cGreenBits = NULL '...
pfd.cGreenShift = NULL '...
pfd.cBlueBits = NULL '...
pfd.cBlueShift = NULL '...
pfd.cAlphaBits = NULL 'No Alpha Buffer
pfd.cAlphaShift = NULL 'Ignore Shift Bit.
pfd.cAccumBits = NULL 'No Accumulation Buffer
pfd.cAccumRedBits = NULL 'Ignore Accumulation Bits...
pfd.cAccumGreenBits = NULL '...
pfd.cAccumBlueBits = NULL '...
pfd.cAccumAlphaBits = NULL '... Good Cereal! ;)
pfd.cDepthBits = 16 ' bits z-buffer depth 8 16 24
pfd.cStencilBits = 1 'Stencil Buffer
pfd.cAuxBuffers = NULL 'No Auxiliary Buffer
pfd.iLayerType = PFD_MAIN_PLANE 'Main Drawing Plane
pfd.bReserved = NULL 'Reserved
pfd.dwLayerMask = NULL 'Ignore Layer Masks...
pfd.dwVisibleMask = NULL '...
pfd.dwDamageMask = NULL '...
'sleep 10
hDC = GetDC(hWnd)
nPixelFormat = ChoosePixelFormat(hDC, @pfd) ' First without multisampling
SetPixelFormat(hDC, nPixelFormat, @pfd)
finit
hRC = wglCreateContext (hDC)
wglMakeCurrent hDC, hRC
ReqNewMode=0 ' done
'initialise_OpenGL(hWnd,hDC,hRC)
ShowWindow hWnd,show
UpdateWindow hWnd
'
glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
glClearColor 0.5, 0, 0, 0
SwapBuffers hDC
'
timerval=16 ' a bit less than 1/60 sec
SetTimer hWnd,1,timerval,NULL
'
'MESSAGE LOOP
'
while GetMessage @wm,0,0,0
TranslateMessage @wm
DispatchMessage @wm
wend
'
function=wm.wparam
end function ; end of WinMain
a=true
dim cmdline,inst as sys
cmdline=GetCommandLine
inst=GetModuleHandle 0
'
WinMain (inst,0,cmdline,SW_NORMAL)
perhaps the code example length could be to a larger limit (50.000 characters) ?
-
Hi Frank, I would post long scripts as an attachment. It's a lot safer.