chart.bas

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

       wc.hInstance     = zInstance
       wc.hIcon         = LoadIcon(wc.hInstance, "PROGRAM")
       wc.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)
       wc.hbrBackground = %NULL
       wc.lpszMenuName  = %NULL
       wc.lpszClassName = VARPTR(zClass)
       wc.hIconSm       = wc.hIcon
       IF RegisterClassEx(wc) THEN IsInitialized& = %TRUE
    END IF
'
    IF IsInitialized& THEN

     '************************************************************************************
     ' Load the GDImage.dll
       IF RegisterGDImageClass() = 0 THEN
          FUNCTION = 99:  EXIT FUNCTION ' If it fails to register then return ERROR = 99
       END IF
     '************************************************************************************

     ' Load the WinXP Theme support (if applicable)
       hWinXP_Lib = LoadLibrary("UxTheme.dll")
       IF hWinXP_Lib THEN
          hWinXP_IsThemeActive = GetProcAddress(hWinXP_Lib, "IsThemeActive")
       END IF
'
       CALL InitCommonControls
'
     ' Window Extended Style
       dwExStyle = %WS_EX_APPWINDOW OR %WS_EX_WINDOWEDGE
     ' Windows Style
       dwStyle = %WS_OVERLAPPEDWINDOW
       CALL SetRect(rc, 0, 0, 668, 532)
       CALL AdjustWindowRectEx(rc, dwStyle, %FALSE, dwExStyle)  ' Adjust Window To True Requested Size
'
       x = MAX&((GetSystemMetrics(%SM_CXSCREEN) - rc.nRight - rc.nLeft) \ 2, 0)
       y = MAX&((GetSystemMetrics(%SM_CYSCREEN) - rc.nBottom - rc.nTop) \ 2, 0)
'
     ' Create The Window
       MyTitle$ = "GDImage control " + ZI_Version + " - ""Real 3D Chart"" demo"
       hMain = CreateWindowEx(dwExStyle, _           ' Extended Style For The Window
                             zClass, _               ' Class Name
                             (MyTitle$), _           ' Window Title
                             dwStyle OR _            ' Defined Window Style
                             %WS_CLIPSIBLINGS OR _   ' Required Window Style
                             %WS_CLIPCHILDREN, _     ' Required Window Style
                             x, y, _                 ' Window Position
                             rc.nRight - rc.nLeft, _ ' Calculate Window Width
                             rc.nBottom - rc.nTop, _ ' Calculate Window Height
                             %NULL, _                ' No Parent Window
                             %NULL, _                ' No Menu
                             wc.hInstance, _         ' Instance
                             BYVAL %NULL)            ' Dont Pass Anything To WM_CREATE
'
       IF hMain THEN
'
        ' Apply WinXP Theme support
          LOCAL lRes AS LONG, pProc AS DWORD
          IF hWinXP_IsThemeActive THEN
             CALL DWORD hWinXP_IsThemeActive USING IsThemeActive TO lRes
             IF lRes  THEN pProc = GetProcAddress(lRes, "EnableThemeDialogTexture")
             IF pProc THEN CALL DWORD pProc USING EnableDialogTheme(hMain, &H01 OR &H02 OR &H04 OR &H06)
          END IF
'
        ' Create button "Up"
          CALL CreateWindowEx(0, "BUTTON", "U", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
                           672 - (7 + 120 + 8) + 48, 10 + (22 + 5) * 1, 24, 22, hMain, %ID_UP, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_UP), zDefaultFont)
          CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_UP), %ANCHOR_RIGHT)

        ' Create button "Left"
          CALL CreateWindowEx(0, "BUTTON", "L", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
                           672 - (7 + 120 + 8) + 14, 10 + (22 + 5) * 2 + 2, 24, 22, hMain, %ID_LEFT, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_LEFT), zDefaultFont)
          CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_LEFT), %ANCHOR_RIGHT)

        ' Create button "Reset"
          CALL CreateWindowEx(0, "BUTTON", "Reset", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
                           672 - (7 + 120 + 8) + 41, 10 + (22 + 5) * 2 - 2, 38, 30, hMain, %ID_RESET, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_RESET), zDefaultFont)
          CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_RESET), %ANCHOR_RIGHT)

        ' Create button "Right"
          CALL CreateWindowEx(0, "BUTTON", "R", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
                           672 - (7 + 120 + 8) + 82, 10 + (22 + 5) * 2 + 2, 24, 22, hMain, %ID_RIGHT, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_RIGHT), zDefaultFont)
          CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_RIGHT), %ANCHOR_RIGHT)

        ' Create button "Down"
          CALL CreateWindowEx(0, "BUTTON", "D", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
                           672 - (7 + 120 + 8) + 48, 10 + (22 + 5) * 3 + 4, 24, 22, hMain, %ID_DOWN, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_DOWN), zDefaultFont)
          CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_DOWN), %ANCHOR_RIGHT)

        ' Create button "In"
          CALL CreateWindowEx(0, "BUTTON", "Zoom In", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
                           672 - (7 + 120 + 8), 10 + (22 + 5) * 4 + 5, 58, 22, hMain, %ID_ZOOM_IN, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_ZOOM_IN), zDefaultFont)
          CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_ZOOM_IN), %ANCHOR_RIGHT)

        ' Create button "Out"
          CALL CreateWindowEx(0, "BUTTON", "Zoom Out", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
                           672 - (7 + 120 + 8) + 62, 10 + (22 + 5) * 4 + 5, 58, 22, hMain, %ID_ZOOM_OUT, zInstance, BYVAL %NULL)
          CALL zSetCTLFont(GetDlgItem(hMain, %ID_ZOOM_OUT), zDefaultFont)
          CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_ZOOM_OUT), %ANCHOR_RIGHT)

        ' Create Static 
          CALL zStaticCenter($CR + "Left mouse button:" + $CR + "change view angle." + $CR + _
                             $CR + "Right mouse button:" + $CR + "change graph location.", _
                             672 - (7 + 120 + 8), 10 + (22 + 5) * 5 + 5, 120, 96, hMain, %ID_STATIC)
          CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_STATIC), %ANCHOR_RIGHT)

        ' *******************************************************************************
        ' 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
          CALL ZI_DoNotSquareTexture() ' Do not fit the texture into a square shape
          
          DIM mt(5) AS ZGLTEXTURE
          mt(0).FullName = "bgtm16.jpg": mt(0).ID = 10
          mt(1).FullName = "oblique.jpg": mt(1).ID = 20
          mt(2).FullName = "environment.jpg": mt(2).ID = 30
          mt(3).FullName = "water.jpg": mt(3).ID = 40
          mt(4).FullName = "ilvista.jpg": mt(4).ID = 50
          mt(5).FullName = "haltext.png": mt(5).ID = 60
          IF ZI_SetMutipleGLTextureFromFile (BYVAL VARPTR(mt(LBOUND(mt))), UBOUND(mt) - LBOUND(mt) + 1) = 0 THEN
             '//CALL ZI_InitGLControl(ZD_ColorARGB(255, RGB(255,255,255)))
             CALL glEnable(%GL_TEXTURE_2D)
             
             chart.chartseries = 7
             chart.chartnumber = 4
             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_PAINT THEN           ' Detect WM_PAINT message
                   FlagPaint = -1
                END IF
             
                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)         ' Scan message flow to handle things our way.

                   IF GetForegroundWindow = hMain _
                      OR FlagPaint& THEN
                      CALL DrawTheScene(UseFont)          ' Draw the Scene (Don't draw when inactive 1% CPU Use).
                      FlagPaint& = 0                      ' Reset the paint flag.
                   END IF
                   CALL apisleep(10)                      ' Do not hog the CPU

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

          IF quadObj THEN CALL gluDeleteQuadric(quadObj)  ' OpenGL quadric onject

          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 InitGraphOffsets(BYVAL x AS SINGLE, BYVAL y AS SINGLE, BYVAL z AS SINGLE)
    chart.xoff = x
    chart.yoff = y
    chart.zoff = z
END SUB
SUB InitGraphRotation(BYVAL x AS SINGLE, BYVAL y AS SINGLE)
    chart.xrot = x
    chart.yrot = y
END SUB
SUB InitGraph()
    CALL InitGraphOffsets(-3.5, 3.25, -36)
    CALL InitGraphRotation(45.0, -30.0)
    chart.radius = 1.0
END SUB

' Set up our OpenGL scene
SUB InitializeGL()

    LOCAL k AS LONG, i AS LONG, j AS LONG

    CALL InitGraph()

    CALL glClearColor(0.9, 0.9, 1, 1)
    CALL glClearDepth(1.0)
    CALL glDepthFunc(%GL_LESS)
    CALL glEnable(%GL_DEPTH_TEST)
    CALL glShadeModel(%GL_SMOOTH)
    CALL glHint(%GL_PERSPECTIVE_CORRECTION_HINT, %GL_NICEST)

    'CALL glHint(%GL_LINE_SMOOTH_HINT, %GL_NICEST)
    'CALL glHint(%GL_POLYGON_SMOOTH_HINT, %GL_NICEST)
    'CALL glHint(%GL_POINT_SMOOTH_HINT, %GL_NICEST)
    'CALL glHint(%GL_FOG_HINT, %GL_NICEST)