Attribute VB_Name = "modD3D"
Option Explicit

Const PI As Double = 3.14159265358979   '円周率の定数化

'DirectXオブジェクト
Dim DX As New DirectX8  'DirectXオブジェクト

'Direct3D
Dim D3D As Direct3D8    'Direct３Dオブジェクト
Dim D3DX As New D3DX8   'D3DXライブラリ
Dim D3DDevice As Direct3DDevice8    'Direct3Dデバイス
Dim StarMesh(4) As D3DXMesh         '球のメッシュ配列

'Direct3D関連
Dim StarMaterials() As D3DMATERIAL8 '球のマテリアル配列
Dim StarMeshDevideCount As Long     '球のメッシュの分割数

'各種パラメータ
Public RenderFlag As Boolean   '描画フラグ
Public Theta As Double         '回転角度

'
'Direct3D初期化
'
Public Sub InitD3D()

On Error Resume Next    'エラーの場合、次の行から再開

'ローカル変数の宣言
Dim D3DDM As D3DDISPLAYMODE         'ディスプレイ・モード格納構造体
Dim D3DPP As D3DPRESENT_PARAMETERS  'プレゼンテーション・パラメータ格納構造体
    'オブジェクトの生成
    Set D3D = DX.Direct3DCreate()   '3Dシステムの生成
    
    'ディスプレイモードの設定
    D3D.GetAdapterDisplayMode D3DADAPTER_DEFAULT, D3DDM     'ディスプレイモードを取得
    With D3DPP                                              'プレゼンテーションパラメータに関する設定
        .Windowed = True        'ウィンドウモード
        .SwapEffect = D3DSWAPEFFECT_COPY_VSYNC  '画面の更新方法
        .BackBufferFormat = D3DDM.Format        'ディスプレイのフォーマット
        .AutoDepthStencilFormat = D3DFMT_D16    '深度バッファ
        .EnableAutoDepthStencil = True          '深度処理の有効化
    End With
    
    'Direct3Dデバイス生成   frmD3D
    Set D3DDevice = D3D.CreateDevice(D3DADAPTER_DEFAULT, _
        D3DDEVTYPE_REF, frmD3D.hWnd, _
        D3DCREATE_SOFTWARE_VERTEXPROCESSING, D3DPP) 'D3Dデバイスを生成
    If D3DDevice Is Nothing Then        'D3Dデバイスが生成されない場合
        Set D3DDevice = D3D.CreateDevice(D3DADAPTER_DEFAULT, _
            D3DDEVTYPE_HAL, frmD3D.hWnd, _
            D3DCREATE_SOFTWARE_VERTEXPROCESSING, D3DPP) 'モードを変えてD3Dデバイスを生成
        If D3DDevice Is Nothing Then    'それでもだめなとき
            Call ReleaseObject          'やめる
        End If
    End If
    
    '描画の質を設定
    D3DDevice.SetRenderState D3DRS_ZENABLE, 1       'Zバッファを有効にする
    'その他の初期化処理
    Call SetupViewMatrix    '視点、射影のマトリックス設定
    Call SetupLight         '光源設定
End Sub

'
'3D空間構築（ジオメトリ）設定
'
Public Sub InitGeometry()
'ループ用変数の宣言
Dim i As Long

    For i = 0 To 3      '4つの球(Sphere)を生成
        Set StarMesh(i) = D3DX.CreateSphere(D3DDevice, _
                                1, 10, 10, Nothing) 'メッシュを生成
    Next i
    StarMeshDevideCount = StarMesh(0).GetNumVertices()  'メッシュの頂点(Vertices)数を数える
End Sub

'
'太陽のマトリックス設定
'
Sub SetupSunMatrix()

Dim StarWorldMatrix As D3DMATRIX
Dim ReduceMatrix As D3DMATRIX

    '原点に設置
    D3DXMatrixTranslation StarWorldMatrix, 0, 0, 0
    
    '
    D3DXMatrixScaling ReduceMatrix, 0.4, 0.4, 0.4
    
    '
    D3DXMatrixMultiply StarWorldMatrix, StarWorldMatrix, ReduceMatrix
    
    '
    D3DDevice.SetTransform D3DTS_WORLD, StarWorldMatrix
    
End Sub

'
'視点(カメラ)、射影のマトリックス設定
'
Sub SetupViewMatrix()

Dim ViewMatrix As D3DMATRIX         '視点
Dim ProjectionMatrix As D3DMATRIX   '射影
Dim Position As D3DVECTOR           '視点の位置
Dim At As D3DVECTOR                 '視線(視点の方向)
Dim Up As D3DVECTOR                 '視点の傾き

    '視点の位置(どこから見るか)
    With Position
        .x = 0: .y = 4: .z = -5
    End With
    
    'どこを見るか
    With At
        .x = 0: .y = 0: .z = 0
    End With
    
    'カメラの上方向は？
    With Up
        .x = 0: .y = 1: .z = 0
    End With
    
    '視点の設定
    D3DXMatrixLookAtLH ViewMatrix, Position, At, Up '視点のマトリックスを生成
    D3DDevice.SetTransform D3DTS_VIEW, ViewMatrix   '視点のマトリックスを適用
    
    '射影の設定
    D3DXMatrixPerspectiveFovLH ProjectionMatrix, PI / 4, 1, 1, 1000 '射影のマトリックスを生成
    D3DDevice.SetTransform D3DTS_PROJECTION, ProjectionMatrix       '射影のマトリックスを適用
    
End Sub

'
'マテリアル生成
'
Sub SetupMaterial(Red As Double, Green As Double, Blue As Double)

'星のメッシュのマテリアル
ReDim StarMaterials(StarMeshDevideCount)
Dim i As Long

    '星のマテリアル設定
    For i = 0 To StarMeshDevideCount - 1    'メッシュの分割数だけループ
        With StarMaterials(i).diffuse       'ディフューズ反射色を設定
            .r = Red                        '反射成分の設定
            .g = Green
            .b = Blue
            .a = 1
        End With
        D3DDevice.SetMaterial StarMaterials(i)  '星のマテリアルを適用
    Next i

End Sub

'
'光源生成処理
'
Sub SetupLight()

Dim DirectionalLight As D3DLIGHT8   '光源
Dim LightColor As D3DCOLORVALUE     '光源の色

    '光源の設定
    DirectionalLight.Type = D3DLIGHT_DIRECTIONAL    '光源の種類を有向光源に設定
    With DirectionalLight.Direction     '光源の方向の設定
        .x = 1: .y = -3: .z = 1
    End With
    With LightColor                     '光源の色の設定
        .r = 1: .g = 1: .b = 1: .a = 1  '白に設定
    End With
    DirectionalLight.diffuse = LightColor   'ディフューズ反射色を設定
    
    '光源をDirect3Dデバイスに適用
    D3DDevice.SetLight 0, DirectionalLight          '光源を生成
    D3DDevice.LightEnable 0, 1                      '光源を有効化
    D3DDevice.SetRenderState D3DRS_LIGHTING, True   '光源を適用
End Sub


'
'描画処理
'
Public Sub Render()

Dim i As Long
    '描画準備
    D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET Or _
            D3DCLEAR_ZBUFFER, &H0, 1, 0             'ビューポートの消去
                                       
    D3DDevice.BeginScene                    'レンダリングの開始
        
        '太陽を描画
        Call SetupSunMatrix     '太陽のマトリクス設定
        Call SetupMaterial(255, 255, 0) 'マテリアル生成
        For i = 0 To StarMeshDevideCount - 1
            StarMesh(3).DrawSubset i
        Next i
    
    D3DDevice.EndScene      'レンダリング終了
    
    'ディスプレイに表示
    D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0  '画面に表示

End Sub

'
'開放処理
'
Public Sub ReleaseObject()

    'DirectXオブジェクトの開放
    Set DX = Nothing
    
    'Direct3Dオブジェクトの開放
    Set D3D = Nothing       'Direct3D
    Set D3DX = Nothing      'D3DXクラス
    Set D3DDevice = Nothing 'Direct3Dデバイス
    
End Sub


