image.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& = 512
          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
          IF ZI_SetGLTextureFromFile("genus.jpg") = 0 THEN ' There is no OpenGL error
             CALL ZI_InitGLControl(ZD_ColorARGB(255, RGB(0,0,16)))
             CALL InitializeGL()
             
             UseFont.fontName = "Time Roman"
             UseFont.fontHeight = 12
             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

        ' Create a high precision MultiMedia timer for the Text marquee effect
          UseDelay& = 10
          hMMTimer = TimeSetEvent(UseDelay&, 100, CODEPTR(MMTimerProc), hMain, 1)

        ' *******************************************************
        ' 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.
                   
                   CALL MessageButton(hMain, Msg)         ' Check for Mouse and Zooming

                   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

        ' Delete our high precision MultiMedia timer  
          IF hMMTimer THEN CALL TimeKillEvent(hMMTimer???)

          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 SetDefault()
    gDistance = -4.0
    gSpinX    = 0
    gSpinY    = 0
    gYincr    = 0
    gXincr    = 0
END SUB

' Set up our OpenGL scene
SUB InitializeGL()
 
    CALL SetDefault()

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

    DIM LightAmbient(3) AS SINGLE:  ARRAY ASSIGN LightAmbient()  = 0.05, 0.05, 0.05, 1.0
    DIM LightDiffuse(3) AS SINGLE:  ARRAY ASSIGN LightDiffuse()  = 1.0, 1.0, 1.0, 1.0
    DIM LightPosition(3) AS SINGLE: ARRAY ASSIGN LightPosition() = 20.0, 0.0, 30.0, 1.0
    CALL glLightfv(%GL_LIGHT0, %GL_AMBIENT, LightAmbient(0))      ' Setup The Ambient Light
    CALL glLightfv(%GL_LIGHT0, %GL_DIFFUSE, LightDiffuse(0))      ' Setup The Diffuse Light
    CALL glLightfv(%GL_LIGHT0, %GL_POSITION, LightPosition(0))    ' Position The Light
    CALL glEnable(%GL_LIGHT0)                                     ' Enable Light ZERO
    CALL glEnable(%GL_LIGHTING)                                   ' Enable Lighting
    CALL glEnable(%GL_COLOR_MATERIAL)                             ' Enable Coloring Of Material

END SUB

SUB MMTimerProc(BYVAL uTimerID AS LONG, BYVAL uMsg AS LONG, BYVAL hMain AS DWORD, BYVAL d1 AS DWORD, BYVAL d2 AS DWORD)
    CALL PostMessage(hMain, %WM_MMTIMER, 0, 0)
END SUB

SUB DrawTheScene(UseFont AS ZGLFONT)
    LOCAL rc AS RECT
    STATIC UseColor AS LONG, zText AS ASCIIZ * 128', One AS LONG', stW AS LONG', T AS DWORD', xT AS LONG, yT AS LONG

    CALL glClear(%GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT)

    gSpinX = (gSpinX + gXincr) MOD 360
    gSpiny = (gSpinY + gYincr) MOD 360
       
    CALL glMatrixMode( %GL_MODELVIEW )
    CALL glLoadIdentity()
    CALL glTranslatef(0.0, 0.0, gDistance)
    CALL glRotatef(-gSpinY, 1.0, 0.0, 0.0)
    CALL glRotatef(-gSpinX, 0.0, 1.0, 0.0)
     
    CALL glBegin(%GL_QUADS)
     ' 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()

    IF stW = 0 THEN
       zText = "GDImage does OpenGL"
       CALL ZI_GetGLTextExtent(glWnd, UseFont, zText, stW, stH)
       UseColor& = ZD_ColorARGB(255, RGB(64,64,92))
       One = -1
       xT = rc.nRight - stw
    END IF
    CALL ZI_DrawGLText(glWnd, UseFont, xT, yT, zText, UseColor)

    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, rc as RECT

    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_MMTIMER                                 ' Our MultiMedia timer is used to perform the marquee text effect
         CALL GetClientRect(glWnd, rc)
         yT = rc.nBottom - stH - 10
         xT = xT + One: IF xT < 0 THEN xT = 0: One = 1
         IF xT > rc.nRight - stw THEN xT = rc.nRight - stw: One = -1

    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
              gYincr = 0.05

         CASE %ID_LEFT
              gXincr = gXincr + 0.05

         CASE %ID_RIGHT
              gXincr = gXincr - 0.05

         CASE %ID_UP
              gYincr = gYincr + 0.05

         CASE %ID_DOWN
              gYincr = gYincr - 0.05

         CASE %ID_RESET
              CALL SetDefault()
              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_SetGLTextureFromFile((FilName$))
              END IF

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

    CASE %WM_KEYDOWN
         SELECT CASE LONG wParam
         CASE %VK_LEFT
              gXincr = gXincr + 0.05
         CASE %VK_RIGHT
              gXincr = gXincr - 0.05
         CASE %VK_UP
              gYincr = gYincr + 0.05
         CASE %VK_DOWN
              gYincr = gYincr - 0.05
         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 < 180 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