illusion.bas

Powerbasic 对GDI 的操作 很漂亮的代码!

          UseW& = ClientXsize& ' Use this to preserve the size
          UseH& = ClientYsize& ' Use this to preserve the size
          Style& = %WS_CHILD OR %WS_VISIBLE 'OR %WS_HSCROLL OR %WS_VSCROLL
          StyleEx& = %WS_EX_STATICEDGE
          CALL ZI_AdjustWindowRect(StyleEx&, UseW&, UseH&, Style&)
          glWnd = CreateWindowEx(StyleEx&, _
                                 $GLImageClassName, _         ' Make it an OpenGL control
                                 "", _                        ' Currently not used
                                 Style&, _                    ' window style
                                 10, _                        ' initial x position
                                 10, _                        ' initial y position
                                 useW&, _                     ' Calculate Window Width
                                 useH&, _                     ' Calculate Window Height
                                 hMain, _                     ' parent window handle
                                 %ID_CTRL, _                  ' ControlID
                                 zInstance, _                 ' program instance handle
                                 BYVAL 0)                     ' creation parameters
          CALL ZI_SetAnchorMode(glWnd, %ANCHOR_HEIGHT_WIDTH)  ' Anchor the control (make it a resizable)
        ' OpenGL section                                      ' ----------------------------------------
        ' Load PNG 32-bit using variable opacity to create OpenGL transparent textures
          DIM mt(1) AS ZGLTEXTURE
          mt(0).FullName = "ilaero.png": mt(0).ID = 10
          mt(1).FullName = "ilvista.jpg": mt(1).ID = 20
          'mt(1).FullName = "ilaero.jpg": mt(1).ID = 20
          IF ZI_SetMutipleGLTextureFrom32Bit(BYVAL VARPTR(mt(LBOUND(mt))), UBOUND(mt) - LBOUND(mt) + 1) = 0 THEN

             ARGBcolor& = ZD_ColorARGB(255, RGB(255,255,255)) ' Use this color for the OpenGL background
             
          '//CALL ZI_InitGLControl(ARGBcolor&)               ' Initialyze the OpenGL parameters
           ' Same as ZI_InitGLControl except for %GL_DEPTH_TEST
           ' that is enabled / disabled for the purpose of the demo.
             CALL glEnable(%GL_TEXTURE_2D)
             CALL zSplitColorARGB(ARGBcolor&, A?, R?, G?, B?)
             Alpha! = A? + 1: Red! = R? + 1: Green! = G? + 1: Blue! = B? + 1
             CALL glClearColor(Red! / 256, Green! /256, Blue! / 256, Alpha! / 256)
             CALL glClearDepth(1.0)

'//CALL glEnable(%GL_DEPTH_TEST)
             CALL glDepthFunc(%GL_LESS)'GREATER)'LEQUAL)'ALWAYS)'%GL_LESS)


             CALL glShadeModel(%GL_SMOOTH)
             CALL glMatrixMode(%GL_PROJECTION)
    
             CALL glEnable(%GL_BLEND)
             CALL glBlendFunc(%GL_SRC_ALPHA, %GL_ONE_MINUS_SRC_ALPHA)

'CALL glEnable(%GL_DEPTH_TEST)


'%GL_EDGE_FLAG                      = &H0B43
'%GL_CULL_FACE                      = &H0B44
'%GL_CULL_FACE_MODE                 = &H0B45
'%GL_FRONT_FACE                     = &H0B46
'CALL glEnable(%GL_FRONT_FACE)
'CALL glEnable(%GL_CULL_FACE)
'CALL glEnable(%GL_CULL_FACE_MODE)
'CALL glEnable(%GL_EDGE_FLAG)

'// bad suggestion CALL glDepthMask(0)
CALL glEnable(%GL_ALPHA_TEST)


          END IF

        ' Show the main window
          CALL ShowWindow(hMain, iCmdShow)
          CALL SetForegroundWindow(hMain)                ' Slightly Higher Priority
          CALL SetFocus(hMain)                           ' Sets Keyboard Focus To The Window

          CALL SetTimer(hMain, 1, 0, %NULL)
          CALL SetTimer(hMain, 2, 20, %NULL)
          WHILE GetMessage(Msg, %NULL, 0, 0)
                CALL TranslateMessage(Msg)
                CALL DispatchMessage(Msg)
          WEND
          CALL KillTimer(hMain, 1)
          CALL KillTimer(hMain, 2)

          FUNCTION = msg.wParam
       END IF

       CALL zDeleteObject(zCaptionFont) ' Delete the caption font

     ' UNLOAD the WinXP Theme DLL (if necessary)
       IF hWinXP_Lib THEN CALL FreeLibrary(hWinXP_Lib)

    END IF
'
    IF hMutex THEN CALL CloseHandle(hMutex)
'
END FUNCTION

SUB DrawTheScene() ' See MSDN documentation for the use of the OpenGL API

    STATIC xrot AS SINGLE, yrot AS SINGLE, zrot AS SINGLE

    CALL glClear(%GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT)
    CALL glLoadIdentity()

  ' Draw the transparent background texture ------------------------
    CALL glBindTexture(%GL_TEXTURE_2D, mt(1).texture)
    CALL glBegin(%GL_QUADS)
       CALL glTexCoord2f(0.0, 0.0): CALL glVertex3f(-25,-25,-60.0) ' Bottom Left Of The Texture And Quad
       CALL glTexCoord2f(1.0, 0.0): CALL glVertex3f( 25,-25,-60.0) ' Bottom Right Of The Texture And Quad
       CALL glTexCoord2f(1.0, 1.0): CALL glVertex3f( 25, 25,-60.0) ' Top Right Of The Texture And Quad
       CALL glTexCoord2f(0.0, 1.0): CALL glVertex3f(-25, 25,-60.0) ' Top Left Of The Texture And Quad
    CALL glEnd()
  ' ----------------------------------------------------------------

  ' Draw the transparent moving texture
    CALL glBindTexture(%GL_TEXTURE_2D, mt(0).texture)

    CALL glTranslatef(0.0, 0.0, -5.0)

    CALL glRotatef(xrot, 1.0, 0.0, 0.0)                             ' Rotate On The X Axis
    CALL glRotatef(yrot, 0.0, 1.0, 0.0)                             ' Rotate On The Y Axis
    CALL glRotatef(zrot, 0.0, 0.0, 1.0)                             ' Rotate On The Z Axis

    CALL glBegin(%GL_QUADS)
     ' Back Face
       CALL glTexCoord2f(1.0, 0.0): CALL glVertex3f(-1.0,-1.0,-1.0) ' Bottom Right Of The Texture And Quad
       CALL glTexCoord2f(1.0, 1.0): CALL glVertex3f(-1.0, 1.0,-1.0) ' Top Right Of The Texture And Quad
       CALL glTexCoord2f(0.0, 1.0): CALL glVertex3f( 1.0, 1.0,-1.0) ' Top Left Of The Texture And Quad
       CALL glTexCoord2f(0.0, 0.0): CALL glVertex3f( 1.0,-1.0,-1.0) ' Bottom Left Of The Texture And Quad

     ' Bottom Face
       CALL glTexCoord2f(1.0, 1.0): CALL glVertex3f(-1.0,-1.0,-1.0) ' Top Right Of The Texture And Quad
       CALL glTexCoord2f(0.0, 1.0): CALL glVertex3f( 1.0,-1.0,-1.0) ' Top Left Of The Texture And Quad
       CALL glTexCoord2f(0.0, 0.0): CALL glVertex3f( 1.0,-1.0, 1.0) ' Bottom Left Of The Texture And Quad
       CALL glTexCoord2f(1.0, 0.0): CALL glVertex3f(-1.0,-1.0, 1.0) ' Bottom Right Of The Texture And Quad

     ' Right face
       CALL glTexCoord2f(1.0, 0.0): CALL glVertex3f( 1.0,-1.0,-1.0) ' Bottom Right Of The Texture And Quad
       CALL glTexCoord2f(1.0, 1.0): CALL glVertex3f( 1.0, 1.0,-1.0) ' Top Right Of The Texture And Quad
       CALL glTexCoord2f(0.0, 1.0): CALL glVertex3f( 1.0, 1.0, 1.0) ' Top Left Of The Texture And Quad
       CALL glTexCoord2f(0.0, 0.0): CALL glVertex3f( 1.0,-1.0, 1.0) ' Bottom Left Of The Texture And Quad

     ' Left Face
       CALL glTexCoord2f(0.0, 0.0): CALL glVertex3f(-1.0,-1.0,-1.0) ' Bottom Left Of The Texture And Quad
       CALL glTexCoord2f(1.0, 0.0): CALL glVertex3f(-1.0,-1.0, 1.0) ' Bottom Right Of The Texture And Quad
       CALL glTexCoord2f(1.0, 1.0): CALL glVertex3f(-1.0, 1.0, 1.0) ' Top Right Of The Texture And Quad
       CALL glTexCoord2f(0.0, 1.0): CALL glVertex3f(-1.0, 1.0,-1.0) ' Top Left Of The Texture And Quad

     ' Top Face
       CALL glTexCoord2f(0.0, 1.0): CALL glVertex3f(-1.0, 1.0,-1.0) ' Top Left Of The Texture And Quad
       CALL glTexCoord2f(0.0, 0.0): CALL glVertex3f(-1.0, 1.0, 1.0) ' Bottom Left Of The Texture And Quad
       CALL glTexCoord2f(1.0, 0.0): CALL glVertex3f( 1.0, 1.0, 1.0) ' Bottom Right Of The Texture And Quad
       CALL glTexCoord2f(1.0, 1.0): CALL glVertex3f( 1.0, 1.0,-1.0) ' Top Right Of The Texture And Quad

     ' Front Face
       CALL glTexCoord2f(0.0, 0.0): CALL glVertex3f(-1.0,-1.0, 1.0) ' Bottom Left Of The Texture And Quad
       CALL glTexCoord2f(1.0, 0.0): CALL glVertex3f( 1.0,-1.0, 1.0) ' Bottom Right Of The Texture And Quad
       CALL glTexCoord2f(1.0, 1.0): CALL glVertex3f( 1.0, 1.0, 1.0) ' Top Right Of The Texture And Quad
       CALL glTexCoord2f(0.0, 1.0): CALL glVertex3f(-1.0, 1.0, 1.0) ' Top Left Of The Texture And Quad

    CALL glEnd()

    CALL ZI_UpdateGLWindow(glWnd) ' Draw the scene

    IF Animate THEN
       xrot = xrot + 0.3             ' X Axis Rotation
       yrot = yrot + 0.2             ' Y Axis Rotation
       zrot = zrot + 0.4             ' Z Axis Rotation
    END IF

END SUB

FUNCTION WndProc(BYVAL hWnd AS LONG, BYVAL Msg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG
    LOCAL rc AS RECT

    SELECT CASE Msg&

    CASE %WM_SIZE
         CALL ZI_ResizeGLWindow(glWnd)
         CALL DrawTheScene()
   
    CASE %WM_TIMER
         IF Animate THEN CALL DrawTheScene()

    CASE %WM_COMMAND
         wP& = LOWRD(wParam&)

         SELECT CASE LONG wP&
         CASE %ID_START_SHOW
              Animate = -1

         CASE %ID_STOP_SHOW
              Animate = 0

         CASE %ID_NEW_IMAGE
              FilName$ = ZI_LoadDialog(hWnd&)
              IF LEN(FilName$) THEN 
               ' Delete existing texture
                 CALL glDeleteTextures(1, mt(0).Texture)
                 mt(0).FullName = FilName$
               ' Load the new one
                 IF ZI_SetMutipleGLTextureFrom32Bit (BYVAL VARPTR(mt(LBOUND(mt))), 1) = 0 THEN
                    CALL DrawTheScene()
                 END IF                 
              END IF

         CASE %ID_BTN_CHECK
              IF SendMessage(lParam, %BM_GETCHECK, 0, 0) THEN
                 CALL glEnable(%GL_DEPTH_TEST)
              ELSE
                 CALL glDisable(%GL_DEPTH_TEST)
              END IF
              
         END SELECT

    CASE %WM_CTLCOLORSTATIC
         SELECT CASE LONG GetDlgCtrlID(lParam)
         CASE %ID_STA_Help
            CALL SetTextColor(wParam, RGB(2,77,220))
            CALL SetBkMode(wParam, %TRANSPARENT)

          ' Use a custom background for the help control
            CALL GetClientRect(GetDlgItem(hWnd, %ID_STA_Help), rc)
            CALL ZI_GradientPaintDC(wParam, 0, 0, rc.nRight, rc.nBottom, RGB(228,227,255), RGB(188,187,211))
            hPen& = CreatePen(0, 1, RGB(128,128,192))
            OldPen& = SelectObject(wParam, hPen&)
            CALL SelectObject(wParam, GetStockObject(%NULL_BRUSH))
            CALL RoundRect(wParam, 0, 0, rc.nRight, rc.nBottom, 8, 8)
            CALL SelectObject(wParam, OldPen&)
            CALL zDeleteObject(hPen&)

            EXIT FUNCTION
         CASE %ID_BTN_CHECK
            CALL SetBkMode(wParam, %TRANSPARENT)

          ' Use a custom background for the Check control
            CALL GetClientRect(GetDlgItem(hWnd, %ID_BTN_CHECK), rc)
            CALL ZI_GradientPaintDC(wParam, 0, 0, rc.nRight, rc.nBottom, RGB(171,170,193), RGB(169,168,192))
            CALL SelectObject(wParam, GetStockObject(%NULL_BRUSH))

            EXIT FUNCTION
         END SELECT

    CASE %WM_ERASEBKGND
         CALL GetClientRect (hWnd, rc)
         CALL ZI_GradientPaintDC(wParam, 0, 0, rc.nRight, rc.nBottom, RGB(228,227,227), RGB(168,167,191))
         FUNCTION = 1: EXIT FUNCTION

    CASE %WM_PAINT
         IF Animate = 0 THEN CALL DrawTheScene()

    CASE %WM_DESTROY
         CALL PostQuitMessage(0)
         FUNCTION = 0: EXIT FUNCTION
    END SELECT
    
    FUNCTION = DefWindowProc(hWnd, Msg&, wParam&, lParam&)

END FUNCTION