frmludovel5.frm

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

       Else 'let's move the racers
          If Lap < 4 Then
             MovePlayer
          Else
             Finish
          End If
          For ind = 1 To UBound(Racers)
              If Racers(ind).Lap < 4 Then
                 RacersAI (ind)
              Else
                 If Racers(ind).Speed > 0 Then Racers(ind).Speed = Racers(ind).Speed - 1
                 If Racers(ind).Speed < 0 Then Racers(ind).Speed = 0
              End If
              MoveRacers (ind)
          Next ind
       End If
       'Render
       RMC.Render
       'Loop Music
       Call Music_mod.LoopMusic
       
       If fine = True Then Cleanup
       
       DoEvents
    
    Loop
End Sub
Private Sub MovePlayer()
Dim i As Integer, distance As Integer
    
'       DIdevice.Acquire
'       DIdevice.GetDeviceStateKeyboard keyb
       
       m_objectFrame(1).GetPosition Nothing, D3Pos
       m_objectFrame(1).GetOrientation Nothing, D3Ori, D3Nor
        
       nvel = 0
       
       If avanti = False And indietro = False Then
          'Velocity = Velocity - 0.05
           If Velocity > 0 Then Velocity = Velocity - 0.1
           If Velocity < 0 Then Velocity = Velocity + 0.1
           MaxVel = 6
       End If
        
        'Move forward
        If avanti = True Then
           Velocity = Velocity + 0.5
           nvel = 1
'           Playersnd.Play DSBPLAY_DEFAULT
        End If
        
        'Move back
        If indietro = True Then
           Velocity = Velocity - 0.5
           MaxVel = 6
           nvel = -1
'           Playersnd.Play DSBPLAY_DEFAULT
        End If
        
        'Rotate left
        If sinistra = True Then
           I_nBanking = I_nBanking + 0.01
        End If

        'Rotate right
        If destra = True Then
           I_nBanking = I_nBanking - 0.01
        End If
        
        Heading = Heading + I_nBanking * 0.5
        ' Banking dekeys
        I_nBanking = I_nBanking * 0.95
     
        ' Reset colission
        L_bColliding = False
                    
        ' Prepare ray
        RMC.dx.VectorCopy D3Ray.pos, D3Pos
        D3Ray.Dir.x = D3Ori.x
        D3Ray.Dir.y = 0
        D3Ray.Dir.z = D3Ori.z
        If dview > -25 Then dview = dview - 1
        
        For xx = 0 To MapSizeX - 1
           For yy = 0 To MapSizeY - 1
                    
                    ' Cast ray
                    Set L_oD3PDA = ViewFrame(xx, yy).RayPick(Nothing, D3Ray, D3DRMRAYPICK_IGNOREFURTHERPRIMITIVES)
                    ' Retrieve results
                    If Not (L_oD3PDA.GetSize = 0) Then
                       If L_oD3PDA.GetPickFrame(0, D3PD).GetSize > 0 Then
                          Set L_oD3Visual = L_oD3PDA.GetPickVisual(0, D3PD)
                          RMC.dx.VectorSubtract D3Tmp, D3Ray.pos, D3PD.vPostion
                          L_bColliding = (RMC.dx.VectorModulus(D3Tmp) <= 15)
                          If L_bColliding Then
                             Boingsnd3D.SetPosition D3Pos.x, D3Pos.y, D3Pos.z, DS3D_IMMEDIATE
                             Boingsnd.Play DSBPLAY_DEFAULT
                             Velocity = -Velocity '/ 2
                             MaxVel = 6
                             If dview < -20 Then dview = dview + 2 Else dview = -20
                          End If
                       End If
                    End If
           
           Next
        Next
       
        If Velocity > MaxVel Then Velocity = MaxVel
        If Velocity < -5 Then Velocity = -5
        
        D3Pos.x = D3Pos.x + Cos(Heading) * Velocity
        D3Pos.y = D3Pos.y
        D3Pos.z = D3Pos.z + Sin(Heading) * Velocity
                                
        ' Calculate Orientation
        D3Ori.x = Cos(Heading)
        D3Ori.y = 0
        D3Ori.z = Sin(Heading)
                    
        ' Calculate Normal
        D3Nor.x = I_nBanking * 2 * -Sin(Heading)
        D3Nor.y = 1
        D3Nor.z = I_nBanking * 2 * Cos(Heading)
                    
        ' Normalize data
        RMC.dx.VectorNormalize D3Ori
        RMC.dx.VectorNormalize D3Nor
        
        ' Check for collision with other drivers
        For i = 1 To UBound(Racers)
            distance = GetDistance(D3Pos.x, D3Pos.z, Racers(i).Location_X, Racers(i).Location_Z)
            If distance < 20 Then
               Driversnd3D(i).SetPosition Racers(i).Location_X, 1, Racers(i).Location_Z, DS3D_IMMEDIATE
               Driversnd(i).Play DSBPLAY_DEFAULT
            End If
            If distance = 10 Then
               Beepsnd3D.SetPosition Racers(i).Location_X, 1, Racers(i).Location_Z, DS3D_IMMEDIATE
               Beepsnd.Play DSBPLAY_DEFAULT
            End If
            If distance < 2.5 + Racers(i).Radius Then
               Hit1snd3D.SetPosition D3Pos.x, D3Pos.y, D3Pos.z, DS3D_IMMEDIATE
               Hit1snd.Play DSBPLAY_DEFAULT
               Hit2snd3D.SetPosition Racers(i).Location_X, 1, Racers(i).Location_Z, DS3D_IMMEDIATE
               Hit2snd.Play DSBPLAY_DEFAULT
               Velocity = -Velocity
               Racers(i).Speed = -Racers(i).Speed / 2
            End If
        Next
        
        For i = 1 To UBound(Bonus)
            distance = GetDistance(D3Pos.x, D3Pos.z, Bonus(i).Location_X, Bonus(i).Location_Z)
            If distance < 5 And Bonus(i).Active = True Then
               'You can drop down this limit below and increase an unlimit(well, integer limit) turbo
               'and try to run at max speed as you can
               If MaxVel < 10 Then MaxVel = MaxVel + 1
               Bonussnd3D.SetPosition D3Pos.x, D3Pos.y, D3Pos.z, DS3D_IMMEDIATE
               Bonussnd.Play DSBPLAY_DEFAULT
               Bonus(i).Active = False
               If BonusFrame(i).GetVisualCount > 0 Then BonusFrame(i).DeleteVisual BonusMesh(i)
            End If
            If Bonus(i).Active = True Then BonusFrame(i).AddRotation D3DRMCOMBINE_BEFORE, 0, 1, 0, 5 * (pi / 180)
        Next
                
        For i = 1 To UBound(Targets)
            distance = GetDistance(D3Pos.x, D3Pos.z, Targets(i).Location_X, Targets(i).Location_Z)
            If Targets(i).Pass = False And distance < 60 Then
               Targets(i).Pass = True
               If i = 1 Then
                  Targets(9).Pass = False
                  TargetsCount = TargetsCount + 1
               End If
               TargetsCount = TargetsCount - 1
            End If
        Next
        
        If TargetsCount = 0 Then
           Lap = Lap + 1
           doTargets
        End If
        
        'Set values ...
        m_objectFrame(1).SetPosition Nothing, D3Pos.x, D3Pos.y, D3Pos.z
        m_objectFrame(1).SetOrientation Nothing, D3Ori.x, D3Ori.y, D3Ori.z, D3Nor.x, D3Nor.y, D3Nor.z
        m_objectFrame(1).GetPosition Nothing, D3Pos
        Playersnd3D.SetPosition D3Pos.x, D3Pos.y, D3Pos.z, DS3D_IMMEDIATE
        ombreFrame.SetPosition m_objectFrame(1), 0, -1.95, 0
        If retro = True Then 'back view
           RMC.CameraFrame.SetPosition m_objectFrame(1), 0, 2, 0
           If ret = 1 Then
              RMC.CameraFrame.AddRotation D3DRMCOMBINE_BEFORE, 0, 1, 0, 180 * pi / 180
              ret = 2
           End If
        Else 'front view
           RMC.CameraFrame.SetPosition m_objectFrame(1), 0, hview, dview
           RMC.CameraFrame.LookAt m_objectFrame(1), Nothing, D3DRMCONSTRAIN_Z
        End If
       
       'These fixed camera views are good for this map only
       If F1 = True Then
          RMC.CameraFrame.SetPosition Nothing, 16 * TCase, 15, 5 * TCase
          RMC.CameraFrame.SetOrientation Nothing, 0.5, 0, -0.5, 0, 1, 0
       End If
       If F2 = True Then
          RMC.CameraFrame.SetPosition Nothing, 23.35 * TCase, 8, 0.45 * TCase
          RMC.CameraFrame.SetOrientation Nothing, -0.5, 0, 1.2, 0, 1, 0
       End If
       If F3 = True Then
          RMC.CameraFrame.SetPosition Nothing, 23 * TCase, 15, 15 * TCase
          RMC.CameraFrame.SetOrientation Nothing, 0.5, 0, -0.5, 0, 1, 0
       End If
       If F4 = True Then
          RMC.CameraFrame.SetPosition Nothing, 45 * TCase, 25, 4.5 * TCase
          RMC.CameraFrame.SetOrientation Nothing, -0.65, 0, 0.35, 0, 1, 0
       End If
       If F5 = True Then
          RMC.CameraFrame.SetPosition Nothing, 50 * TCase, 5, 8.7 * TCase
          RMC.CameraFrame.SetOrientation Nothing, -0.65, 0, 0.35, 0, 1, 0
       End If
       If F6 = True Then
          RMC.CameraFrame.SetPosition Nothing, 47 * TCase, 20, 30 * TCase
          RMC.CameraFrame.SetOrientation Nothing, -1, 0, -1, 0, 1, 0
       End If
       If F7 = True Then
          RMC.CameraFrame.SetPosition Nothing, 41 * TCase, 5, 43 * TCase
          RMC.CameraFrame.SetOrientation Nothing, 0, 0, -1, 0, 1, 0
       End If
       If F8 = True Then
          RMC.CameraFrame.SetPosition Nothing, 29 * TCase, 20, 46 * TCase
          RMC.CameraFrame.SetOrientation Nothing, 1, 0, 0, 0, 1, 0
       End If
       If F9 = True Then
          RMC.CameraFrame.SetPosition Nothing, 18 * TCase, 15, 37 * TCase
          RMC.CameraFrame.SetOrientation Nothing, 0.5, 0, 1, 0, 1, 0
       End If
       If F10 = True Then
          RMC.CameraFrame.SetPosition Nothing, 7 * TCase, 7.5, 37 * TCase
          RMC.CameraFrame.SetOrientation Nothing, 0, 0, 0, 0, 1, 0
       End If
       If F11 = True Then
          RMC.CameraFrame.SetPosition Nothing, 7.5 * TCase, 15, 12 * TCase
          RMC.CameraFrame.SetOrientation Nothing, -0.5, 0, 1, 0, 1, 0
       End If
       If F12 = True Then
          RMC.CameraFrame.SetPosition Nothing, 3 * TCase, 7.5, 2 * TCase
          RMC.CameraFrame.SetOrientation Nothing, 0, 0, 1, 0, 1, 0
       End If
      
        RMC.DsoundLis70.SetPosition D3Pos.x, D3Pos.y, D3Pos.z, DS3D_IMMEDIATE
        RMC.DsoundLis70.SetOrientation D3Ori.x, D3Ori.y, D3Ori.z, D3Nor.x, D3Nor.y, D3Nor.z, DS3D_IMMEDIATE
        
        'Angle = Cos(Heading)
        
        'fix the angle
        If Angle > pi * 2 Then Angle = Angle - pi * 2
        If Angle < 0 Then Angle = Angle + pi * 2
     
End Sub
  

Private Sub Initwalls()
Dim i, appo As String, blocco As String
For i = 0 To 111
    If i < 10 Then
       appo = "00" & CStr(i)
    ElseIf i < 100 Then
       appo = "0" & CStr(i)
    Else
       appo = CStr(i)
    End If
    blocco = App.path & "\Mesh\bloc_" & appo & ".x"
    Set Wall(i) = CaricaX(blocco)
Next i
End Sub
Private Function CaricaX(Nom$) As Direct3DRMMeshBuilder3
Dim i As Byte, appo As String

Set CaricaX = RMC.D3DRM.CreateMeshBuilder()
CaricaX.LoadFromFile Nom$, 0, D3DRMLOAD_FROMFILE, Nothing, Nothing
appo = Mid(Nom$, Len(Nom$) - 9, 8)
'I cannot test the mesh directly: I get an Automation error(I do not know why);
'so I have to test it with this "if" command below:
If appo = "bloc_009" Or appo = "bloc_010" Or appo = "bloc_011" Or appo = "bloc_012" Or appo = "bloc_013" Or _
   appo = "bloc_014" Or appo = "bloc_015" Or appo = "bloc_016" Or appo = "bloc_017" Or appo = "bloc_018" Or _
   appo = "bloc_019" Or appo = "bloc_020" Or appo = "bloc_021" Or appo = "bloc_022" Or appo = "bloc_023" Or _
   appo = "bloc_024" Or appo = "bloc_025" Or appo = "bloc_026" Or appo = "bloc_027" Or appo = "bloc_028" Or _
   appo = "bloc_029" Or appo = "bloc_030" Or appo = "bloc_031" Or appo = "bloc_032" Or appo = "bloc_033" Or _
   appo = "bloc_034" Or appo = "bloc_035" Or appo = "bloc_036" Or appo = "bloc_037" Or appo = "bloc_038" Or _
   appo = "bloc_039" Or appo = "bloc_040" Or appo = "bloc_041" Or appo = "bloc_042" Or appo = "bloc_043" Or _
   appo = "bloc_044" Or appo = "bloc_045" Or appo = "bloc_046" Or appo = "bloc_047" Or appo = "bloc_048" Or _
   appo = "bloc_049" Or appo = "bloc_050" Or appo = "bloc_051" Or appo = "bloc_052" Or appo = "bloc_053" Or _
   appo = "bloc_054" Or appo = "bloc_055" Or appo = "bloc_056" Or appo = "bloc_057" Or appo = "bloc_058" Or _
   appo = "bloc_059" Or appo = "bloc_060" Or appo = "bloc_061" Or appo = "bloc_062" Or appo = "bloc_063" Or _
   appo = "bloc_064" Or appo = "bloc_065" Or appo = "bloc_066" Or appo = "bloc_067" Or appo = "bloc_068" Or _
   appo = "bloc_069" Or appo = "bloc_070" Or appo = "bloc_071" Or appo = "bloc_072" Or appo = "bloc_073" Or _
   appo = "bloc_074" Or appo = "bloc_075" Or appo = "bloc_076" Or appo = "bloc_077" Or appo = "bloc_078" Or _
   appo = "bloc_079" Or appo = "bloc_080" Or appo = "bloc_081" Or appo = "bloc_082" Or appo = "bloc_083" Or _
   appo = "bloc_084" Or appo = "bloc_085" Or appo = "bloc_086" Or appo = "bloc_087" Or appo = "bloc_088" Or _
   appo = "bloc_089" Or appo = "bloc_090" Or appo = "bloc_091" Or appo = "bloc_092" Or appo = "bloc_093" Or _
   appo = "bloc_094" Or appo = "bloc_095" Or appo = "bloc_096" Or appo = "bloc_097" Or appo = "bloc_098" Or _
   appo = "bloc_099" Or appo = "bloc_100" Or appo = "bloc_101" Or appo = "bloc_102" Or appo = "bloc_103" Or _
   appo = "bloc_104" Or appo = "bloc_105" Or appo = "bloc_106" Or appo = "bloc_107" Or appo = "bloc_108" Or _
   appo = "bloc_109" Or appo = "bloc_110" Or appo = "bloc_111" Then
   For i = 0 To CaricaX.GetFaceCount - 1
       CaricaX.GetFace(i).GetTexture.SetDecalTransparency D_TRUE
       CaricaX.GetFace(i).GetTexture.SetDecalTransparentColor RGB(255, 0, 255)
   Next
End If
End Function
Private Sub CreatePlayers()
Dim i As Integer
For i = 1 To UBound(Racers) + 1
    Set m_objectFrame(i) = RMC.D3DRM.CreateFrame(RMC.SceneFrame)
    Set m_meshBuilder(i) = RMC.D3DRM.CreateMeshBuilder()
    If i = 1 Then m_meshBuilder(i).LoadFromFile App.path & "\Mesh\player.x", 0, D3DRMLOAD_FROMFILE, Nothing, Nothing
    If i = 2 Or i = 3 Then m_meshBuilder(i).LoadFromFile App.path & "\Mesh\kazi.x", 0, D3DRMLOAD_FROMFILE, Nothing, Nothing
    If i = 4 Or i = 5 Then m_meshBuilder(i).LoadFromFile App.path & "\Mesh\cop.x", 0, D3DRMLOAD_FROMFILE, Nothing, Nothing
    If i = 6 Or i = 7 Then m_meshBuilder(i).LoadFromFile App.path & "\Mesh\iron.x", 0, D3DRMLOAD_FROMFILE, Nothing, Nothing
    If i = 8 Or i = 9 Then m_meshBuilder(i).LoadFromFile App.path & "\Mesh\leroy.x", 0, D3DRMLOAD_FROMFILE, Nothing, Nothing
    If i = 10 Or i = 11 Then m_meshBuilder(i).LoadFromFile App.path & "\Mesh\cubik.x", 0, D3DRMLOAD_FROMFILE, Nothing, Nothing
    m_objectFrame(i).AddScale D3DRMCOMBINE_REPLACE, 1, 1, 1
    m_objectFrame(i).AddRotation D3DRMCOMBINE_BEFORE, 0, 1, 0, 90 * (pi / 180)
    m_objectFrame(i).AddVisual m_meshBuilder(i)
    Set m_meshBuilder(i) = Nothing
Next i
Set ombreFrame = RMC.D3DRM.CreateFrame(RMC.SceneFrame)
Set ombreMesh = RMC.D3DRM.CreateMeshBuilder()
ombreMesh.LoadFromFile App.path & "\Mesh\ombre.x", 0, D3DRMLOAD_FROMFILE, Nothing, Nothing
'ombreMesh.SetQuality D3DRMRENDER_UNLITFLAT
ombreMesh.GetFace(0).GetTexture.SetDecalTransparency D_TRUE
ombreMesh.GetFace(0).GetTexture.SetDecalTransparentColor RGB(255, 255, 255)
Dim fin As Direct3DRMFrame3
Set fin = RMC.D3DRM.CreateFrame(ombreFrame)
Dim mo As D3DRMMATERIALOVERRIDE
With mo
     .lFlags = D3DRMMATERIALOVERRIDE_DIFFUSE_RGBONLY
     .dcDiffuse.a = 0.1
End With
fin.SetMaterialOverride mo
fin.AddVisual ombreMesh