Learn 3D Graphics Programming on the PC/Learn_3D_Graphics_Programming_on_the_PC_Ferraro.iso/rwwin/rwvbview.fr_/rwvbview.bin

Visual Basic Form | 1995-11-14 | 14.2 KB | 397 lines

VERSION 2.00
Begin Form Form1
   Caption         =   "RenderWare VB Object Viewer"
   ClientHeight    =   3648
   ClientLeft      =   876
   ClientTop       =   1464
   ClientWidth     =   4104
   Height          =   4200
   Icon            =   RWVBVIEW.FRX:0000
   Left            =   828
   LinkTopic       =   "Form1"
   ScaleHeight     =   3648
   ScaleWidth      =   4104
   Top             =   960
   Width           =   4200
   Begin Timer tmrAnimate
      Interval        =   20
      Left            =   720
      Top             =   120
   End
   Begin CommonDialog OpenFileDlg
      DialogTitle     =   "Load Script or Picture into Scene"
      Filter          =   "Script file (*.rwx) | *.rwx | Picture file (*.ras;*.bmp) | *.ras;*.bmp"
      Left            =   120
      Top             =   120
   End
   Begin Menu File
      Caption         =   "&File"
      Begin Menu Open
         Caption         =   "&Open..."
      End
      Begin Menu Exit
         Caption         =   "E&xit"
      End
   End
   Begin Menu Help
      Caption         =   "&Help"
      Begin Menu About
         Caption         =   "&About"
      End
   End
Const SHIFT_MASK = 1
Const CTRL_MASK = 2
Const ALT_MASK = 4
Const LEFT_BUTTON = 1
Const RIGHT_BUTTON = 2
Const MIDDLE_BUTTON = 4
Dim Scene As Long
Dim Camera As Long
Dim CameraTilt As Single
Dim CameraDistance As Single
Dim Light As Long
Dim SpinMatrix As Long
Dim LastX As Integer
Dim LastY As Integer
Dim AnimMode As Integer
Dim FrameNumber As Integer
Const ANoAction = 0
Const ASpinClump = 1
Dim PickedClump As Long
Dim MouseMoveMode As Integer
Const MMNoAction = 0
Const MMDragClump = 1
Const MMDragClumpInZ = 2
Const MMPanLight = 3
Const MMPanAndZoomCamera = 4
Const MMScrollBackdrop = 5
Const MMSpinClump = 6
Const MMTiltCamera = 7
Sub About_Click ()
    frmAbout.Show 1
End Sub
Sub Exit_Click ()
    Unload Me
End Sub
Sub Form_Load ()
    Dim VRet As Variant
    CameraTilt = 0
    CameraDistance = -7
    FrameNumber = 0
    If RwOpen("MSWindows", 0) = 0 Then
        If RwGetError() = E_RW_NOMEM Then
            MsgBox "Insufficient memory to open the RenderWare(tm) library", MB_OK
        Else
            MsgBox "Error opening the RenderWare(tm) library", MB_OK
        End If
        End
    End If
    Camera = RwCreateCamera(1024, 768, 0)
    If Camera = 0 Then
        If RwGetError() = E_RW_NOMEM Then
            MsgBox "Insufficient memory to create the RenderWare(tm) camera", MB_OK
        Else
            MsgBox "Error creating the RenderWare(tm) camera", MB_OK
        End If
        RwClose
        End
    End If
    VRet = RwSetCameraBackColor(Camera, 0, 0, 1)
    VRet = RwTiltCamera(Camera, CameraTilt)
    VRet = RwVCMoveCamera(Camera, 0, 0, CameraDistance)
    VRet = RwSetCameraViewwindow(Camera, .2, .2)
    Scene = RwCreateScene()
    If Scene = 0 Then
        VRet = RwDestroyCamera(Camera)
        RwClose
        MsgBox "Error creating the RenderWare(tm) scene", MB_OK
        End
    End If
    Light = RwCreateLight(rwDIRECTIONAL, -1, -1, -1, 1)
    If Light = 0 Then
        VRet = RwDestroyScene(Scene)
        VRet = RwDestroyCamera(Camera)
        RwClose
        MsgBox "Error creating the RenderWare(tm) light", MB_OK
        End
    End If
    VRet = RwAddLightToScene(Scene, Light)
    SpinMatrix = RwCreateMatrix()
    If SpinMatrix = 0 Then
        VRet = RwDestroyScene(Scene)
        VRet = RwDestroyCamera(Camera)
        RwClose
        MsgBox "Error creating the RenderWare(tm) matrix", MB_OK
        End
    End If
End Sub
Sub Form_MouseDown (Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim Pick As RwPickRecord
    Dim VRet As Variant
    x = x / Screen.TwipsPerPixelX
    y = y / Screen.TwipsPerPixelY
    If (Button And LEFT_BUTTON) <> 0 Then
        If RwPickScene(Scene, x, y, Camera, Pick) <> 0 Then
            Select Case Pick.type
            Case rwNAPICKOBJECT
                AnimMode = ANoAction
                PickedClump = 0
                If RwGetCameraBackdrop(Camera) <> 0 Then
                    If (Shift And (SHIFT_MASK Or CTRL_MASK)) = (SHIFT_MASK Or CTRL_MASK) Then
                        VRet = RwDestroyRaster(RwGetCameraBackdrop(Camera))
                        VRet = RwSetCameraBackdrop(Camera, 0)
                        RenderScene hWnd, hDC
                        MouseMoveMode = MMNoAction
                    Else
                        MouseMoveMode = MMScrollBackdrop
                    End If
                Else
                    MouseMoveMode = MMNoAction
                End If
            Case rwPICKEDCLUMP
                If (Shift And (SHIFT_MASK Or CTRL_MASK)) = (SHIFT_MASK Or CTRL_MASK) Then
                    VRet = RwDestroyClump(Pick.Object.clump.clump)
                    RenderScene hWnd, hDC
                    MouseMoveMode = MMNoAction
                    PickedClump = 0
                Else
                    PickedClump = Pick.Object.clump.clump
                    If (Shift And SHIFT_MASK) <> 0 Then
                        MouseMoveMode = MMDragClump
                    ElseIf (Shift And CTRL_MASK) <> 0 Then
                        MouseMoveMode = MMDragClumpInZ
                    Else
                        MouseMoveMode = MMSpinClump
                    End If
                End If
            End Select
        End If
    ElseIf (Button And RIGHT_BUTTON) <> 0 Then
        If (Shift And CTRL_MASK) <> 0 Then
            MouseMoveMode = MMPanLight
        ElseIf (Shift And SHIFT_MASK) <> 0 Then
            MouseMoveMode = MMTiltCamera
        Else
            MouseMoveMode = MMPanAndZoomCamera
        End If
    End If
    If MouseMoveMode <> MMNoAction Then
        LastX = x
        LastY = y
    End If
End Sub
Sub Form_MouseMove (Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim Parent As Long
    Dim tmpMatrix As Long
    Dim worldToLocal As Long
    Dim Up As RwV3d
    Dim Rght As RwV3d
    Dim At As RwV3d
    Dim xDelta As Single
    Dim yDelta As Single
    Dim xAngle As Single
    Dim yAngle As Single
    Dim ZoomDelta As Single
    Dim xOffset As Long
    Dim yOffset As Long
    Dim VRet As Variant
    x = x / Screen.TwipsPerPixelX
    y = y / Screen.TwipsPerPixelY
    Select Case MouseMoveMode
    Case MMScrollBackdrop
        VRet = RwGetCameraBackdropOffset(Camera, xOffset, yOffset)
        xOffset = xOffset + LastX - x
        yOffset = yOffset + LastY - y
        VRet = RwSetCameraBackdropOffset(Camera, xOffset, yOffset)
    Case MMPanAndZoomCamera
        VRet = RwVCMoveCamera(Camera, 0, 0, -CameraDistance)
        VRet = RwTiltCamera(Camera, -CameraTilt)
        VRet = RwPanCamera(Camera, LastX - x)
        CameraDistance = CameraDistance + (LastY - y) / 10
        VRet = RwTiltCamera(Camera, CameraTilt)
        VRet = RwVCMoveCamera(Camera, 0, 0, CameraDistance)
    Case MMTiltCamera
        VRet = RwVCMoveCamera(Camera, 0, 0, -CameraDistance)
        VRet = RwTiltCamera(Camera, -CameraTilt)
        CameraTilt = CameraTilt + LastY - y
        VRet = RwTiltCamera(Camera, CameraTilt)
        VRet = RwVCMoveCamera(Camera, 0, 0, CameraDistance)
    Case MMSpinClump
        yAngle = x - LastX
        xAngle = y - LastY
        VRet = RwGetCameraLookUp(Camera, Up)
        VRet = RwGetCameraLookRight(Camera, Rght)
        Parent = RwGetClumpParent(PickedClump)
        If Parent <> 0 Then
            tmpMatrix = RwPushScratchMatrix()
            worldToLocal = RwPushScratchMatrix()
            VRet = RwGetClumpLTM(Parent, tmpMatrix)
            VRet = RwInvertMatrix(tmpMatrix, worldToLocal)
            VRet = RwTransformVector(Up, worldToLocal)
            VRet = RwNormalize(Up)
            VRet = RwTransformVector(Rght, worldToLocal)
            VRet = RwNormalize(Rght)
            VRet = RwPopScratchMatrix()
            VRet = RwPopScratchMatrix()
        End If
        VRet = RwRotateMatrix(SpinMatrix, Up.x, Up.y, Up.z, yAngle, rwREPLACE)
        VRet = RwRotateMatrix(SpinMatrix, Rght.x, Rght.y, Rght.z, xAngle, rwPOSTCONCAT)
        VRet = RwTransformClumpJoint(PickedClump, SpinMatrix, rwPOSTCONCAT)
        AnimMode = ASpinClump
    Case MMDragClump
        VRet = RwPushScratchMatrix()
        xDelta = (x - LastX) / 50
        yDelta = (LastY - y) / 50
        VRet = RwGetCameraLookRight(Camera, Rght)
        VRet = RwGetCameraLookUp(Camera, Up)
        Parent = RwGetClumpParent(PickedClump)
        If Parent <> 0 Then
            tmpMatrix = RwPushScratchMatrix()
            worldToLocal = RwPushScratchMatrix()
            VRet = RwGetClumpLTM(Parent, tmpMatrix)
            VRet = RwInvertMatrix(tmpMatrix, worldToLocal)
            VRet = RwTransformVector(Up, worldToLocal)
            VRet = RwNormalize(Up)
            VRet = RwTransformVector(Rght, worldToLocal)
            VRet = RwNormalize(Rght)
            VRet = RwPopScratchMatrix()
            VRet = RwPopScratchMatrix()
        End If
        VRet = RwTranslateMatrix(RwScratchMatrix(), Rght.x * xDelta, Rght.y * xDelta, Rght.z * xDelta, rwREPLACE)
        VRet = RwTranslateMatrix(RwScratchMatrix(), Up.x * yDelta, Up.y * yDelta, Up.z * yDelta, rwPOSTCONCAT)
        VRet = RwTransformClump(PickedClump, RwScratchMatrix(), rwPOSTCONCAT)
        VRet = RwPopScratchMatrix()

    Case MMDragClumpInZ
        VRet = RwPushScratchMatrix()
        yDelta = (LastY - y) / 50
        VRet = RwGetCameraLookAt(Camera, At)
        Parent = RwGetClumpParent(PickedClump)
        If Parent <> 0 Then
            tmpMatrix = RwPushScratchMatrix()
            worldToLocal = RwPushScratchMatrix()
            VRet = RwGetClumpLTM(Parent, tmpMatrix)
            VRet = RwInvertMatrix(tmpMatrix, worldToLocal)
            VRet = RwTransformVector(At, worldToLocal)
            VRet = RwNormalize(At)
            VRet = RwPopScratchMatrix()
            VRet = RwPopScratchMatrix()
        End If
        VRet = RwTranslateMatrix(RwScratchMatrix(), At.x * yDelta, At.y * yDelta, At.z * yDelta, rwREPLACE)
        VRet = RwTransformClump(PickedClump, RwScratchMatrix(), rwPOSTCONCAT)
        VRet = RwPopScratchMatrix()

    Case MMPanLight
        Dim scratch As Long
        VRet = RwPushScratchMatrix()
        scratch = RwScratchMatrix()
        VRet = RwRotateMatrix(scratch, 0, 1, 0, LastX - x, rwREPLACE)
        VRet = RwRotateMatrix(scratch, 1, 0, 0, LastY - y, rwPOSTCONCAT)
        VRet = RwTransformLight(Light, scratch, rwPOSTCONCAT)
        VRet = RwPopScratchMatrix()
    End Select
    If MouseMoveMode <> MMNoAction Then
        RenderScene hWnd, hDC
        LastX = x
        LastY = y
    End If
End Sub
Sub Form_MouseUp (Button As Integer, Shift As Integer, x As Single, y As Single)
    MouseMoveMode = MMNoAction
End Sub
Sub Form_Paint ()
    Dim VRet As Variant
    VRet = RwInvalidateCameraViewport(Camera)
    VRet = RwShowCameraImage(Camera, hDC)
End Sub
Sub Form_Resize ()
    Dim VRet As Variant
    Dim IRet As Integer
    Dim ScreenWidth As Integer
    Dim ScreenHeight As Integer
    ScreenWidth = Width / Screen.TwipsPerPixelX
    ScreenHeight = Height / Screen.TwipsPerPixelY
    VRet = RwSetCameraViewport(Camera, 0, 0, ScreenWidth, ScreenHeight)
    VRet = RwSetCameraBackdropViewportRect(Camera, 0, 0, ScreenWidth, ScreenHeight)
    RenderScene hWnd, hDC
End Sub
Sub Form_Unload (Cancel As Integer)
    Dim VRet As Variant
    Dim Raster As Long
    VRet = RwDestroyMatrix(SpinMatrix)
    VRet = RwDestroyScene(Scene)
    Raster = RwGetCameraBackdrop(Camera)
    If Raster Then
        VRet = RwDestroyRaster(Raster)
        VRet = RwSetCameraBackdrop(Camera, 0)
    End If
    VRet = RwDestroyCamera(Camera)
    RwClose
End Sub
Sub Open_Click ()
    Dim clump As Long
    Dim Raster As Long
    Dim Extension As String
    Dim Filename As String
    Dim VRet As Long
    OpenFileDlg.Action = 1
    Filename = OpenFileDlg.Filename
    Extension = Right$(Filename, Len(Filename) - InStr(Filename, "."))
    If Extension = "BMP" Or Extension = "RAS" Then
        Raster = RwReadRaster(Filename, rwGAMMARASTER Or rwDITHERRASTER)
        If Raster <> 0 Then
            If RwGetCameraBackdrop(Camera) <> 0 Then
                VRet = RwDestroyRaster(RwGetCameraBackdrop(Camera))
            End If
            VRet = RwSetCameraBackdrop(Camera, Raster)
            VRet = RwSetCameraBackdropOffset(Camera, 0, 0)
            RenderScene hWnd, hDC
        Else
            ReportFileError Filename
        End If
    ElseIf Extension = "RWX" Then
        clump = RwReadShape(Filename)
        If clump <> 0 Then
            VRet = RwAddClumpToScene(Scene, clump)
            RenderScene hWnd, hDC
        Else
            ReportFileError Filename
        End If
    End If
End Sub
Sub RenderScene (ByVal hWnd As Integer, ByVal hDC As Integer)
    Dim VRet As Long
    VRet = RwBeginCameraUpdate(Camera, hWnd)
    VRet = RwClearCameraViewport(Camera)
    VRet = RwRenderScene(Scene)
    VRet = RwEndCameraUpdate(Camera)
    VRet = RwShowCameraImage(Camera, hDC)
End Sub
Sub ReportFileError (Filename As String)
    Select Case RwGetError()
    Case E_RW_NOMEM
        MsgBox "Insufficient memory to load file " + Filename, MB_OK
    Case Else
        MsgBox "Error reading file " + Filename, MB_OK
    End Select
End Sub
Sub tmrAnimate_Timer ()
    Dim VRet As Variant
    If PickedClump <> 0 And AnimMode <> ANoAction And MouseMoveMode <> MMSpinClump Then
        Select Case AnimMode
        Case ASpinClump:
            VRet = RwTransformClumpJoint(PickedClump, SpinMatrix, rwPOSTCONCAT)
            FrameNumber = FrameNumber + 1
            If FrameNumber >= 128 Then
                FrameNumber = 0
                VRet = RwPushScratchMatrix()
                VRet = RwGetClumpJointMatrix(PickedClump, RwScratchMatrix())
                VRet = RwOrthoNormalizeMatrix(RwScratchMatrix(), RwScratchMatrix())
                VRet = RwTransformClumpJoint(PickedClump, RwScratchMatrix(), rwREPLACE)
                VRet = RwPopScratchMatrix()
            End If
            RenderScene hWnd, hDC
        End Select
    End If
End Sub