vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Erstellen von dynamischen Kontextmen?s - wann immer Sie sie brauchen!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2025
 
zurück

 Sie sind aktuell nicht angemeldet.Funktionen: Einloggen  |  Neu registrieren  |  Suchen

Visual-Basic Einsteiger
Re: Snake modifizieren 
Autor: qwert
Datum: 25.02.06 15:27

Private Sub Form_Unload(Cancel As Integer)
End
End Sub
 
Private Sub Label2_Click()
If dead = True Then
 u = vbYes
 Beep
Else
 u = MsgBox("Are you sure you want to restart and change speeds?", vbYesNo)
End If
If u = vbYes Then
 ChangeMode NORM_MODE
 RestartGame
End If
End Sub
 
Private Sub Label3_Click()
If dead = True Then
 u = vbYes
 Beep
Else
 u = MsgBox("Are you sure you want to restart and change speeds?", vbYesNo)
End If
If u = vbYes Then
 ChangeMode FAST_MODE
 RestartGame
End If
End Sub
 
Private Sub Label4_Click()
If dead = True Then
 u = vbYes
 Beep
Else
 u = MsgBox("Are you sure you want to restart and change speeds?", vbYesNo)
End If
If u = vbYes Then
 ChangeMode SUPER_MODE
 RestartGame
End If
End Sub
 
Private Sub Label6_Click()
SetControls 1
Beep
End Sub
 
Private Sub Label7_Click()
SetControls 2
Beep
End Sub
 
 
Private Sub lblHighScore_Click()
Form2.Show
End Sub
 
Private Sub lblStartOver_Click()
 RestartGame
End Sub
 
Sub RestartGame()
 score = 0
  If l > 4 Then
   For i = 5 To l
    Unload body(i)
   Next
  End If
  l = 4
  t = 100
  For i = 0 To 4
   body(i).Left = 80
   body(i).Top = t
   body(i).Tag = "up"
   t = t + 10
  Next
  lblDie.Visible = False
  lblStartOver.Visible = False
  lblScore.Visible = False
 
 
  NewFood
  DoEvents
  Timer1.Enabled = True
  Timer2.Enabled = True
  dead = False
End Sub
Private Sub Timer1_Timer()
If dead = False And waiting = False Then
For i = 0 To l
 Select Case body(i).Tag
  Case "left"
   body(i).Left = body(i).Left - speed
  Case "right"
   body(i).Left = body(i).Left + speed
  Case "up"
   body(i).Top = body(i).Top - speed
  Case "down"
   body(i).Top = body(i).Top + speed
 End Select
Next
If i > 0 Then
 For i = l To 1 Step -1
  body(i).Tag = body(i - 1).Tag
 Next
End If
End If
End Sub
 
Function MoveSnake(ByVal fdir As String)
 body(0).Tag = fdir
 waiting = False
End Function
 
Sub die()
On Error Resume Next
 waiting = True
 dead = True
 Timer1.Enabled = False
 Timer2.Enabled = False
 lblDie.Visible = True
 lblStartOver.Visible = True
 lblHighScore.Visible = True
 lblScore.Caption = "Score: " & score
 lblScore.Visible = True
 fPaused.Visible = True
 
  If score > HighScore Then
 
   fFile = FreeFile
    Open App.Path & "\hscore.hs" For Output As #fFile
     Print #fFile, score
    Close #fFile
   GetHighScore
   MsgBox "Highscore!"
  End If
 
End Sub
 
Sub CheckHits()
 
 
  For i = 0 To l
   For a = 0 To l
    If a <> i Then
     If body(i).Left = body(a).Left And body(i).Top = body(a).Top Then
      die
     End If
    End If
   Next
  Next
 
  If body(0).Left < 0 Or body(0).Left > Form1.ScaleWidth Or body(0).Top > _
    Form1.ScaleHeight Or body(0).Top < 0 Then
   die
  End If
 
 
  If body(0).Left = food.Left And body(0).Top = food.Top Then
      score = score + pval
   NewFood
   NewSeg
  End If
 
 
End Sub
 
 
Private Sub Timer2_Timer()
 
CheckHits
 
End Sub
 
Function NewFood()
 food.Visible = True
10 Randomize
  X = Int(Rnd() * 15) * 10
  Y = Int(Rnd() * 15) * 10
  For i = 0 To l
   If X = body(i).Left And Y = body(i).Top Then
    GoTo 10
   End If
  Next
 If X > Form1.ScaleWidth Then GoTo 10
 If Y > Form1.ScaleHeight Then GoTo 10
 food.Left = X
 food.Top = Y
End Function
alle Nachrichten anzeigenGesamtübersicht  |  Zum Thema  |  Suchen

 ThemaViews  AutorDatum
Snake modifizieren1.017qwert25.02.06 15:26
Re: Snake modifizieren669qwert25.02.06 15:27
Re: Snake modifizieren555HarryC25.02.06 17:23
Re: Snake modifizieren564vbtricks26.02.06 08:33
Re: Snake modifizieren458qwert07.03.06 20:09
Re: Snake modifizieren620vbtricks08.03.06 09:31

Sie sind nicht angemeldet!
Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.

Einloggen  |  Neu registrieren

Funktionen:  Zum Thema  |  GesamtübersichtSuchen 

nach obenzurück
 
   

Copyright ©2000-2025 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel