Form1.frm

 VERSION 5.00
Begin VB.Form Form1
   Caption         =   "CollisionDectection3D by Stéphanie"
   ClientHeight    =   6225
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   11190
   LinkTopic       =   "Form1"
   ScaleHeight     =   415
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   746
   StartUpPosition =   3  'Windows Default
   Begin VB.CheckBox csuc
      Caption         =   "Const. speed up"
      Height          =   255
      Left            =   7560
      TabIndex        =   24
      Top             =   2400
      Width           =   1695
   End
   Begin VB.CommandButton Command5
      Caption         =   "Speed up cube"
      Height          =   495
      Left            =   7560
      TabIndex        =   23
      Top             =   1920
      Width           =   1215
   End
   Begin VB.CommandButton Command4
      Caption         =   "Reset Camera"
      Height          =   495
      Left            =   6240
      TabIndex        =   21
      Top             =   1920
      Width           =   1215
   End
   Begin VB.CheckBox Check1
      Caption         =   "Follow cube"
      Height          =   255
      Left            =   6120
      TabIndex        =   20
      Top             =   2400
      Value           =   1  'Checked
      Width           =   1335
   End
   Begin VB.Frame Frame1
      Caption         =   "Gravity "
      Height          =   1695
      Left            =   6120
      TabIndex        =   3
      Top             =   120
      Width           =   4935
      Begin VB.TextBox Text1
         Height          =   285
         Index           =   3
         Left            =   3960
         TabIndex        =   19
         Text            =   "Text1"
         Top             =   1200
         Width           =   855
      End
      Begin VB.TextBox Text1
         Height          =   285
         Index           =   2
         Left            =   3960
         TabIndex        =   18
         Text            =   "Text1"
         Top             =   840
         Width           =   855
      End
      Begin VB.TextBox Text1
         Height          =   285
         Index           =   1
         Left            =   3960
         TabIndex        =   17
         Text            =   "Text1"
         Top             =   600
         Width           =   855
      End
      Begin VB.TextBox Text1
         Height          =   285
         Index           =   0
         Left            =   3960
         TabIndex        =   16
         Text            =   "Text1"
         Top             =   360
         Width           =   855
      End
      Begin VB.CommandButton Command3
         Caption         =   "0"
         Height          =   255
         Index           =   3
         Left            =   3720
         TabIndex        =   15
         Top             =   1200
         Width           =   255
      End
      Begin VB.CommandButton Command3
         Caption         =   "0"
         Height          =   255
         Index           =   2
         Left            =   3720
         TabIndex        =   14
         Top             =   840
         Width           =   255
      End
      Begin VB.CommandButton Command3
         Caption         =   "0"
         Height          =   255
         Index           =   1
         Left            =   3720
         TabIndex        =   13
         Top             =   600
         Width           =   255
      End
      Begin VB.CommandButton Command3
         Caption         =   "0"
         Height          =   255
         Index           =   0
         Left            =   3720
         TabIndex        =   12
         Top             =   360
         Width           =   255
      End
      Begin VB.HScrollBar Grav_S
         Height          =   255
         Index           =   3
         LargeChange     =   100
         Left            =   480
         Max             =   10000
         Min             =   -10000
         TabIndex        =   10
         Top             =   1200
         Value           =   1000
         Width           =   3255
      End
      Begin VB.HScrollBar Grav_S
         Height          =   255
         Index           =   2
         LargeChange     =   100
         Left            =   480
         Max             =   1000
         Min             =   -1000
         TabIndex        =   8
         Top             =   840
         Width           =   3255
      End
      Begin VB.HScrollBar Grav_S
         Height          =   255
         Index           =   1
         LargeChange     =   100
         Left            =   480
         Max             =   1000
         Min             =   -1000
         TabIndex        =   6
         Top             =   600
         Value           =   -200
         Width           =   3255
      End
      Begin VB.HScrollBar Grav_S
         Height          =   255
         Index           =   0
         LargeChange     =   100
         Left            =   480
         Max             =   1000
         Min             =   -1000
         TabIndex        =   4
         Top             =   360
         Width           =   3255
      End
      Begin VB.Label Label1
         Caption         =   "force:"
         Height          =   255
         Index           =   3
         Left            =   120
         TabIndex        =   11
         Top             =   1200
         Width           =   375
      End
      Begin VB.Label Label1
         Caption         =   "Z:"
         Height          =   255
         Index           =   2
         Left            =   120
         TabIndex        =   9
         Top             =   840
         Width           =   375
      End
      Begin VB.Label Label1
         Caption         =   "Y:"
         Height          =   255
         Index           =   1
         Left            =   120
         TabIndex        =   7
         Top             =   600
         Width           =   375
      End
      Begin VB.Label Label1
         Caption         =   "X:"
         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   5
         Top             =   360
         Width           =   375
      End
   End
   Begin VB.CommandButton Command2
      Caption         =   "reset cube pos."
      Height          =   615
      Left            =   6240
      TabIndex        =   2
      Top             =   2760
      Width           =   1215
   End
   Begin VB.CommandButton Command1
      Caption         =   "quit"
      Height          =   735
      Left            =   6240
      TabIndex        =   1
      Top             =   5400
      Width           =   1815
   End
   Begin VB.PictureBox Picture1
      Height          =   6000
      Left            =   0
      ScaleHeight     =   5940
      ScaleWidth      =   5940
      TabIndex        =   0
      Top             =   0
      Width           =   6000
   End
   Begin VB.Label etat
      Alignment       =   2  'Center
      Caption         =   "Label2"
      Height          =   255
      Left            =   0
      TabIndex        =   22
      Top             =   6000
      Width           =   6015
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim running As Boolean
Dim lasttime As Single

Private Sub Command1_Click()
running = False
End Sub

Private Sub Command2_Click()
initObj
cube(1).Pos = MakeVector(0, 0, 0)
cube(1).Mov = MakeVector(0, 0, 0)
End Sub

Private Sub Command3_Click(Index As Integer)
Grav_S(Index).Value = 0
End Sub

Private Sub Command4_Click()
Dim matview As D3DMATRIX
Call G_dx.ViewMatrix(matview, MakeVector(-90, -90, -90), MakeVector(0, 0, 0), MakeVector(0, 1, 0), 0)
g_d3dDevice.SetTransform D3DTRANSFORMSTATE_VIEW, matview
End Sub

Private Sub Command5_Click()
cube(1).Mov.x = cube(1).Mov.x * 1.1
cube(1).Mov.y = cube(1).Mov.y * 1.1
cube(1).Mov.z = cube(1).Mov.z * 1.1
End Sub

Private Sub Form_Load()
Me.Show
InitDDraw Picture1.hWnd
InitD3D
initObj
running = True
lasttime = Timer
Grav_S_Change 0
Do While running
    Do While (Timer - lasttime) <= 0.01
    Loop
    lasttime = Timer
    Doframe
    DoEvents
Loop
End
End Sub

Private Sub Doframe()
Dim rv As D3DVECTOR
cube(1).Mov.x = cube(1).Mov.x + GravityV.x * GravityP
cube(1).Mov.y = cube(1).Mov.y + GravityV.y * GravityP
cube(1).Mov.z = cube(1).Mov.z + GravityV.z * GravityP
If CollDetec_obj(cube(1).Pos, cube(1).Mov, cube(0), rv) = True Then
    etat.Caption = "Collision!"
Else
    etat.Caption = ""
End If
cube(1).Pos.x = cube(1).Pos.x + cube(1).Mov.x
cube(1).Pos.y = cube(1).Pos.y + cube(1).Mov.y
cube(1).Pos.z = cube(1).Pos.z + cube(1).Mov.z
moveCube cube(1).Mov
If Check1.Value = 1 Then followCube1
If csuc.Value = 1 Then Command5_Click
RenderScene 0
End Sub

Private Sub moveCube(v As D3DVECTOR)
Dim t As Long
For t = 0 To cube(1).VC - 1
    cube(1).v(t).x = cube(1).v(t).x + v.x
    cube(1).v(t).y = cube(1).v(t).y + v.y
    cube(1).v(t).z = cube(1).v(t).z + v.z
Next t
End Sub

Private Sub Form_Unload(Cancel As Integer)
running = False
End Sub

Private Sub Grav_S_Change(Index As Integer)
Dim t As Long
GravityV = MakeVector(Grav_S(0).Value / 1000, Grav_S(1).Value / 1000, Grav_S(2).Value / 1000)
GravityP = Grav_S(3).Value / 1000
For t = 0 To 3
    Text1(t).Text = Grav_S(t).Value / 1000
Next t
End Sub

Private Sub Grav_S_Scroll(Index As Integer)
Grav_S_Change Index
End Sub

Private Sub followCube1()
Dim matview As D3DMATRIX
Call G_dx.ViewMatrix(matview, MakeVector(-90, -90, -90), cube(1).Pos, MakeVector(0, 1, 0), 0)
g_d3dDevice.SetTransform D3DTRANSFORMSTATE_VIEW, matview
End Sub

Project Homepage: