Option Explicit

Dim g_dx            As New DirectX7
Dim m_dd            As DirectDraw7
Dim m_ddClipper     As DirectDrawClipper
Dim m_rm            As Direct3DRM3

Dim m_rmDevice      As Direct3DRMDevice3
Dim m_rmViewport    As Direct3DRMViewport2

Dim m_rootFrame     As Direct3DRMFrame3
Dim m_lightFrame    As Direct3DRMFrame3
Dim m_cameraFrame   As Direct3DRMFrame3
Dim m_objectFrame   As Direct3DRMFrame3
Dim m_uvFrame       As Direct3DRMFrame3
Dim m_light         As Direct3DRMLight
Dim m_meshBuilder   As Direct3DRMMeshBuilder3
Dim m_object        As Direct3DRMMeshBuilder3

Dim m_width         As Long
Dim m_height        As Long
Dim m_running       As Boolean
Dim fPath            As String

'フォームをロードしました
Private Sub Form_Load()
    
    'Xファイルのパスを設定します
    fPath = App.Path & "\" & "dropship.x"
        
    'パスが正しい場合だけ実行します
    If Not (Dir(fPath) = "") Then
        
        '強制的にフォームを表示します
        Show
        DoEvents
        
        'DirectDraw、Direct3DRMの初期化をします
        InitRM
        
        'フレームの初期化をします
        InitScene fPath
        
        'Mainループで3Dを再生します
        RenderLoop
        
        'すべてのクラスを解放します
        CleanUp
    
    Else
        
        'パスが違っていることを知らせます
        MsgBox "指定のパスは存在しません", vbCritical
        
    End If
    
    '強制的に終了します
    End
    
End Sub

'すべてのクラスを解放します
Sub CleanUp()
    
    m_running = False
    
    Set m_light = Nothing
    Set m_meshBuilder = Nothing
    Set m_object = Nothing

    Set m_lightFrame = Nothing
    Set m_cameraFrame = Nothing
    Set m_objectFrame = Nothing
    Set m_rootFrame = Nothing

    Set m_rmDevice = Nothing
    Set m_ddClipper = Nothing
    Set m_rm = Nothing
    Set m_dd = Nothing
 
End Sub

'DirectDraw、Direct3DRMの初期設定です
Sub InitRM()
    
    'DIrectDrawを生成します
    Set m_dd = g_dx.DirectDrawCreate("")
    
    'DIrectDrawClipperを生成して、最終的に表示する位置を決めます
    Set m_ddClipper = m_dd.CreateClipper(0)
    m_ddClipper.SetHWnd Picture1.hWnd
    
    'ピクチャボックスの大きさを代入しておきます。
    m_width = Picture1.ScaleWidth
    m_height = Picture1.ScaleHeight
    
    'Direct3DRMを生成します
    Set m_rm = g_dx.Direct3DRMCreate()
    
    'DIrectDrawClipperとDirect3DRMの関係を関連付けます
    Set m_rmDevice = m_rm.CreateDeviceFromClipper(m_ddClipper, "", m_width, m_height)
    
    'メッシュをどのように表示するかを設定します
    m_rmDevice.SetQuality D3DRMRENDER_GOURAUD
    
End Sub

'フレームの初期設定です
Sub InitScene(sMesh As String)
    
    '//////////
    'フレームの生成
    '//////////
    
    'シーンフレーム、カメラフレーム、
    'ライトフレーム、メッシュ用フレーム
    'の生成をします
    Set m_rootFrame = m_rm.CreateFrame(Nothing)
    Set m_cameraFrame = m_rm.CreateFrame(m_rootFrame)
    Set m_lightFrame = m_rm.CreateFrame(m_rootFrame)
    Set m_objectFrame = m_rm.CreateFrame(m_rootFrame)
    
    
    
    '//////////
    'カメラ
    '//////////
    
    'カメラの位置を設定します(後ろに下がる)
    m_cameraFrame.SetPosition m_rootFrame, 0, 0, -100
    
    'カメラの姿勢を設定します
    m_cameraFrame.SetOrientation m_rootFrame, 0, 0, 1, 0, 1, 0
    
    'Viewportを生成して、
    'カメラフレームが本当にカメラの機能を持つように設定します
    Set m_rmViewport = m_rm.CreateViewport(m_rmDevice, m_cameraFrame, 0, 0, m_width, m_height)
    
    
    
    '//////////
    'ライト
    '//////////
    
    'Lightを生成して、
    'ライトの種類と色(ここでは強さ)を決めます
    Set m_light = m_rm.CreateLight(D3DRMLIGHT_POINT, &HFFFFFFFF)
    
    'ライトの位置を設定します(左上から)
    m_lightFrame.SetPosition m_rootFrame, -100, 100, 0
    
    'ライトの姿勢を設定します
    m_lightFrame.SetOrientation m_rootFrame, 0, 0, 1, 0, 1, 0
    
    '実際にライトの働きをするように設定します
    m_lightFrame.AddLight m_light
    
    
    
    '//////////
    'メッシュ
    '//////////
    
    'MeshBuilderを生成して、
    'Xファイルを読み込みます
    Set m_meshBuilder = m_rm.CreateMeshBuilder
    m_meshBuilder.LoadFromFile sMesh, 0, D3DRMLOAD_FROMFILE, Nothing, Nothing
    
    'MeshBuilderで読み込んだ内容を
    'ObjectFrameに、くっ付けます
    m_objectFrame.AddVisual m_meshBuilder
    
    'ObjectFrameに、回転運動ベクトルを与えます
    m_objectFrame.SetRotation m_rootFrame, 0.3, 1, 0, 0.01
    
End Sub

'Mainループです
Sub RenderLoop()
    Dim t1 As Long, t2 As Long
    Dim delta As Single
    
    On Local Error Resume Next
    
    '初期設定です
    m_running = True
    t1 = g_dx.TickCount()
    
    Do While m_running = True
        
        '時間差を求めます
        t2 = g_dx.TickCount()
        delta = (t2 - t1) / 10
        t1 = t2
        
        '運動ベクトルの動きを再生します
        m_rootFrame.Move delta
        
        'Viewportの描画内容をすべてクリアにします
        m_rmViewport.Clear D3DRMCLEAR_ALL
        
        'Viewportにシーンフレームの内容を描画します
        m_rmViewport.Render m_rootFrame
        
        '実際に描画内容を表示します
        m_rmDevice.Update
        
        'ループの脱出、描画の更新のためのDoEventsです
        DoEvents
        
    Loop
End Sub

'ウィンドウを閉じました
Private Sub Form_Unload(Cancel As Integer)
    
    'すべてのクラスを解放して終了します
    CleanUp
    End
    
End Sub

'他のウィンドウで隠れていた部分が表示されました
Private Sub Picture1_Paint()
    On Local Error Resume Next
    
    'ピクチャボックスのハンドルを更新します
    m_rmDevice.HandlePaint Picture1.hDC
    
End Sub