2004.12.9 コンピュータグラフィックス2

OpenGLによるアニメーション

１．ダブルバッファリングの設定

1)初期設定

VB上でglutによる初期化がうまく稼動しないため，Initialize部分を以下のように設定する．
Private Function Initialize() As Boolean
    Dim pfd As PIXELFORMATDESCRIPTOR
    Dim r&
    Picture1.ScaleMode = vbPixels
    pfd.nSize = Len(pfd)
    pfd.nVersion = 1
   pfd.dwFlags = PFD_SUPPORT_OPENGL Or PFD_DRAW_TO_WINDOW OrPFD_DOUBLEBUFFER Or PFD_TYPE_RGBA
    pfd.iPixelType = PFD_TYPE_RGBA
    pfd.cColorBits = 24
    pfd.cDepthBits = 16
    pfd.iLayerType = PFD_MAIN_PLANE
    r = ChoosePixelFormat(Picture1.hDC, pfd)
    If r = 0 Then
        MsgBox "ChoosePixelFormat failed"
        Exit Function
    End If
    r = SetPixelFormat(Picture1.hDC, r, pfd)
    m_hGLRC = wglCreateContext(Picture1.hDC)
    wglMakeCurrent Picture1.hDC, m_hGLRC
    Initialize = True
End Function
2)バッファの切り替え
これまで利用していたglflushに代えて，以下のコマンドを用いる(Picture1を切り替える場合）
SwapBuffers Picture1.hDC

２．シェーディング，ライティングの仮設定

(詳細は次回以降)

1)シェーディングの設定

Initialize中に以下のコマンドを加える．
   glDepthFunc GL_LEQUAL        '陰面処理におけるDepthの判定方法
    glEnable GL_DEPTH_TEST      'DepthTestをONにする．
    glShadeModel GL_FLAT          'フラットシェーディングを行うことを宣言
Draw中のglClearを以下のように変更する．
    glClear GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT

2)ライティングの設定

　Form_Initialize(), Picture1_Paint()プロシージャからの呼び出しを変更する．

Private Sub Form_Initialize()
    Timer1.Interval = 10
    Timer1.Enabled = False
    Initialize
End Sub
Private Sub Picture1_Paint()
    ViewSet 50, Picture1.ScaleWidth / Picture1.ScaleHeight, 1, 100
    SetLight
    Draw
End Sub

以下のサブプロシージャを作成する．

Private Sub SetLight()
    Dim ambientLight0(3) As Single
    Dim positionLight0(3) As Single
    'fillarray4fはユーザー定義
    FillArray4f ambientLight0(), 0.3!, 0.3!, 0.3!, 1!
    FillArray4f positionLight0(), -2!, 10!, -4!, 1!
    glLightfv GL_LIGHT0, GL_AMBIENT, ambientLight0(0)
    glEnable GL_LIGHTING
    glEnable GL_LIGHT0
End Sub
Private Sub FillArray4f(a() As Single, f1 As Single, f2 As Single, f3 As Single, f4 As Single)
    a(0) = f1: a(1) = f2: a(2) = f3: a(3) = f4
End Sub

３．ディスプレイリスト

　　モデリングされた部品群のグループ化：
　　　　例えばタイヤとホイールのように常に一体化して動く部品をグループ化し，あらかじめOpenGL上で
　　　　コンパイルしておくことにより，無駄な演算処理を省き，高速な描画を実現する．

glNewList gluint, GL_COMPILE
glEndList
gluintは整数

　

4．コード

Option Explicit
'Form1上にPicture1及びCommand1(0), Command1(1)を配置する．
'重要　Command1ボタンをコントロール配列に　（Command1ボタンをコピー＆貼り付けで作成できる）
Dim m_hGLRC As Long
Private Type pnt3d
    x As Single
    y As Single
    z As Single
End Type
Dim r As pnt3d
Dim addr As pnt3d
Private Sub Form_Initialize()
    Timer1.Interval = 10
    Timer1.Enabled = False
    Initialize
    makemodel
End Sub
Private Sub Command1_MouseDown(index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim add As Integer
    If Button = vbLeftButton Then add = 1 Else add = -1
    Select Case index
        Case 0
            addr.y = 0
            addr.z = add * 1
        Case 1
            addr.y = add * 1
            addr.z = 0
            
    End Select
    Timer1.Enabled = True
End Sub
Private Sub Command1_MouseUp(index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    Timer1.Enabled = False
End Sub
Private Sub Picture1_Paint()
    ViewSet 50, Picture1.ScaleWidth / Picture1.ScaleHeight, 1, 100
    SetLight
    Draw
End Sub
Private Function Initialize() As Boolean
    Dim pfd As PIXELFORMATDESCRIPTOR
    Dim r&
    Picture1.ScaleMode = vbPixels
    pfd.nSize = Len(pfd)
    pfd.nVersion = 1

'　　ダブルバッファ切替
'    ダブルバッファを使わない場合：pfd.dwFlags = PFD_SUPPORT_OPENGL Or PFD_DRAW_TO_WINDOW
'    ダブルバッファを使う場合
    pfd.dwFlags = PFD_SUPPORT_OPENGL Or PFD_DRAW_TO_WINDOW Or PFD_DOUBLEBUFFER Or PFD_TYPE_RGBA

    pfd.iPixelType = PFD_TYPE_RGBA
    pfd.cColorBits = 24
    pfd.cDepthBits = 16
    pfd.iLayerType = PFD_MAIN_PLANE
    r = ChoosePixelFormat(Picture1.hDC, pfd)
    If r = 0 Then
        MsgBox "ChoosePixelFormat failed"
        Exit Function
    End If
    r = SetPixelFormat(Picture1.hDC, r, pfd)
    m_hGLRC = wglCreateContext(Picture1.hDC)
    wglMakeCurrent Picture1.hDC, m_hGLRC
    glDepthFunc GL_LEQUAL
    glEnable GL_DEPTH_TEST
    glShadeModel GL_FLAT
    Initialize = True
End Function
Private Sub Form_Unload(Cancel As Integer)
    If m_hGLRC <> 0 Then
        wglMakeCurrent 0, 0
        wglDeleteContext m_hGLRC
    End If
End Sub
Private Sub ViewSet(fov As Single, aspect As Single, near As Single, far As Single)
    glMatrixMode GL_PROJECTION
    glLoadIdentity
    gluPerspective fov, aspect, near, far
    glViewport 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight
    
    '視点の設定
    glTranslatef 0#, 0#, -10#
    glRotatef 20, 1, 0, 0
    'Matrixの切替
    glMatrixMode GL_MODELVIEW
    glLoadIdentity
    
End Sub
Private Sub makemodel()
    glNewList 1, GL_COMPILE
        glutSolidSphere 0.3, 10, 10
        glutWireTorus 0.1, 0.3, 10, 20
    glEndList
End Sub
Public Sub Draw()
    Dim n As Integer
    glClearColor 0.3, 0.3, 0.4, 0
    glClear GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT
    glColor3f 1#, 1#, 1#
    
    glTranslatef addr.z / 25, 0, 0
    glRotatef addr.y, 0, 1, 0
    
    drawAxisGlobal
    glPushMatrix
        glPushMatrix
            glTranslatef -0.5, 0, -0.3
            glRotatef -r.z, 0, 0, 1
            glCallList 1
        glPopMatrix
        glPushMatrix
            glTranslatef 0.5, 0, -0.3
            glRotatef -r.z, 0, 0, 1
            glCallList 1
        glPopMatrix
        glPushMatrix
            glTranslatef -0.5, 0, 0.3
            glRotatef -r.z, 0, 0, 1
            glCallList 1
        glPopMatrix
        glPushMatrix
            glTranslatef 0.5, 0, 0.3
            glRotatef -r.z, 0, 0, 1
            glCallList 1
        glPopMatrix
    glPopMatrix
    SwapBuffers Picture1.hDC
End Sub
Private Sub Timer1_Timer()
    r.z = r.z + addr.z
    r.y = r.y + addr.y
    Draw
End Sub
Public Sub drawAxisGlobal()
    glBegin GL_LINES
        glVertex3f -5, 0, 0
        glVertex3f 5, 0, 0
    glEnd
    glBegin GL_LINES
        glVertex3f 0, -5, 0
        glVertex3f 0, 5, 0
    glEnd
End Sub
Private Sub FillArray4f(a() As Single, f1 As Single, f2 As Single, f3 As Single, f4 As Single)
    a(0) = f1: a(1) = f2: a(2) = f3: a(3) = f4
End Sub
Private Sub SetLight()
    Dim ambientLight0(3) As Single
    Dim positionLight0(3) As Single
    'fillarray4fはユーザー定義
    FillArray4f ambientLight0(), 0.3!, 0.3!, 0.3!, 1!
    FillArray4f positionLight0(), -2!, 10!, -4!, 1!
    glLightfv GL_LIGHT0, GL_AMBIENT, ambientLight0(0)
    glEnable GL_LIGHTING
    glEnable GL_LIGHT0
End Sub