drag'ndrop + viewport + sdk window

[Frankolinox]

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

[Frankolinox]

post two:

the code example for this edit window is too long (character length is limited to 20.000 characters)..

Code: [Select]

 '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...


[Frankolinox]

'second part, copy and paste to first part :-)

Code: [Select]

'===============
' 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) ?

[Charles Pegge]

Hi Frank, I would post long scripts as an attachment. It's a lot safer.