OpenGL + button

Started by Frank Brübach, November 05, 2023, 09:39:41 AM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Print
Go Down Pages1
User actions

Frank Brübach

November 05, 2023, 09:39:41 AM Last Edit: November 05, 2023, 01:31:57 PM by Frank Brübach
Good morning... Here is another little question how to Install Buttons with callback Action to an OpenGL window frame?
I have desactivate enumchild for seeing the Buttons.. but how I can scale this both for OpenGL window and Buttons actions?

Perhaps there ist a simple Setup for this Problem thx Frank

PS the grafide.o2bas / OpenGL / grafide folder  example I Like more... Because of both Dimensions and Binding two gui's :)  but its too silly to delete all Features of Peroxide ;)

Code Select


  '=============================
  'Multiple Opengl child Windows
  '=============================

  'MS Child Windows
  'http://msdn.microsoft.com/en-us/library/ms632598(VS.85).aspx
 
  '13:01 10/12/2010
  '13:30 03/10/2013
  '03:29 16/05/2018
  'Charles Pegge
  '
  #case capital
  '
  $ filename "t.exe"
  'uses RTL64
  uses MinWin

  #define WINGDIAPI
  #define APIENTRY
  #define const
  typedef word wchar_t
  typedef sys ptrdiff_t
  includepath "$/inc/glo2/"
  library "opengl32.dll"
  uses gl/gl.h
  'uses gl/glext.h
  library "glu32.dll"
  uses gl/glu.h
  uses gl/wgl.inc
  library ""
  includepath ""


  % ID_FIRSTCHILD  100
  'other children ..115
  % IDM_APP_EXIT 101
  % IDB_BUTTON  102
  sys hWndStdButton
  %IDB_BUTTON2 200
  sys hWndStdButton2
  % IDC_OWNERDRAWN  1000
  sys hWndClrButton
 

  'GLOBAL VARIABLES
  '----------------

  sys hinstance
  sys hWndMain
  sys hDC,hRC,hw[16],hd[16]

  RECT        cRect
  PAINTSTRUCT Paintst


  ;=====================================
 
  sys inst=GetModuleHandle 0
  asciiz * cmdline
  &cmdline=GetCommandLine
  string szAppName="OpenGL Child Windows"
  string szconfirm="Confirm Quit"

  ;=====================================
 

  '-------------------------------------------
  function PixelFormat(sys hdc, choice) as sys
  '===========================================

  'setup pixel format

  dim nPixelFormat as sys
  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        = 0                            'Ignore Color and Shift Bits...
  pfd.cRedShift      = 0                            '...
  pfd.cGreenBits      = 0                            '...
  pfd.cGreenShift    = 0                            '...
  pfd.cBlueBits      = 0                            '...
  pfd.cBlueShift      = 0                            '...
  pfd.cAlphaBits      = 0                            'No Alpha Buffer
  pfd.cAlphaShift    = 0                            'Ignore Shift Bit.
  pfd.cAccumBits      = 0                            'No Accumulation Buffer
  pfd.cAccumRedBits  = 0                            'Ignore Accumulation Bits...
  pfd.cAccumGreenBits = 0                            '...
  pfd.cAccumBlueBits  = 0                            '...
  pfd.cAccumAlphaBits = 0                            '... Good Cereal! ;)
  pfd.cDepthBits      = 16                          ' bits z-buffer depth 8 16 24
  pfd.cStencilBits    = 1                            'Stencil Buffer
  pfd.cAuxBuffers    = 0                            'No Auxiliary Buffer
  pfd.iLayerType      = PFD_MAIN_PLANE              'Main Drawing Plane
  pfd.bReserved      = 0                            'Reserved
  pfd.dwLayerMask    = 0                            'Ignore Layer Masks...
  pfd.dwVisibleMask  = 0                            '...
  pfd.dwDamageMask    = 0                            '...
  '
  nPixelFormat = ChoosePixelFormat(hDC, &pfd) 'First without multisampling
  '
  SetPixelFormat(hDC, nPixelFormat, &pfd)
  return nPixelFormat
  '
  end function


  '---------------------------
  sub PrepareRenderFor(sys n)
  '===========================
  {
    'GET CHILD HANDLE AND DEVICE CONTEXT FOR RENDERING
    '
    sys chw
    chw=hw[n] : hdc=hd[n]
    '
    wglMakeCurrent hDC, hRC
    '
    'SET THE VIEWPORT AND PERSPECTIVE
    '
    RECT crect
    GetClientRect  chw,@cRect
    glViewport 0, 0, crect.right, crect.bottom
    double aspect=crect.right/crect.bottom
    '
    glMatrixMode  GL_PROJECTION
    glLoadIdentity
    gluPerspective 45, aspect, 1.0, 100
    glMatrixMode  GL_MODELVIEW
    glLoadIdentity
    '
    glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
  }


  '------------------------------------------------------------
  function EnumChildProc(sys hwndChild, lParam) as sys callback
  '============================================================
  {
    RECT * rcParent;
    sys i, idChild;
    sys v,w,h,info
 
    // Retrieve the child-window identifier. Use it to set the
    // position of the child window.
    info=GWL_ID
    idChild = GetWindowLong(hwndChild, info)
    i=idChild-ID_FIRSTCHILD
 

    // Set Size and position the child window. 
 
    & rcParent = lParam;
    v=rcParent.right/4 'right/4
    w=v*i
    h=rCParent.bottom
    if i=2 then v-=50 : h-=50 'size test
    if i=3 then v-=10 : 'shape text
    MoveWindow(hwndChild, w, 0, v, h, true);
 
 
    // Make sure the child window is visible.
 
    ShowWindow(hwndChild, SW_SHOW);
 
    return true;
  }

  'STANDARD CHILD WINDOWS STYLES
  '=============================
  '
  'Button    The class for a button.
  'ComboBox    The class for a combo box.
  'Edit            The class for an edit control.
  'ListBox    The class for a list box.
  'MDIClient    The class for an MDI client window.
  'ScrollBar    The class for a scroll bar.
  'Static    The class for a static control.

  '---------------------------------------------------------------
  function WndProc(sys hwnd, uMsg, wParam, lParam) as sys callback
  '===============================================================
  {
    static single s1,s2,s3,s4,ang1,ang2,angi1=-2,angi2=1
    static zstring zs[4096]
    '
    RECT rcClient
    static sys i,j,px,py,lx,ly,id,style,chw,act,idmenu

    string sty
 
    select umsg
 
        case WM_CREATE: // creating main window 
            '
            'CREATE CHILD WINDOWS
            '
            style=WS_CHILD | WS_BORDER | WS_VISIBLE
            idmenu=0
            py=10
            '
            for i = 1 to 4
              j=i-1
              id=ID_FIRSTCHILD+j
              px=10+j*100 : lx=100 : ly=100
              '
              if i<=2 then
                sty="edit"
              elseif i=3 then
                sty="static"
              end if
              '
              hw[i]=CreateWindowEx(0,*sty, null, style, px,py,lx,ly, hwnd, id, inst, null)
              '
            next
            '
            'SETUP DEVICE CONTEXTS FOR EACH OPENGL CHILD WINDOW
            '
            for i=3 to 4
              '
              chw=hw[i]
              hDC=GetDC chw
              hd[i]=hDC
              '
              PixelFormat(hDC,0)
              finit 'reinitialise fpu after npixelformat
              '

'---------------------------------- button test callback ------------------- //
 hWndStdButton = CreateWindowEx(
            0,
            "BUTTON",
            "Standard Button",
            WS_VISIBLE or WS_CHILD,
            620,  40,
            120, 44, ''120, 24,
            hWnd,
            IDB_BUTTON,
            inst,
            null)
            ShowWindow(hWndStdButton, SW_SHOW)
hWndStdButton = CreateWindowEx(
            0,
            "BUTTON",
            "Second Button",
            WS_VISIBLE or WS_CHILD,
            620,  90,
            120, 44, ''120, 24,
            hWnd,
            IDB_BUTTON2,
            inst,
            null)

'---------------------------------- button test callback ------------------- //

            next
            '
            'create only one render context for several device contexts
            hRC = wglCreateContext(hD[3])
            '
            'SETUP INITIAL VALUES FOR ROTATION SPEED IN THE EDIT BOXES
            '

            chw=hw[1] : zs="-2 Rotation Speed"
            'a=1
            's=""
            'print zs
            SendMessage chw, WM_SETTEXT,32 , @zs
            chw=hw[2] : zs="1 Rotation Speed"
            SendMessage chw, WM_SETTEXT,32 , @zs
            return 0
            '
'------------------------------- button try ------------------- //

case WM_COMMAND
  'case WM_COMMAND

  'hMenu = GetMenu(hwnd)
  if wparam = IDM_APP_EXIT then       
    SendMessage hwnd, WM_CLOSE, 0, 0
    return 1 'indicate this message has been intercepted / no further action
  end if

            select case loword(wParam)

                  case IDB_BUTTON
                    select case hiword(wParam)
                        case BN_CLICKED
                            MessageBox(0, "Selected Standard Button", "Standard Button", MB_OK or MB_ICONINFORMATION)
                    end select
                        case IDB_BUTTON2
                    select case hiword(wParam)
                        case BN_CLICKED
                            MessageBox(0, "Selected 2.Standard Button", "Second Button", MB_OK or MB_ICONINFORMATION)
                    end select
  end select
'------------------------------- button try end --------------- //
        case WM_TIMER
          '
          act=1
          '
        case WM_MOUSEMOVE
          '
        case WM_KEYDOWN
          '
          if wparam=27 then SendMessage hwnd, WM_DESTROY, 0, 0
          return 0
          '
        case WM_SIZE:  // main window changed size
 
            // Get the dimensions of the main window's client
            // area, and enumerate the child windows. Pass the
            // dimensions to the child windows during enumeration.
            sys i,u,v
            ''u=rcClient.right/5 ''right/4
            ''v=rcClient.bottom-40 '/1.25
            ''for i=1 to 4

            GetClientRect(hwnd, &rcClient);
            '--------------------- how to scale opengl window ? --------------------- //
            '--------------------- for button actions? ------------------------------ //
            'EnumChildWindows(hwnd, & EnumChildProc, &rcClient);
            '--- buttons
            MoveWindow (hWndStdButton,hwnd,160,160,60,80,true) 'u+60
            MoveWindow (hWndStdButton2,hwnd,160,210,60,80,true)
           
            ''next
            act=2

        case WM_CLOSE:
          // Create the message box. If the user clicks
      // the Yes button, destroy the main window.
 
        'if (MessageBox(hwnd, *szConfirm, *szAppName, MB_YESNOCANCEL) == IDYES)
            DestroyWindow(hwndMain)
        'end if
        return 0

        'case WM_ERASEBKGND
        '
        'return 0

        case WM_DESTROY:
 
        // Post the WM_QUIT message to
        // quit the application terminate.
 
        wglDeleteContext hRC
        hdc=hd[3] : wglMakeCurrent hDC, null : ReleaseDC hWnd,hDC
        hdc=hd[4] : wglMakeCurrent hDC, null : ReleaseDC hWnd,hDC
        PostQuitMessage(0);
        return 0;

        case else
        return DefWindowProc(hwnd, uMsg, wParam, lParam);
    end select
    '

    '-----------------------------------
    'CREATE SCENE FRAME AND SWAP BUFFERS
    '===================================
    '
    if act then

      'PROCESS EACH OPENGL CHILD WINDOW
      '--------------------------------
      '
      'READ ROTATION SPEED FROM EDIT BOX
      '
      chw=hw[1]
      SendMessage chw, WM_GETTEXT,32 , & zs
      '
      angi1=val zs
      '
      PrepareRenderFor 3
      '
      'INIT BUFFERS
      '
      glClearColor 0.5, 0, 0, 0
      '
      'SHAPE
      '
      s1=.2
      s2=-1
      s3=0.5
      s4=s3*.2
      glLoadIdentity
      glrotatef ang1, 0,0,1
      glbegin GL_TRIANGLES
      glcolor4f  00,  s3,  s3, 1
      glvertex3f -s1, -s1,  s2
      '
      glcolor4f  s3,  s3,  00, 1
      glvertex3f  s1, -s1,  s2
      glcolor4f  s4,  0,  s3, 1
      glvertex3f  00,  s1,  s2
      glend
      'glfinish
      swapBuffers hdc
      '
      '
      'NEXT OPENGL CHILD WINDOW
      '========================
      '
      'READ ROTATION SPEED FROM EDIT BOX
      '
      chw=hw[2]
      SendMessage chw, WM_GETTEXT,32 , & zs
      angi2=val zs
      '
      'SET DEVICE CONTEXT FOR RENDERING
      '
      PrepareRenderFor 4
      '
      'INIT BUFFERS
      '
      glClearColor 0.2, 0.0, 0.0, 0
      '
      'SHAPE
      '
      s1=.2
      s2=-1
      s3=0.5
      s4=s3*.2
      glLoadIdentity
      glrotatef ang2, 0,0,1
      glbegin GL_QUADS
      glcolor4f  s3,  00,  s4, 1
      glvertex3f -s1, -s1,  s2
      glcolor4f    0,  s3,  s4, 1
      glvertex3f -s1,  s1,  s2
      glcolor4f  s4,  0,  s3, 1
      glvertex3f  s1,  s1,  s2
      glcolor4f  s3,  0,  s4, 1
      glvertex3f  s1, -s1,  s2
      glend
      'glfinish
      swapBuffers hdc
      sleep 15
      '
      'UPDATE ROTATION ANGLES
      '----------------------
      '
      ang1+=angi1
      ang2+=angi2
      act=0
      return 0
      '
    end if 'act
    '
    '
  }



  '--------------------------------------------------------------------
  Function WinMain(sys inst, prevInst, asciiz*cmdline, sys show) as sys
  '====================================================================
                    '
  dim a,b,c,style,hWnd as sys
  dim wc as WNDCLASS
  dim wm as MSG

  with wc                '
    .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=strptr "openglch"
  end with

  hinstance=inst

  if not RegisterClass @wc
    MessageBox 0,`Registration failed`,`Problem`,MB_ICONERROR
    exit function
  end if


  style=WS_OVERLAPPEDWINDOW
  style=WS_OVERLAPPEDWINDOW | // overlapped window
        WS_HSCROLL |          // horizontal scroll bar
        WS_VSCROLL            // vertical scroll bar


  // Create the main window.

  hwndMain = CreateWindowEx(
    0,                      // no extended styles         
    strptr "openglch",      // class name                 
    strptr szAppName,      // window title
    style,                  //               
    CW_USEDEFAULT,          // default horizontal position 
    CW_USEDEFAULT,          // default vertical position   
    800,                    // default width               
    240,                    // default height             
    null,                  // no parent or owner window   
    null,                  // class menu used             
    hinstance,              // instance handle             
    null);                  // no window creation data     


  // Show the window using the flag specified by the program
  // that started the application, and send the application
  // a WM_PAINT message.

  hwnd=hwndMain
     
  if not hWnd then
    MessageBox 0,`Unable to create window`,`problem`,MB_ICONERROR
    exit function
  end if
                        '
  ShowWindow hWnd,show
  UpdateWindow hWnd
 '
  SetTimer hWnd,1,10,null
  '
  '
  'MESSAGE LOOP
  '
  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
  '
  killTimer hwnd, 1
  '
  function=wm.wparam

  end function ; end of WinMain



  WinMain inst,0,cmdline,SW_NORMAL

Frank Brübach

#1
November 05, 2023, 05:15:15 PM Last Edit: November 05, 2023, 05:19:27 PM by Frank Brübach
One solution I have found already but No Access of the Buttons to the OpenGL window frame
I changed the Set Size and Position of the child window


Code Select


  '=============================
  'Multiple Opengl child Windows
  '=============================

  'MS Child Windows
  'http://msdn.microsoft.com/en-us/library/ms632598(VS.85).aspx
 
  '13:01 10/12/2010
  '13:30 03/10/2013
  '03:29 16/05/2018
  'Charles Pegge
  '
  #case capital
  '
  $ filename "t.exe"
  'uses RTL64
  uses MinWin

  #define WINGDIAPI
  #define APIENTRY
  #define const
  typedef word wchar_t
  typedef sys ptrdiff_t
  includepath "$/inc/glo2/"
  library "opengl32.dll"
  uses gl/gl.h
  'uses gl/glext.h
  library "glu32.dll"
  uses gl/glu.h
  uses gl/wgl.inc
  library ""
  includepath ""


  % ID_FIRSTCHILD  100
  'other children ..115
 
  % IDB_BUTTON  100
  sys hWndStdButton
  %IDB_BUTTON2 200
  sys hWndStdButton2
  % IDC_OWNERDRAWN  1000
  sys hWndClrButton
  sys cube

  'GLOBAL VARIABLES
  '----------------

  sys hinstance
  sys hWndMain
  sys hDC,hRC,hw[16],hd[16]

  RECT        cRect
  PAINTSTRUCT Paintst


  ;=====================================
 
  sys inst=GetModuleHandle 0
  asciiz * cmdline
  &cmdline=GetCommandLine
  string szAppName="OpenGL Child Windows"
  string szconfirm="Confirm Quit"

  ;=====================================
 
  sub shape1
  '===========
  float s1,s2,s3,s4
  s1=.2
  s2=0
  s3=0.5
  s4=s3*.2
  glbegin GL_TRIANGLES
  glcolor4f  00,  s3,  s3, 1
  glvertex3f -s1, -s1,  s2
  '
  glcolor4f  s3,  s3,  00, 1
  glvertex3f  s1, -s1,  s2
  glcolor4f  s4,  0,  s3, 1
  glvertex3f  00,  s1,  s2
  glend
  end sub

  sub shape2 '3
  '===========
  float s1,s2,s3,s4
  float ang1,ang
  'SHAPE
    '
    s1=.6 '2    'x y
    s2=-1    'z
    s3=0.5  'color
    s4=s3*.2 'color
    '
    glrotatef ang1, 0,0,1
    'glrotatef ang1, 0,1,0
    '
    glbegin GL_QUADS
    glcolor4f  00,  s3,  s3, 1 : glvertex3f -s1, -s1,  s2
    glcolor4f  s3,  s3,  00, 1 : glvertex3f  s1, -s1,  s2
    glcolor4f  s4,  0,  s3, 1 : glvertex3f  s1,  s1,  s2
    glcolor4f  s4,  0,  s3, 1 : glvertex3f -s1,  s1,  s2
    glend
    '
    glfinish
end sub


  '-------------------------------------------
  function PixelFormat(sys hdc, choice) as sys
  '===========================================

  'setup pixel format

  dim nPixelFormat as sys
  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        = 0                            'Ignore Color and Shift Bits...
  pfd.cRedShift      = 0                            '...
  pfd.cGreenBits      = 0                            '...
  pfd.cGreenShift    = 0                            '...
  pfd.cBlueBits      = 0                            '...
  pfd.cBlueShift      = 0                            '...
  pfd.cAlphaBits      = 0                            'No Alpha Buffer
  pfd.cAlphaShift    = 0                            'Ignore Shift Bit.
  pfd.cAccumBits      = 0                            'No Accumulation Buffer
  pfd.cAccumRedBits  = 0                            'Ignore Accumulation Bits...
  pfd.cAccumGreenBits = 0                            '...
  pfd.cAccumBlueBits  = 0                            '...
  pfd.cAccumAlphaBits = 0                            '... Good Cereal! ;)
  pfd.cDepthBits      = 16                          ' bits z-buffer depth 8 16 24
  pfd.cStencilBits    = 1                            'Stencil Buffer
  pfd.cAuxBuffers    = 0                            'No Auxiliary Buffer
  pfd.iLayerType      = PFD_MAIN_PLANE              'Main Drawing Plane
  pfd.bReserved      = 0                            'Reserved
  pfd.dwLayerMask    = 0                            'Ignore Layer Masks...
  pfd.dwVisibleMask  = 0                            '...
  pfd.dwDamageMask    = 0                            '...
  '
  nPixelFormat = ChoosePixelFormat(hDC, &pfd) 'First without multisampling
  '
  SetPixelFormat(hDC, nPixelFormat, &pfd)
  return nPixelFormat
  '
  end function


  '---------------------------
  sub PrepareRenderFor(sys n)
  '===========================
  {
    'GET CHILD HANDLE AND DEVICE CONTEXT FOR RENDERING
    '
    sys chw
    chw=hw[n] : hdc=hd[n]
    '
    wglMakeCurrent hDC, hRC
    '
    'SET THE VIEWPORT AND PERSPECTIVE
    '
    RECT crect
    GetClientRect  chw,@cRect
    glViewport 0, 0, crect.right, crect.bottom
    double aspect=crect.right/crect.bottom
    '
    glMatrixMode  GL_PROJECTION
    glLoadIdentity
    gluPerspective 45, aspect, 1.0, 100
    glMatrixMode  GL_MODELVIEW
    glLoadIdentity
    '
    glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
  }


  '------------------------------------------------------------
  function EnumChildProc(sys hwndChild, lParam) as sys callback
  '============================================================
  {
    RECT * rcParent;
    sys i, idChild;
    sys v,w,h,info
 
    // Retrieve the child-window identifier. Use it to set the
    // position of the child window.
    info=GWL_ID
    idChild = GetWindowLong(hwndChild, info)
    i=idChild-ID_FIRSTCHILD
 

    // Set Size and position the child window. 
 
    & rcParent = lParam;
    v=rcParent.right/5 '4
    w=v*i
    h=rCParent.bottom
    if i=2 then v-=70 : h-=70 'size test 50
    if i=3 then v-=10 : 'shape text
    MoveWindow(hwndChild, w, 0, v, h, true);
 
 
    // Make sure the child window is visible.
 
    ShowWindow(hwndChild, SW_SHOW);
 
    return true;
  }

  'STANDARD CHILD WINDOWS STYLES
  '=============================
  '
  'Button    The class for a button.
  'ComboBox    The class for a combo box.
  'Edit            The class for an edit control.
  'ListBox    The class for a list box.
  'MDIClient    The class for an MDI client window.
  'ScrollBar    The class for a scroll bar.
  'Static    The class for a static control.



  '---------------------------------------------------------------
  function WndProc(sys hwnd, uMsg, wParam, lParam) as sys callback
  '===============================================================
    type wnd
      sys hWnd,hDC
    end type
    '
    static wnd h[4]
    static single ang1,ang2,angi1=-2,angi2=1
    static zstring zs[4096]
    '
    RECT rcClient
    static sys i,j,px,py,lx,ly,id,style,act,idmenu
    string sty
    'RECT crect
    'select umsg
 
        'case WM_CREATE: // creating main window 
            '

  %IDM_FILE_NEW    40001
  %IDM_FILE_OPEN    40002
  %IDM_FILE_SAVE    40003
  %IDM_FILE_SAVE_AS 40004
  %IDM_APP_EXIT    40005
  %IDM_EDIT_UNDO    40006
  %IDM_EDIT_CUT    40007
  %IDM_EDIT_COPY    40008
  %IDM_EDIT_PASTE  40009
  %IDM_EDIT_CLEAR  40010
  %IDM_APP_HELP    40011
  %IDM_APP_ABOUT    40012
  '
  static sys hdc,hMenu,hMenuPopup
  static String txt
  'static rect crect
  'static PaintStruct Paintst
  sys id
  '
  select case uMsg
  '
  case WM_CREATE
  '
  hMenu = CreateMenu
  hMenuPopup = CreateMenu
  AppendMenu hMenuPopup, MF_STRING,    IDM_FILE_NEW,    "&New"
  AppendMenu hMenuPopup, MF_STRING,    IDM_FILE_OPEN,    "&Open..."
  AppendMenu hMenuPopup, MF_STRING,    IDM_FILE_SAVE,    "&Save"
  AppendMenu hMenuPopup, MF_STRING,    IDM_FILE_SAVE_AS, "Save &As..."
  AppendMenu hMenuPopup, MF_SEPARATOR, 0,                null
  AppendMenu hMenuPopup, MF_STRING,    IDM_APP_EXIT,    "E&xit"
  AppendMenu hMenu,      MF_POPUP,    hMenuPopup,      "&File"

  hMenuPopup = CreateMenu
  AppendMenu hMenuPopup, MF_STRING,    IDM_EDIT_UNDO,    "&Undo"
  AppendMenu hMenuPopup, MF_SEPARATOR, 0,                null
  AppendMenu hMenuPopup, MF_STRING,    IDM_EDIT_CUT,    "Cu&t"
  AppendMenu hMenuPopup, MF_STRING,    IDM_EDIT_COPY,    "&Copy"
  AppendMenu hMenuPopup, MF_STRING,    IDM_EDIT_PASTE,  "&Paste"
  AppendMenu hMenuPopup, MF_STRING,    IDM_EDIT_CLEAR,  "De&lete"
  AppendMenu hMenu,      MF_POPUP,    hMenuPopup,      "&Edit"

  hMenuPopup = CreateMenu
  AppendMenu hMenuPopup, MF_STRING,    IDM_APP_HELP,    "&Help"
  AppendMenu hMenuPopup, MF_STRING,    IDM_APP_ABOUT,    "&About MenuDemo..."
  AppendMenu hMenu,      MF_POPUP,    hMenuPopup,      "&Help"
  '
  SetMenu      hwnd, hMenu
  SetWindowText hwnd,"Menu Demo, Buttons + OpenGL ChildWindows"
  '
  sys dis=MF_DISABLED or MF_GRAYED
  CheckMenuItem hMenu,IDM_FILE_NEW, MF_CHECKED
  EnableMenuItem hMenu,IDM_FILE_OPEN,dis

            '
            style=WS_CHILD | WS_BORDER | WS_VISIBLE
            idmenu=0
            py=10
            '
            for i = 1 to 4
              j=i-1
              id=ID_FIRSTCHILD+j
              px=10+j*100 : lx=100 : ly=100
              '
              if i<=2 then
                sty="button" '' "edit"
              elseif i=3 then
                sty="static"
              end if
              '
              h[i].hWnd=CreateWindowEx(0,*sty, null, style, px,py,lx,ly, hwnd, id, inst, null)
              h[i].hDC=GetDC h[i].hwnd
'CREATE CHILD WINDOWS

            hWndStdButton = CreateWindowEx(
            0,
            "BUTTON",
            "Standard Button",
            WS_VISIBLE or WS_CHILD,
            620,  40,
            120, 44, ''120, 24,
            hWnd,
            IDB_BUTTON,
            inst,
            null)
            ShowWindow(hWndStdButton, SW_SHOW)
hWndStdButton = CreateWindowEx(
            0,
            "BUTTON",
            "Second Button",
            WS_VISIBLE or WS_CHILD,
            620,  90,
            120, 44, ''120, 24,
            hWnd,
            IDB_BUTTON2,
            inst,
            null)
            'hWndStdButton2
ShowWindow(hWndStdButton2, SW_SHOW)
              '
            next
            '
            'SETUP DEVICE CONTEXTS FOR EACH OPENGL CHILD WINDOW
            '
            PixelFormat(h[3].hDC,1)
            PixelFormat(h[4].hDC,0)
            '
            'reinitialise fpu after npixelformat
            '
            finit
            '
            'create one render context for several device contexts
            '
            hRC = wglCreateContext(h[3].hdc)
            '
            'SETUP INITIAL VALUES FOR ROTATION SPEED IN THE EDIT BOXES
            '
            zs="-2 Rotation Speed"
            SendMessage h[1].hwnd, WM_SETTEXT,32 , @zs
            zs="5 Rotation Speed"
            SendMessage h[2].hwnd, WM_SETTEXT,32 , @zs
            return 0
            '
case WM_COMMAND
  'case WM_COMMAND

  hMenu = GetMenu(hwnd)
  if wparam = IDM_APP_EXIT then       
    SendMessage hwnd, WM_CLOSE, 0, 0
    return 1 'indicate this message has been intercepted / no further action
  end if

            select case loword(wParam)

                  case IDB_BUTTON
                    select case hiword(wParam)
                        case BN_CLICKED
                            MessageBox(0, "Selected Standard Button", "Standard Button", MB_OK or MB_ICONINFORMATION)
                    end select
                        case IDB_BUTTON2
                    select case hiword(wParam)
                        case BN_CLICKED
                            MessageBox(0, "Selected 2.Standard Button", "Second Button", MB_OK or MB_ICONINFORMATION)
                    end select

end select
        case WM_TIMER
          '
          act=1
          '
        case WM_MOUSEMOVE
          '
        case WM_KEYDOWN
          '
          if wparam=27 then SendMessage hwnd, WM_DESTROY, 0, 0
          return 0
          '
        case WM_SIZE:  // main window changed size
 
            GetClientRect(hwnd, @rcClient);
            sys i,u,v
            u=rcClient.right/5 ''right/4
            v=rcClient.bottom-40 '/1.25
            for i=1 to 4
              'MoveWindow(h[i].hWnd, i*u-u, 0, u, v, true);
              MoveWindow(h[i].hWnd, i*u-u, 20, u, v, true);
              MoveWindow (hWndStdButton,hwnd,160,60,u+60,80,true)
              MoveWindow (hWndStdButton2,hwnd,160,110,60,80,true)
            next
 
            act=1

        case WM_CLOSE:

        DestroyWindow(hwndMain)
        return 0

        'case WM_ERASEBKGND
        '
        'return 0

        case WM_DESTROY:
 
        // Post the WM_QUIT message to
        // quit the application terminate.
 
        wglDeleteContext hRC
        wglMakeCurrent h.hDC[3], null : ReleaseDC hWnd,hDC
        wglMakeCurrent h.hDC[4], null : ReleaseDC hWnd,hDC
        PostQuitMessage(0);
        return 0;


    end select
    '


    macro PrepareForRender(x,y,w,h)
    '==============================
    '
    'SET THE VIEWPORT AND PERSPECTIVE
    '
    glEnable GL_SCISSOR_TEST
    glViewport x,y,w,h
    glScissor  x,y,w,h
    '
    glMatrixMode GL_PROJECTION
    glLoadIdentity
    gluPerspective 45, w/h, 1.0, 100
    glMatrixMode GL_MODELVIEW
    glLoadIdentity
    end macro


    '-----------------------------------
    'CREATE SCENE FRAME AND SWAP BUFFERS
    '===================================
    '
    if act then
      '
      RECT crect
      '
      '
      'PROCESS EACH OPENGL CHILD WINDOW
      '--------------------------------
      '
      'READ ROTATION SPEED FROM EDIT BOX
      '
      SendMessage h[1].hWnd, WM_GETTEXT,32 , @zs
      angi1=val zs
      '
      wglMakeCurrent h[3].hDC, hRC
      GetClientRect  h.hwnd,@cRect
      PrepareForRender 0,0,cRect.right,cRect.bottom
      glClearColor .9, 0.9, 1.0, 0
      glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
      gltranslatef 0,0,-1
      glrotatef ang1, 0,0,1
      '
      shape1()
      '
      swapBuffers h[3].hdc

      ang1+=angi1
      if ang1>360 then ang1-=360
      '
      '
      'NEXT OPENGL CHILD WINDOW
      '========================
      '
      'READ ROTATION SPEED FROM EDIT BOX
      '
      SendMessage h[2].hWnd, WM_GETTEXT,32 , @zs
      angi2=val zs
      '
      wglMakeCurrent h[4].hDC, hRC
      GetClientRect(h[4].hwnd, @cRect)
      '
      'FOUR VIEWPORTS
      '
      sys u,v,x,y
      '
      u=cRect.right  >>1
      v=cRect.bottom >>1
      glEnable GL_SCISSOR_TEST
      '
      for y=0 to 1
      for x=0 to 1
        PrepareForRender x*u+5,y*v+5,u-10,v-10
        glClearColor 0.5*x, 0, 0.5*y, 0
        glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
        gltranslatef 0,0,-2
        if x=0 then glrotatef ang2, 0,0,1
        if x=1 then glrotatef ang2, 1,0,0
        '
        shape2()
        '
      next
      next
      swapBuffers h[4].hdc
      sleep 15
      ang2+=angi2
      if ang2>360 then ang2-=360
      '
      act=0
      return 0
      '
    end if 'act
    '
    '
    'for unprocessed messages:
    '
    return DefWindowProc(hwnd, uMsg, wParam, lParam);
    '
  end function
  '--------------------------------------------------------------------
  Function WinMain(sys inst, prevInst, asciiz*cmdline, sys show) as sys
  '====================================================================
                    '
  dim a,b,c,style,hWnd as sys
  dim wc as WNDCLASS
  dim wm as MSG

  with wc                '
    .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=strptr "openglch"
  end with

  hinstance=inst

  if not RegisterClass @wc
    MessageBox 0,`Registration failed`,`Problem`,MB_ICONERROR
    exit function
  end if


  style=WS_OVERLAPPEDWINDOW
  style=WS_OVERLAPPEDWINDOW | // overlapped window
        WS_HSCROLL |          // horizontal scroll bar
        WS_VSCROLL            // vertical scroll bar


  // Create the main window.

  hwndMain = CreateWindowEx(
    0,                      // no extended styles         
    strptr "openglch",      // class name                 
    strptr szAppName,      // window title
    style,                  //               
    CW_USEDEFAULT,          // default horizontal position 
    CW_USEDEFAULT,          // default vertical position   
    800,                    // default width               
    240,                    // default height             
    null,                  // no parent or owner window   
    null,                  // class menu used             
    hinstance,              // instance handle             
    null);                  // no window creation data     
         

  // Show the window using the flag specified by the program
  // that started the application, and send the application
  // a WM_PAINT message.

  hwnd=hwndMain
     
  if not hWnd then
    MessageBox 0,`Unable to create window`,`problem`,MB_ICONERROR
    exit function
  end if

                        '
  ShowWindow hWnd,show
  UpdateWindow hWnd
 '
  SetTimer hWnd,1,10,null
  '
  '
  'MESSAGE LOOP
  '
  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
  '
  killTimer hwnd, 1
  '
  function=wm.wparam

  end function ; end of WinMain

'-----------------------------------------
  WinMain inst,0,cmdline,SW_NORMAL
Print
Go Up Pages1
User actions