pano.bas

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

        ' *******************************************************************************
        ' Alternate methode to create a GDImage OpenGL control
        ' Note: when GDImage is active the OpenGL $GLImageClassName is already registered
        ' -------------------------------------------------------------------------------
          ClientXsize& = 512: ClientYsize& = 384
          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 any of the supported GDImage graphic format to create a texture
          CALL ZI_DoNotSquareTexture() ' Do not fit the texture into a square shape
          zTexture = "panohigh.jpg"
          IF ZI_SetGLTextureFromFile(zTexture) = 0 THEN ' There is no OpenGL error
             CALL ZI_InitGLControl(ZD_ColorARGB(255, RGB(0,0,16)))
             CALL InitializeGL()
             
             UseFont.fontName = "Arial"
             UseFont.fontHeight = 10
             UseFont.fontWeight = %FW_BOLD
             CALL ZI_BuildGLfont(ZI_GetGLDC(glWnd), UseFont) ' Build OpenGL font for our OpenGL window
             CALL GlobalFont(UseFont, 1)
          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

        ' *******************************************************
        ' This is a special message loop to render fast animation
        ' *******************************************************
          WHILE Done = %FALSE                             ' Loop That Runs While done = %FALSE
             IF PeekMessage(Msg, %NULL, 0, 0, %PM_REMOVE) THEN ' Is There A Message Waiting?
                IF msg.message = %WM_QUIT THEN            ' Have We Received A Quit Message?
                   Done = %TRUE                           ' If So done = %TRUE
                ELSE                                      ' If Not, Deal With Window Messages
                   'IF TranslateAccelerator(ghWnd, hAccel, Msg) = 0 THEN
                      CALL TranslateMessage(msg)          ' Translate The Message
                      CALL DispatchMessage(msg)           ' Dispatch The Message
                   'END IF
                END IF
             ELSE                                         ' If there are no pending messages
                IF Active THEN                            ' Draw The Scene.
                   
                   IF GetFocus <> hMain THEN              ' Do they hold down a Zoom button
                      CALL MessageButton(hMain, Msg) 
                   END IF

                   CALL DrawTheScene(UseFont)             ' Draw the Scene (Don't draw when inactive 1% CPU Use)
                   IF IsZoomed(hMain) = 0 THEN
                      IF GetForegroundWindow <> hMain THEN CALL apisleep(1)
                   END IF

                ELSE                                      ' When minimized don't hog the CPU.
                   CALL apiSleep(100)
                END IF
             END IF
          WEND

          FUNCTION = msg.wParam
       END IF

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

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

SUB ResetPano()
    Vert  = 90
    Horz  = 180
    vIncr = 0
    hIncr = 0
END SUB

' Set up our OpenGL scene
SUB InitializeGL()

    CALL ResetPano()

    CALL glShadeModel(%GL_SMOOTH)                                 ' Enable Smooth Shading
    CALL glHint(%GL_PERSPECTIVE_CORRECTION_HINT, %GL_NICEST)      ' Do nicest perspective

    CALL glEnable(%GL_COLOR_MATERIAL)                             ' Enable Coloring Of Material

END SUB

SUB DrawTheScene(UseFont AS ZGLFONT)
    LOCAL Radius AS SINGLE, quadObj AS LONG

    STATIC UseColor AS LONG

    CALL glClear(%GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT)

    IF UseColor& = 0 THEN UseColor& = ZD_ColorARGB(255, RGB(128,0,0))

    Vert = (Vert + vIncr) MOD 360
    Horz = (Horz + hIncr) MOD 360
    CALL ZI_DrawGLText(glWnd, UseFont, 10, 10, ("Horizontal " + STR$(CINT(Horz))), UseColor)
    CALL ZI_DrawGLText(glWnd, UseFont, 26, 10 + UseFont.fontHeight, ("Vertical " + STR$(CINT(Vert))), UseColor)
    CALL ZI_DrawGLText(glWnd, UseFont, 40, 10 + UseFont.fontHeight * 2, ("Zoom " + STR$(101 - FIX(ZI_GetGLzoom(glWnd) * 1.72415))), UseColor)

    CALL glPushMatrix()
         CALL ZI_UseGLPanoramaView(Vert, Horz)
    CALL glPopMatrix()

    CALL ZI_UpdateGLWindow(glWnd)
END SUB

FUNCTION WndProc(BYVAL hWin AS LONG, BYVAL Msg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG
    
    LOCAL ps AS PAINTSTRUCT, lp AS POINTAPI, ZoomIs AS LONG, UseFont AS ZGLFONT

    STATIC wasX&, wasY&

    SELECT CASE Msg&

    CASE %WM_ACTIVATE                                ' Watch For Window Activate Message
         IF HIWRD(wParam) = 0 THEN                   ' Check Minimization State
            Active = 1                               ' Program Is Active
         ELSE                                        ' Otherwise
            Active = 0                               ' Program Is No Longer Active
         END IF

    CASE %WM_SIZE
         CALL ZI_ResizeGLWindow(glWnd)
         CALL GlobalFont(UseFont, 0): CALL DrawTheScene(UseFont)

    CASE %WM_COMMAND
         wP& = LOWRD(wParam&)

         SELECT CASE LONG wP&
         CASE %ID_START
              hIncr = 0.05

         CASE %ID_LEFT
              hIncr = hIncr + 0.01

         CASE %ID_RIGHT
              hIncr = hIncr - 0.01

         CASE %ID_UP
              vIncr = vIncr + 0.01

         CASE %ID_DOWN
              vIncr = vIncr - 0.01

         CASE %ID_RESET
              CALL ResetPano()
              CALL ZI_SetGLzoom(glWnd, 0): CALL ZI_ResizeGLWindow(glWnd)
              CALL GlobalFont(UseFont, 0): CALL DrawTheScene(UseFont)

         CASE %ID_NEW_IMAGE
              FilName$ = ZI_LoadDialog(hWin&)
              IF LEN(FilName$) THEN
                 CALL ZI_DoNotSquareTexture()
                 CALL ZI_SetGLTextureFromFile((FilName$))
              END IF

         END SELECT
         IF GetFocus <> hWin THEN CALL SetFocus(hWin)

    CASE %WM_KEYDOWN
         SELECT CASE LONG wParam
         CASE %VK_LEFT
              hIncr = hIncr + 0.01
         CASE %VK_RIGHT
              hIncr = hIncr - 0.01
         CASE %VK_UP
              vIncr = vIncr + 0.01
         CASE %VK_DOWN
              vIncr = vIncr - 0.01
         CASE %VK_PGUP
              ZoomIs = ZI_GetGLzoom(glWnd)
              IF ZoomIs > 1 THEN
                 CALL ZI_SetGLzoom(glWnd, ZoomIs - 1): CALL ZI_ResizeGLWindow(glWnd)
              END IF
         CASE %VK_PGDN
              ZoomIs = ZI_GetGLzoom(glWnd)
              IF ZoomIs < 58 THEN
                 CALL ZI_SetGLzoom(glWnd, ZoomIs + 1): CALL ZI_ResizeGLWindow(glWnd)
              END IF
         END SELECT
         FUNCTION = 0: EXIT FUNCTION

    CASE %WM_PAINT
         CALL GradientPaint(hWin&, RGB(228,227,227), RGB(168,167,191))
         FUNCTION = 0: EXIT FUNCTION
    CASE %WM_DESTROY
         CALL PostQuitMessage(0)
         FUNCTION = 0: EXIT FUNCTION
    END SELECT
    FUNCTION = DefWindowProc(hWin&, Msg&, wParam&, lParam&)
END FUNCTION

SUB GradientPaint(BYVAL hWin&, BYVAL TopRGB&, BYVAL BottomRGB&)
    LOCAL ps AS PAINTSTRUCT
    LOCAL rc AS RECT
  ' Tile the background
    CALL GetClientRect (hWin&, rc)
    hDC& = BeginPaint(hWin&, ps)
    CALL ZI_GradientPaintDC(hDC&, 0, 0, rc.nRight, rc.nBottom, TopRGB&, BottomRGB&)
    CALL EndPaint(hWin&, ps)
END SUB