Código serpiente VB
'Definir el valor de enumeración de velocidad de movimiento de la serpiente
Enum privado tpsSpeed
RÁPIDO = 0
LENTO = 1
End Enum
'Define el valor de enumeración de la dirección del movimiento de la serpiente
Enum privado tpsDirection
D_UP = 38
D_DOWN = 40
D_LEFT = 37
D_RIGHT = 39
End Enum
'Define el valor de enumeración de las cuatro áreas restringidas en el área deportiva
p>
Enumeración privada tpsForbiddenZone
FZ_TOP = 30
FZ_BOTTOM = 5330
FZ_LEFT = 30
FZ_RIGHT = 5730
p>End Enum
'Definir el valor de enumeración del número de inicialización de cabeza y cuerpo de serpiente
Enum privado tpsSnake
SNAKEONE = 1
SNAKETWO = 2
SNAKETHREE = 3
SNAKEFOUR = 4
Fin de enumeración
' Constante que define el ancho de la serpiente
Private Const SNAKEWIDTH As Integer = 100
'Este proceso se utiliza para mostrar información del juego
Private Sub Form_Load()
Me.Show
Me.lblTitle = "BS Greedy Snake— (Versión" & App.Major & "." & App.Minor & "." & App.Revision & ")"
Me.Caption = Me.lblTitle.Caption
frmSplash.Show 1
End Sub
'Este proceso es utilizado para restaurar el formulario a su forma original Tamaño
Private Sub Form_Resize()
If Me.WindowState lt;gt 1 Then
Me.Caption = ""
Me.Height = 6405 'El alto del formulario es 6405 tw
Me.Width = 8535 'El ancho del formulario es 8535 tw
Me.Left = (Ancho.Pantalla - Ancho) \ 2
Me.Top = (Alto.Pantalla - Alto) \ 2
Fin si
End Sub
'Este proceso utiliza Iniciar el juego de nuevo
Private Sub cmdGameStart_MouseDown(Button As Integer, Shift As Integer, X As Sin
gle, Y As Single)
Beep
msg = MsgBox("¿Estás seguro de que quieres reiniciar el juego?", 4 32, "BS Snake")
Si msg = 6, entonces llame a m_subGameInitialize
End Sub
'Este proceso se utiliza para pausar/ejecutar el juego
Private Sub chkPause_MouseDown(Botón como Entero, desplazamiento como entero,
Me.tmrGameTime.Enabled = False
Me.picMoveArea.Enabled = False
Me.lblPauseLab.Visible = True
Me .chkPause.Caption = "Continuar juego (y R)"
Else
Me.tmrSnakeMove.Enabled = True
Yo .tmrGameTime.Enabled = True
Me.picMoveArea.Enabled = True
Me.lblPauseLab.Visible = False
Me.chkPause.Caption = "Pausar juego (amp; P)"
End If
End Sub
'Este proceso se utiliza para mostrar las reglas del juego
Private Sub cmdGameRules_MouseDown (Botón como entero, Mayús como entero, ) amp; _
" para controlar la dirección del movimiento de la serpiente. Durante el movimiento, la serpiente" & Chr(13) & _
"no puede retirarse, y la cabeza de la serpiente no puede tocar fuera del borde del área de movimiento" & Chr(13) & _
"Con el propio cuerpo de la serpiente, de lo contrario el juego fallará. Después de comer la fruta "amp; Chr(13) & _
" que aparece aleatoriamente, el cuerpo de la serpiente se alargará y, cuanto más largo se vuelva, más difícil será.
¡Buena suerte! ! ", 0 64, "Reglas del juego"
End Sub
'Este proceso se utiliza para mostrar información sobre el desarrollo del juego
Private Sub cmdAbout_MouseDown(Button As Integer, Shift As Integer, amp; App.Minor amp; "versión)" amp; Chr(13) amp; ) amp;
"Diseñado y producido por PigheadPrince" amp; Chr(13) amp _
"CopyRight(C)2002, BestSoft.TCG", 0, "Acerca de esto game"
p>
End Sub
'Este proceso se utiliza para salir del juego
Private Sub cmdExit_MouseDown(Button As Integer, Shift As Integer , X As Single, Y As Single)
Beep
msg = MsgBox("¿Quieres salir de este juego?", 4 32, "BS Snake")
Seleccionar mensaje de caso
Caso 6
Fin
Caso 7
Me.chkWindowButton(2).Value = 0
Salir Sub
Fin Seleccionar
Fin Sub
'Este proceso se utiliza para arrastrar el formulario_(haga clic en el icono)
Private Sub imgWindowTop_MouseDown(Botón como entero, Mayús como entero, X como único, Y como único)
ReleaseCapture
Enviar mensaje Me.hwnd, WM_SYSCOMMAND, SC_MOVE, 0
End Sub
'Este proceso de aplicación se utiliza para manejar operaciones relacionadas del grupo de botones de control de formulario_(bloquear, minimizar, salir)
Private Sub chkWindowButton_MouseUp( Índice como entero, botón como entero, desplazamiento como entero, X como único, Y como único)
Si el botón lt;gt 1, entonces salga de Sub
Seleccione el índice de casos
Caso 0 'Bloquear el formulario
Si Me.chkWindowButton(0).Value = 1 Entonces
Me.imgWindowTop.BorderStyle = 0
Me.imgWindowTop.Enabled = False
Else
Me.imgWindowTop.BorderStyle = 1
Me.imgWindowTop.Enabled = True
Finalizar si
Caso 1 'Minimizar
Me.WindowState = 1
Me.chkWindowButton(1).Value = 0
Me.Caption = "BS Greedy Snake— (V-" amp; App.Major amp; "." amp; App.Minor amp; "version)"
Caso 2 'Salir
Beep
msg = MsgBox("¿Quieres salir de este juego?", 4 32, " BS serpiente codiciosa")
Seleccionar mensaje de caso
Caso 6
Fin
Caso 7
Yo .chkWindowButton (2).Valor = 0
Salir Sub
Finalizar selección
Finalizar selección
Fin Sub
'Este proceso se utiliza para establecer la velocidad del movimiento de la serpiente
Private Sub hsbGameSpeed_Change()
Me.tmrSnakeMove.Interval = Me.hsbGameSpeed.Value
End Sub
'Este proceso se utiliza para cambiar la dirección del movimiento de la serpiente a través de las teclas de flecha del teclado
Private Sub picMoveArea_KeyDown(KeyCode As Integer, Shift As Integer)
Seleccione Caso g_intDirection
Caso D_UP
Si KeyCode = D_DOWN Entonces salga Sub
Caso D_DOWN
Si KeyCode = D_UP Entonces salga Sub
Caso D_LEFT
Si KeyCode = D_RIGHT Entonces salga de Sub
Caso D_RIGHT
Si KeyCode = D_LEFT Entonces salga de Sub
Es
d Select
g_intDirection = KeyCode
End Sub
'Este proceso de bucle de tiempo se utiliza para calcular el número de segundos pasados en el juego y mostrarlo
Sub privado tmrGameTime_Timer()
g_lngGameTime = g_lngGameTime 1
Me.lblGameTime.Caption = g_lngGameTime amp "segundos"
End Sub
'Este proceso de bucle de tiempo se utiliza para controlar la trayectoria del movimiento de la serpiente
Private Sub tmrSnakeMove_Timer()
Dim lngSnakeX As Long, lngSnakeY As Long, lngSnakeColor As Long
Atenuar lngPointX mientras, lngPointY mientras, lngPointColor mientras
Aleatorizar
Me.picMoveArea.SetFocus
Me.picMoveArea. Cls
'Confirma la dirección del movimiento de la cabeza de serpiente y obtiene la nueva posición
Selecciona Case g_intDirection
Case D_UP 'Mover hacia arriba
g_udtSnake(SNAKEONE).Snake_CurX = g_udtSnake (SNAKEONE).Snake_OldX
g_udtSnake(SNAKEONE).Snake_CurY = g_udtSnake(SNAKEONE).Snake_OldY
g_udtSnake(SNAKEONE).Snake_CurY = g_udtSnake( SNAKEONE).Snake_CurY - SNAKEWIDTH
Caso D_DOWN 'Movimiento hacia abajo
g_udtSnake(SNAKEONE).Snake_CurX = g_udtSnake(SNAKEONE).Snake_OldX
g_udtSnake(SNAKEONE). Snake_CurY = g_udtSnake(SNAKEONE).Snake_OldY
g_udtSnake(SNAKEONE).Snake_CurY = g_udtSnake(SNAKEONE).Snake_CurY SNAKEWIDTH
Caso D_LEFT 'Mover a la izquierda
g_udtSnake( SNAKEONE).Snake_CurX = g_udtSnake( SNAKEONE).Snake_OldX
g_udtSnake(SNAKEONE).Snake_CurX = g_udtSnake(SNAKEONE).Snake_CurX - ANCHO DE SERPIENTE
g_udtSnake(SNAKEONE).Snake_CurY = g_udtSnake(SNAKEONE).Snake_OldY
Caso D_RIGHT 'Mover a la derecha
g_udtSnake(SNAKEONE).Snake_CurX = g_udtSnake(SNAKEONE).Snake_OldX
g_udtSnake(SNAKEONE).Snake_CurX = g_udtSnake(SNAKEONE).Snake_CurX SNAKEWIDTH
g_udtSnake(SNAKEONE).Snake_CurY = g_udtSnake(SNAKEONE).Snake_OldY
Finalizar selección
'Dibuja la cabeza de la serpiente según la nueva posición
lngSnakeX = g_udtSnake(SNAKEONE).Snake_CurX
lngSnakeY = g_udtSnake(SNAKEONE).Snake_CurY
lngSnakeColor = g_udtSnake (SNAKEONE).Snake_Color
Me.picMoveArea.PSet (lngSnakeX, lngSnakeY), lngSnakeColor
'Mover la posición de otras partes del cuerpo de la serpiente
Para i = 2 Para g_intSnakeLength
g_udtSnake(i).Snake_CurX = g_udtSnake(i - 1).Snake_OldX
g_udtSnake(i).Snake_CurY = g_udtSnake(i - 1 ).Snake_OldY
lngSnakeX = g_udtSnake(i).Snake_CurX
lngSnakeY = g_udtSnake(i).Snake_CurY
lngSnakeColor = g_udtSnake(i).Snake_Color
Me picMoveArea.PSet (lngSnakeX, lngSnakeY), lngSnakeColor
Siguiente i
'Actualizar la antigua posición de coordenadas de la serpiente
Para j = 1 A g_intSnakeLength
g_udtSnake(j).Snake_OldX = g_udtSnake(j).Snake_CurX
g_udtSnake(j).Snake_OldY = g_udtSnake(j).Snake_CurY
Siguiente j
'Determina si la serpiente ha alcanzado el área restringida durante el movimiento, provocando que el juego falle
If m_funMoveForbiddenZone(g_udtSnake(SNAKEONE).Snake_Cu
rX, g_udtSnake(SNAKEONE).Snake_CurY) Luego
Bip
MsgBox "¡Tu serpiente se movió al área restringida, el juego falló!", 0 16, "BS Greedy Snake"< / p>
Me.tmrSnakeMove.Enabled = False
Me.tmrGameTime.Enabled = False
Me.picMoveArea.Visible = False
Salir Sub
End If
'Determina si la serpiente tocó su propio cuerpo mientras se movía y provocó que el juego fallara
If m_funTouchSnakeBody(g_udtSnake(SNAKEONE).Snake_CurX, g_udtSnake( SNAKEONE).Snake_CurY) Luego
Bip
MsgBox "Tu serpiente tocó su propio cuerpo mientras se movía, ¡el juego falló!", 0 16, "BS Snake"
Me.tmrSnakeMove.Enabled = False
Me.tmrGameTime.Enabled = False
Me.picMoveArea.Visible = False
Salir Sub
End If
'Determinar si la serpiente se ha comido la fruta
If m_funEatPoint(g_udtSnake(SNAKEONE).Snake_CurX, g_udtSnake(SNAKEONE).Snake_CurY) Then
'Acumula puntuaciones de jugadores y actualiza la visualización de puntuaciones
g_intPlayerScore = g_intPlayerScore 1
Me.lblYourScore.Caption = g_intPlayerScore "Puntos"
Llame a m_subAddSnake 'Alarga el cuerpo de la serpiente
Llame a m_subGetPoint 'Obtén la posición y el color de la siguiente fruta
De lo contrario
'Dibuja la fruta
lngPointX = g_udtPoint.Point_X
lngPointY = g_udtPoint.Point_Y
lngPointColor = g_udtPoint.Point_Color
Me.picMoveArea.PSet (lngPointX, lngPointY), lngPointColor
End If
End Sub
'Este subproceso privado se utiliza para inicializar el juego
Private Sub m_subGameInitialize()
Borrar g_udtSnake
'Borrar la estructura de la serpiente
g_intPlayerScore = 0 'Borrar la puntuación del jugador
g_lngGameTime = 0 'Borrar el número de segundos pasados en el juego
g_intDirection = D_DOWN 'Set Establece la dirección de movimiento inicial de la serpiente hacia abajo
g_intSnakeLength = 4 'Establece la longitud inicial de la serpiente
ReDim g_udtSnake(1 To g_intSnakeLength) 'Redefine la longitud de the Snake
'Define los datos de la cabeza de serpiente
Con g_udtSnake(SNAKEONE)
.Snake_OldX = 530
.Snake_OldY = 530
. Snake_Color = vbBlack
Terminar con
'Definir los datos de la sección 2 del cuerpo de la serpiente
Con g_udtSnake(SNAKETWO)
.Snake_OldX = 530
.Snake_OldY = 430
.Snake_Color = vbGreen
Terminar con
'Definir los datos de la sección 3 del cuerpo de la serpiente
p>Con g_udtSnake(SNAKETHREE)
.Snake_OldX = 530
.Snake_OldY = 330
.Snake_Color = vbYellow
Terminar con
'Definir los datos de la sección 4 del cuerpo de la serpiente
Con g_udtSnake(SNAKEFOUR)
.Snake_OldX = 530
.Snake_OldY = 230
.Snake_Color = vbRed
Terminar con
Me.picMoveArea.Visible = True
Me.lblYourScore.Caption = g_intPlayerScore amp; "minutos"
Me.lblGameTime.Caption = g_lngGameTime amp; "segundos"
Me.tmrSnakeMove.Interval = Me.hsbGameSpeed.Value
Me .tmrSnakeMove.Enabled = True
Me.tmrGameTime.Enabled = True
Llamar a m_subGetPoint 'Obtener la posición y el color del primer fruto
>
End Sub
'Este subproceso privado se utiliza para devolver la información de posición y color de la fruta obtenida
Private Sub m_subGetPoint()
Dim lngRedValue As Long, lngGreenValue As Long, lngBlueValue As Long
Dim lngPointX As Long, lngPointY As Long, lngPointColor As Long
'Obtener aleatoriamente el color de la fruta
lngRedValue = Int((255 - 0 1) * Rnd 0)
lngGreenValue = Int((255 - 0 1) * Rnd 0)
lngBlueValue = Int( (255 - 0 1 ) * Rnd 0)
lngPointColor = RGB(lngRedValue, lngGreenValue, lngBlueValue)
'Obtener aleatoriamente la posición de la fruta
lngPointX = Int((FZ_LEFT - FZ_RIGHT 1) * Rnd FZ_RIGHT)
lngPointY = Int((FZ_TOP - FZ_BOTTOM 1) * Rnd FZ_BOTTOM)
Me.PSet (lngPointX, lngPointY), lngPointColor
'Establecer valor de retorno de la función
Con g_udtPoint
.Point_X = lngPointX
.Point_Y = lngPointY
.Point_Color = lngPointColor
End With
End Sub
'Este subproceso privado se utiliza para alargar el cuerpo de la serpiente
Private Sub m_subAddSnake()
Dim udtSnakeTemp() As Snake
Dim lngSnakeX As Long, lngSnakeY As Long, lngSnakeColor As Long
'Hacer una copia de seguridad del datos del cuerpo original de la serpiente y alargar el cuerpo de la serpiente
p>ReDim udtSnakeTemp(1 To g_intSnakeLength)
For k = 1 To g_intSnakeLength
With udtSnakeTemp(k)
.Snake_CurX = g_udtSnake(k ).Snake_CurX
.Snake_CurY = g_udtSnake(k).Snake_CurY
.Snake_OldX = g_udtSnake(k).Snake_OldX
.Snake_OldY = g_udtSnake(k).Snake_OldY
.Snake_Color = g_udtSnake(k).Snake_Color
Terminar con
Siguiente k
g_intSnakeLength = g_intSnakeLength 1
ReDim g_udtSnake(g_intSnakeLength)
'Devuelve los datos de respaldo del cuerpo de la serpiente a la matriz de cuerpos de la serpiente alargada
For l = 1 To g_intSnakeLength - 1
Con g_udtSnake(l)
.Snake_CurX = udtSnakeTemp(l).Snake_CurX
.Snake_CurY = udtSnakeTemp(l).Snake_CurY
.Snake_OldX = udtSnakeTemp(l).Snake_OldX
.Snake_OldY = udtSnakeTemp(l).Snake_OldY
.Snake_Color = udtSnakeTemp(l).Snake_Color
Terminar con
Siguiente l
'Escribir los datos del cuerpo recién agregados
Seleccionar caso g_intDirection
Caso D_UP
Con g_udtSnake(g_intSnakeLength)
.Snake_OldX = g_udtSnake(g_intSnakeLength - 1).Snake_CurX SNAKEWIDTH
.Snake_OldY = g_udtSnake(g_intSnakeLength - 1).Snake_CurY
.Snake_Color = g_udtPoint.Point_Color
Terminar con
Caso D_DOWN
Con g_udtSnake(g_intSnakeLength)
.Snake_OldX = g_udtSnake (g_intSnakeLength - 1).Snake_CurX - ANCHO DE SERPIENTE
.Snake_OldY = g_udtSnake(g_intSnakeLength - 1).Snake_CurY
.Snake_Color = g_udtPoint.Point_Color
Terminar con
<p> Caso D_LEFT
Con g_udtSnake(g_intSnakeLength)
.Snake_OldX = g_udtSnake(g_intSnakeLength - 1).Snake_CurX
.Snake_OldY = g_udtSnake(g_intSnakeLength - 1) .Snake_CurY SNAKEWIDTH
.Snake_Color = g_udtPoint.Point_Color
Terminar con
Caso D_RIGHT
Con g_udtSnake(g_intSnakeLength)
.Snake_OldX = g_udtSnake(g_intSnakeLength - 1).Snake_CurX
.Snake_OldY = g_udtSnake(g_intSnakeLength - 1).Snake_CurY - SNAKEWIDTH
.Snake_Color = g_udtPoint.Point_Color
Terminar con
Finalizar selección
lngSnakeX = g_udtSnake(g_intSnakeLength).Snake_CurX
lngSnakeY = g_udtSnake(g_intSnakeLength).Snake_CurY
lngSnakeColor = g_udtSnake(g_intSnakeLength).Snake_Color
Me.picMoveArea.PSet (lngSnakeX, lngSnakeY), lngSnakeColor
End Sub
'La función personalizada Si la serpiente utilizada para el movimiento de retorno llega a la zona prohibida y hace que el juego falle
Función privada m_funMoveForbiddenZone(SnakeX As Long, SnakeY As Long) As Boolean
If (SnakeX gt; = FZ_LEFT Y SnakeX lt;= FZ_RIGHT) Y (SnakeY gt;= FZ_TOP Y SnakeY lt;= FZ_BOTTOM) Entonces
m_funMoveForbiddenZone = False
Else
m_funMoveForbiddenZone = True
End If
End Function
'Esta función personalizada se utiliza para devolver si la serpiente en movimiento toca su propio cuerpo, lo que provoca que el juego falle
Función privada m_funTouchSnakeB
ody(SnakeX As Long, SnakeY As Long) Como booleano
Para m = 2 Para g_intSnakeLength
Si SnakeX = g_udtSnake(m).Snake_CurX Y SnakeY = g_udtSnake(m) .Snake_CurY Entonces
m_funTouchSnakeBody = True
Salir para
Else
m_funTouchSnakeBody = False
Finalizar si
Siguiente m
Función final
'Esta función personalizada se utiliza para devolver si la serpiente en movimiento se ha comido la fruta
Función privada m_funEatPoint (SnakeX Mientras, SnakeY Mientras) Como Booleano
Si Abs(SnakeX - g_udtPoint.Point_X) lt;= SNAKEWIDTH Y Abs(SnakeY - g_udtPoint.Point_Y) lt;= SNAKEWIDTH Entonces
m_funEatPoint = True
Else
m_funEatPoint = False
Finalizar si
Finalizar función
' ( Llamada a la función API Process_Para realizar la operación de arrastre de forma sin título)---------------------------------
'La función RleaseCapture se usa para liberar la captura del mouse
Función de declaración pública ReleaseCapture Lib "user32" () As Long
'La función SendMessage se usa para enviar formularios móviles a Windows Message
Función de declaración pública SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As _
Long, ByVal wMsg As Long, ByVal wParam As Long, IParam As Any) As Long
Public Const WM_SYSCOMMAND = amp; H112 'Declarar una constante que envía mensajes a Windows
Public Const SC_MOVE = amp; HF012 'Declarar una constante que controla la ventana móvil
'(Parte de declaración de variable del juego)---------------------------------------- -------- ------------------
'Definir la estructura del tipo de datos de serpiente
Tipo público Serpiente
Sn
ake_OldX Mientras dure
Snake_OldY Mientras dure
Snake_CurX Mientras dure
Snake_CurY Mientras dure
Snake_Color Mientras dure
Tipo final
'Definir la estructura del tipo de datos de la fruta
Tipo público Punto
Punto_X As Long
Punto_Y As Long
Point_Color As Long
Tipo final
'Definir la matriz dinámica de Snake
Public g_udtSnake() As Snake
'Definición Fruta
Public g_udtPoint As Point
'Definir la longitud de la serpiente
Public g_intSnakeLength As Integer
'Definir el color de la serpiente
Public g_lngSnakeColor As Long
'Define la dirección del movimiento de la serpiente
Public g_intDirection As Integer
'Define la puntuación del jugador
Public g_intPlayerScore As Integer
'Define el número de segundos que dura el juego
Public g_lngGameTime As Long