frmludovel5.frm

用VB开发的与跑跑卡丁车一模一样的赛车游戏

Set Boingsnd3D = Nothing
Set Beepsnd = Nothing
Set Beepsnd3D = Nothing
Set Hit1snd = Nothing
Set Hit1snd3D = Nothing
Set Hit2snd = Nothing
Set Hit2snd3D = Nothing
Set Bonussnd = Nothing
Set Bonussnd3D = Nothing
    
Set RM_E = Nothing
Set mat = Nothing
    
Set DINPUT = Nothing
Set DIdevice = Nothing

ShowCursor 1

End

End Sub
Private Function GetDistance(X1 As Single, Y1 As Single, X2 As Single, Y2 As Single) As Single
    'calculates the distance between two points
    GetDistance = Sqr((X1 - X2) ^ 2 + (Y1 - Y2) ^ 2)
End Function

Private Sub RacersAI(ind As Integer)
    Dim AbsoluteAngle   As Single
    Dim RelativeAngle   As Single
    Dim NextNode        As Integer
    Dim distance        As Integer
    NextNode = Racers(ind).NextNode  'we could reference this via the object/udt but its neater like this
    
'## Check for Node Collisions
    distance = GetDistance(Racers(ind).Location_X, Racers(ind).Location_Z, Nodes(NextNode).Location_X, Nodes(NextNode).Location_Y)
    If distance < Racers(ind).Radius + NodeRadius Then
        If Nodes(NextNode).Dir = "+" Then
           m_objectFrame(ind + 1).AddRotation D3DRMCOMBINE_BEFORE, 0, 1, 0, 90 * (pi / 180)
        ElseIf Nodes(NextNode).Dir = "-" Then
           m_objectFrame(ind + 1).AddRotation D3DRMCOMBINE_BEFORE, 0, 1, 0, -90 * (pi / 180)
        End If
        NextNode = NextNode + 1
        
        If NextNode > UBound(Nodes) Then
           NextNode = 1
           Lastnodes = True
        End If
        Racers(ind).NextNode = NextNode
    End If

'## Calculate Direction
    AbsoluteAngle = FindAngle(Racers(ind).Location_X, Racers(ind).Location_Z, Nodes(NextNode).Location_X, Nodes(NextNode).Location_Y)
    
    'We now have the angle from us to our next node
    'we're going to re-orient it so its a relative angle
    CheckAngle Racers(ind).Direction
    CheckAngle AbsoluteAngle
    RelativeAngle = AbsoluteAngle - Racers(ind).Direction
    CheckAngle RelativeAngle
    If RelativeAngle > 0 Then
        Racers(ind).Direction = Racers(ind).Direction + Racers(ind).TurnRatio
    Else
        Racers(ind).Direction = Racers(ind).Direction - Racers(ind).TurnRatio
    End If



'## Calculate Speed
    'work out our turning circle
    If RelativeAngle > 0 Then
        ProjectCircle CircleX, CircleY, CircleRadius, True, ind  'the first 3 params are where the data is returned to after
    Else
        ProjectCircle CircleX, CircleY, CircleRadius, False, ind 'the sub executes.
    End If
    'check if the node is within our turning circle
    'ie if we dont slow down we'll miss it cause we cant turn enough
    distance = GetDistance(CircleX, CircleY, Nodes(NextNode).Location_X, Nodes(NextNode).Location_Y)
    If distance < CircleRadius Then
        Racers(ind).Speed = Racers(ind).Speed - Racers(ind).BrakeSpeed
        If Racers(ind).Speed < Racers(ind).MinSpeed Then Racers(ind).Speed = Racers(ind).MinSpeed
    ElseIf Abs(RelativeAngle) > Racers(ind).BackAngle Then
    'Check if node is behind us and slow down if it is
        Racers(ind).Speed = Racers(ind).Speed - Racers(ind).BrakeSpeed
        If Racers(ind).Speed < Racers(ind).MinSpeed Then Racers(ind).Speed = Racers(ind).MinSpeed
    Else 'we are a race car, we should speed up if we can
        Racers(ind).Speed = Racers(ind).Speed + Racers(ind).Acceleration
        If Racers(ind).Speed > Racers(ind).MaxSpeed Then Racers(ind).Speed = Racers(ind).MaxSpeed
    End If
    
    If Lastnodes = True And GetDistance(Racers(ind).Location_X, Racers(ind).Location_Z, Nodes(UBound(Nodes)).Location_X, Nodes(UBound(Nodes)).Location_Y) < 60 Then
       Racers(ind).Lap = Racers(ind).Lap + 1
       Racers(ind).time = Format(CStr(Timemin), "00") + Format(CStr(Timesec), "00")
       Racers(ind).Position = cont
       Lastnodes = False
       
       Racerspos(ind) = cont
       cont = cont + 1
       If cont > 10 Then cont = 1
    End If

End Sub

Private Sub CheckAngle(ByRef Dir As Single)
    'simply ensures that a direction is within a range of -1*Pi to +1*Pi
    While Dir > pi Or Dir < -pi
        If Dir > pi Then Dir = Dir - 2 * pi
        If Dir < -pi Then Dir = Dir + 2 * pi
    Wend
End Sub

Private Sub MoveRacers(ind As Integer)
Dim i As Integer, distance As Integer
'Simple collision through the racers (could be implemented)
For i = 1 To UBound(Racers)
    If i <> ind Then
       distance = GetDistance(Racers(ind).Location_X, Racers(ind).Location_Z, Racers(i).Location_X, Racers(i).Location_Z)
       If distance < Racers(ind).Radius + Racers(i).Radius Then
             Racers(ind).Speed = -Racers(ind).Speed
             Racers(i).Speed = -Racers(i).Speed
'             Hit1snd3D.SetPosition Racers(ind).Location_X, 1, Racers(ind).Location_Z, DS3D_IMMEDIATE
'             Hit1snd.Play DSBPLAY_DEFAULT
'             Hit2snd3D.SetPosition Racers(i).Location_X, 1, Racers(i).Location_Z, DS3D_IMMEDIATE
'             Hit2snd.Play DSBPLAY_DEFAULT
       End If
   End If
Next

'Position the racers
Racers(ind).Location_X = Racers(ind).Location_X + Racers(ind).Speed * Sin(Racers(ind).Direction)
Racers(ind).Location_Z = Racers(ind).Location_Z - Racers(ind).Speed * Cos(Racers(ind).Direction)
m_objectFrame(ind + 1).SetPosition Nothing, Racers(ind).Location_X, 1, Racers(ind).Location_Z
'Driversnd3D(ind).SetPosition Racers(ind).Location_X, 1, Racers(ind).Location_Z, DS3D_IMMEDIATE
'Driversnd(ind).Play DSBPLAY_DEFAULT

End Sub

Private Sub ProjectCircle(rtnOriginX As Single, rtnOriginY As Single, rtnRadius As Single, TurnLeft As Boolean, ind As Integer)
'We calculate out the minimum circle we can turn at our current speed
'NOTE: I could not have done this bit so efficiently without the help of a great guy called Brykovian
    
    Dim VelocityX1  As Single
    Dim VelocityY1  As Single
    Dim VelocityX2  As Single
    Dim VelocityY2  As Single
    Dim AccelX      As Single
    Dim AccelY      As Single
    Dim AccelTot    As Single
    Dim Radius      As Single
    Dim OriginX     As Single
    Dim OriginY     As Single
    Dim t           As Integer
    Const NumTicks = 10
    DummyRacers(ind) = Racers(ind)
    
    'First we must calculate the seperate X & Y velocities
    'We project the motion of the racers for a few ticks to get more accuracy
    For t = 1 To NumTicks
        If TurnLeft Then
            DummyRacers(ind).Direction = DummyRacers(ind).Direction + DummyRacers(ind).TurnRatio
        Else 'Turn Right
            DummyRacers(ind).Direction = DummyRacers(ind).Direction - DummyRacers(ind).TurnRatio
        End If
        DummyRacers(ind).Location_X = DummyRacers(ind).Location_X + DummyRacers(ind).Speed * Sin(DummyRacers(ind).Direction)
        DummyRacers(ind).Location_Z = DummyRacers(ind).Location_Z - DummyRacers(ind).Speed * Cos(DummyRacers(ind).Direction)
    Next t
    VelocityX1 = Sin(Racers(ind).Direction) * Racers(ind).Speed
    VelocityY1 = Cos(Racers(ind).Direction) * Racers(ind).Speed
    VelocityX2 = Sin(DummyRacers(ind).Direction) * DummyRacers(ind).Speed
    VelocityY2 = Cos(DummyRacers(ind).Direction) * DummyRacers(ind).Speed

    'Now we calculate the acceleration towards the center of the circle
    AccelX = (VelocityX2 - VelocityX1) / NumTicks
    AccelY = (VelocityY2 - VelocityY1) / NumTicks
    AccelTot = Sqr(AccelX * AccelX + AccelY * AccelY)

    'Finally we can work out the radius of our circle using
    'On Error GoTo OverFlowHandler
    If Radius > 0 Then
       Radius = (Racers(ind).Speed * Racers(ind).Speed) / AccelTot
    Else
       Radius = 0
    End If
    'On Error GoTo 0

    'now it just remains of cource to calculate the origin of our circle
    If TurnLeft Then
        OriginX = Racers(ind).Location_X + Radius * Sin(Racers(ind).Direction + pi / 2)
        OriginY = Racers(ind).Location_Z - Radius * Cos(Racers(ind).Direction + pi / 2)
    Else 'Turn Right
        OriginX = Racers(ind).Location_X + Radius * Sin(Racers(ind).Direction - pi / 2)
        OriginY = Racers(ind).Location_Z - Radius * Cos(Racers(ind).Direction - pi / 2)
    End If

    'And now really finally we pass the results back
    rtnOriginX = OriginX
    rtnOriginY = OriginY
    rtnRadius = Radius
    Exit Sub
OverFlowHandler:
'   When/If the car slows to exactly 0 we get an overflow error
    Radius = 0
    Resume Next
End Sub

Private Function FindAngle(X1 As Single, Y1 As Single, X2 As Single, Y2 As Single) As Single
    Dim sngXComp As Single
    Dim sngYComp As Single

    'Find the angle between the 2 coords
    sngXComp = X2 - X1
    sngYComp = Y1 - Y2
    If Sgn(sngYComp) > 0 Then FindAngle = Atn(sngXComp / sngYComp)
    If Sgn(sngYComp) < 0 Then FindAngle = Atn(sngXComp / sngYComp) + pi
End Function
Private Sub Tmr_time_Timer()
Numdown = 5
Timesec = Timesec + 1
If Timesec > 59 Then
   Timesec = 0
   Timemin = Timemin + 1
End If
End Sub
Private Sub InitSounds()
Dim i As Byte

    RMC.InitDsound70
    
    'Player car sound
    Set Playersnd = RMC.Create2DsBuffromfile70(App.path & "\Audio\engine1.wav")
    Set Playersnd3D = RMC.Create3DSBUFfrom2Dbuf70(Playersnd)
    Playersnd3D.SetMinDistance 1 * TCase, DS3D_IMMEDIATE
    Playersnd3D.SetMaxDistance 2 * TCase, DS3D_IMMEDIATE
   
    'Drivers car sound
    For i = 1 To UBound(Racers)
        If i Mod 2 = 0 Then
           Set Driversnd(i) = RMC.Create2DsBuffromfile70(App.path & "\Audio\engine1.wav")
           Set Driversnd3D(i) = RMC.Create3DSBUFfrom2Dbuf70(Driversnd(i))
           Driversnd3D(i).SetMinDistance 1 * TCase, DS3D_IMMEDIATE
           Driversnd3D(i).SetMaxDistance 3 * TCase, DS3D_IMMEDIATE
        Else
           Set Driversnd(i) = RMC.Create2DsBuffromfile70(App.path & "\Audio\engine1.wav")
           Set Driversnd3D(i) = RMC.Create3DSBUFfrom2Dbuf70(Driversnd(i))
           Driversnd3D(i).SetMinDistance 1 * TCase, DS3D_IMMEDIATE
           Driversnd3D(i).SetMaxDistance 3 * TCase, DS3D_IMMEDIATE
        End If
    Next
    
    'Trumpet
    Set Beepsnd = RMC.Create2DsBuffromfile70(App.path & "\Audio\Beep.wav")
    Set Beepsnd3D = RMC.Create3DSBUFfrom2Dbuf70(Beepsnd)
    Beepsnd3D.SetMinDistance 10, DS3D_IMMEDIATE
    Beepsnd3D.SetMaxDistance 20, DS3D_IMMEDIATE
    
    'Collision with walls sound
    Set Boingsnd = RMC.Create2DsBuffromfile70(App.path & "\Audio\Boing.wav")
    Set Boingsnd3D = RMC.Create3DSBUFfrom2Dbuf70(Boingsnd)
    Boingsnd3D.SetMinDistance 1, DS3D_IMMEDIATE
    Boingsnd3D.SetMaxDistance 1, DS3D_IMMEDIATE
    
    'Collision with drivers
    Set Hit1snd = RMC.Create2DsBuffromfile70(App.path & "\Audio\Hit1.wav")
    Set Hit1snd3D = RMC.Create3DSBUFfrom2Dbuf70(Hit1snd)
    Hit1snd3D.SetMinDistance 10, DS3D_IMMEDIATE
    Hit1snd3D.SetMaxDistance 20, DS3D_IMMEDIATE
    
    'Collision between racers
    Set Hit2snd = RMC.Create2DsBuffromfile70(App.path & "\Audio\Hit2.wav")
    Set Hit2snd3D = RMC.Create3DSBUFfrom2Dbuf70(Hit2snd)
    Hit2snd3D.SetMinDistance 5, DS3D_IMMEDIATE
    Hit2snd3D.SetMaxDistance 10, DS3D_IMMEDIATE
    
    'Pick bonus
    Set Bonussnd = RMC.Create2DsBuffromfile70(App.path & "\Audio\Bonus.wav")
    Set Bonussnd3D = RMC.Create3DSBUFfrom2Dbuf70(Bonussnd)
    Bonussnd3D.SetMinDistance 1, DS3D_IMMEDIATE
    Bonussnd3D.SetMaxDistance 1, DS3D_IMMEDIATE

End Sub
Sub doTargets()
'For other maps these point have to stay in a file
'they are good only for this demo map
ReDim Targets(9)
Targets(1).Location_X = 23 * TCase
Targets(1).Location_Z = 7 * TCase
Targets(1).Pass = False
Targets(1).Size = 60
Targets(2).Location_X = 28 * TCase
Targets(2).Location_Z = 14 * TCase
Targets(2).Pass = False
Targets(2).Size = 60
Targets(3).Location_X = 43 * TCase
Targets(3).Location_Z = 8 * TCase
Targets(3).Pass = False
Targets(3).Size = 60
Targets(4).Location_X = 49 * TCase
Targets(4).Location_Z = 15 * TCase
Targets(4).Pass = False
Targets(4).Size = 60
Targets(5).Location_X = 41 * TCase
Targets(5).Location_Z = 37 * TCase
Targets(5).Pass = False
Targets(5).Size = 60
Targets(6).Location_X = 29 * TCase
Targets(6).Location_Z = 46 * TCase
Targets(6).Pass = False
Targets(6).Size = 60
Targets(7).Location_X = 12 * TCase
Targets(7).Location_Z = 37 * TCase
Targets(7).Pass = False
Targets(7).Size = 60
Targets(8).Location_X = 3 * TCase
Targets(8).Location_Z = 5 * TCase
Targets(8).Pass = False
Targets(8).Size = 60
Targets(9).Location_X = 8 * TCase
Targets(9).Location_Z = 2 * TCase
Targets(9).Pass = False
Targets(9).Size = 60
TargetsCount = 9
End Sub
Sub Finish()
   Tmr_time.Enabled = False
   If Velocity > 0 Then Velocity = Velocity - 0.5
   If Velocity < 0 Then Velocity = 0
   D3Pos.x = D3Pos.x + Cos(Heading) * Velocity
   D3Pos.y = D3Pos.y
   D3Pos.z = D3Pos.z + Sin(Heading) * Velocity
   If dview < 50 Then dview = dview + 0.5
   If oview > -50 Then oview = oview - 0.5
   If hview < 20 Then hview = hview + 0.05
   m_objectFrame(1).SetPosition Nothing, D3Pos.x, D3Pos.y, D3Pos.z
   ombreFrame.SetPosition m_objectFrame(1), 0, -1.95, 0
   RMC.CameraFrame.SetPosition m_objectFrame(1), oview, hview, dview
   RMC.CameraFrame.LookAt m_objectFrame(1), Nothing, D3DRMCONSTRAIN_Z
End Sub