ni scripnya
Private Declare Function GetTickCount Lib "kernel32" () As Long 'this function lets us not use timer'timers are bad :) 'main body... each part of the snake has X and YPrivate Type PartX As IntegerY As IntegerEnd Type 'Dynamic array to store part coordinatesDim Part() As Part 'Velocity in X and Y direction of the snakeDim vX As Integer, vY As IntegerDim i As Integer 'for loopsDim CS As Single 'cell size Dim FX As Integer, FY As Integer 'food coordinatesDim X As Integer, Y As Integer Dim bRunning As Boolean, died As Boolean Private Sub Form_Load()Randomize 'random generation 'Initialize controls******************Picture1.BackColor = vbWhitePicture1.ScaleMode = 3 'pixels CS = 20 'cell size in pixelsX = Int(Picture1.ScaleWidth / CS)Y = Int(Picture1.ScaleHeight / CS) Picture1.AutoRedraw = TruePicture1.ScaleWidth = X * CSPicture1.ScaleHeight = Y * CS Me.WindowState = 2Me.Show DrawGrid Picture1, CS'************************************* died = False'set up the gameReDim Part(0)Part(0).X = 0Part(0).Y = 0 FX = Int(Rnd * X)FY = Int(Rnd * Y)'go to main loopbRunning = TrueMainLoopEnd Sub Sub MainLoop()Do While bRunning = True Update Draw WAIT (50) 'increasing this number makes game slowerLoop Unload MeEnd Sub Sub Update()'MOVE PARTSFor i = UBound(Part) To 1 Step -1 Part(i).X = Part(i - 1).X Part(i).Y = Part(i - 1).YNext i 'MOVE HEADPart(0).X = Part(0).X + vXPart(0).Y = Part(0).Y + vY 'HAS HE GONE OUT OF BOUNDS ?If Part(0).X <>= X Or Part(0).Y <>= Y Thendied = TrueEnd If 'HAS HE CRASHED INTO HIMSELF ?For i = 1 To UBound(Part)If Part(i).X = Part(0).X And Part(i).Y = Part(0).Y Thendied = TrueEnd IfNext i 'DID HE EAT FOOD ?If Part(0).X = FX And Part(0).Y = FY Then ReDim Preserve Part(UBound(Part) + 1) Part(UBound(Part)).X = -CS Part(UBound(Part)).Y = -CS FX = Int(Rnd * X) FY = Int(Rnd * Y) Form1.Caption = "Parts: " & UBound(Part)End If 'IS HE DEAD ?If died = True Then NewGameEnd Sub Sub Draw() 'DRAW WHITENESS Rectangle 0, 0, X * CS, Y * CS, vbWhite 'DRAW SNAKE. PARTS IN BLUE, HEAD IN GREEN For i = 1 To UBound(Part) Rectangle Part(i).X * CS, Part(i).Y * CS, Part(i).X * CS + CS, Part(i).Y * CS + CS, vbBlue Next i Rectangle Part(0).X * CS, Part(0).Y * CS, Part(0).X * CS + CS, Part(0).Y * CS + CS, vbGreen 'DRAW FOOD Rectangle FX * CS, FY * CS, FX * CS + CS, FY * CS + CS, vbRed DrawGrid Picture1, CSEnd Sub Sub Rectangle(X1 As Integer, Y1 As Integer, X2 As Integer, Y2 As Integer, color As Long) Picture1.Line (X1, Y1)-(X2, Y2), color, BFEnd Sub Sub NewGame()'SET UP NEW GAMEdied = False ReDim Part(0)Part(0).X = 0Part(0).Y = 0 vX = 0vY = 0 FX = Int(Rnd * X)FY = Int(Rnd * Y)End Sub Sub DrawGrid(Pic As Control, CS As Single) '************************************************************************** 'DRAW GRID '************************************************************************** Dim i As Integer, Across As Single, Up As Single Across = Pic.ScaleWidth / CS Up = Pic.ScaleHeight / CS For i = 0 To Across Pic.Line (i * CS, 0)-(i * CS, Up * CS) Next i For i = 0 To Up Pic.Line (0, i * CS)-(Across * CS, i * CS) Next iEnd Sub Sub WAIT(Tim As Integer) '************************************************************************** 'WAIT FUNCTION '************************************************************************** Dim LastWait As Long LastWait = GetTickCount Do While Tim > GetTickCount - LastWait DoEvents LoopEnd Sub Private Sub Picture1_KeyDown(KeyCode As Integer, Shift As Integer)'USER KEYPRESSES HANDLED HERESelect Case KeyCodeCase vbKeyRightvX = 1vY = 0Case vbKeyLeftvX = -1vY = 0Case vbKeyUpvX = 0vY = -1Case vbKeyDownvX = 0vY = 1End SelectEnd Sub Private Sub Picture1_KeyPress(KeyAscii As Integer)'27 is ESC. IF user presses ESC, QUITIf KeyAscii = 27 Then bRunning = FalseEnd Sub Private Sub Form_Unload(Cancel As Integer)'This function can be left outEndEnd Sub
