Red de conocimientos turísticos - Información de alquiler - ¿Puedes escribir un juego Buscaminas en VB?

¿Puedes escribir un juego Buscaminas en VB?

'------------------------------------------------ - -------------------

' Código fuente del Buscaminas (este programa acaba de la parte principal del programa, creo que puedes completar los demás detalles)

'El buscaminas El programa es lo más difícil es cómo abrir automáticamente el área en blanco

'Solía usar el método de juicio "apilar" para abrir el área en blanco,

'Eso es. , presione las coordenadas que se juzgarán en la simulación establecida en el área de apilamiento y luego muestre los juicios uno por uno.

'Con este método, necesitamos usar colecciones para hacer pilas, y la programación es muy problemática.

'Lo pensé durante mucho tiempo y finalmente se me ocurrió otro método. , que es lo que estamos haciendo ahora El método utilizado

'Lo llamaré método de "escaneo" por el momento, porque utiliza el principio de escaneo para abrir el área en blanco

El método de 'escaneo' es rápido y no utiliza Colección, no hay necesidad de recopilación, también usa el principio de escaneo para abrir el área en blanco

''El método de escaneo es rápido y no utilizar colección, ni requiere colección. No es necesario recopilar datos y es fácil de programar y leer el programa.

'Personalmente me gusta mucho este método y creo que es una idea muy novedosa (jaja, no te rías de mí por ser estúpido)

'Puedes copiar o modificar el código siguiente para satisfacer tus necesidades, pero indica su fuente

'¡Contáctame si tienes alguna pregunta! Correo electrónico: ZMSPU@163.COM

'--------- - -------------------------------------------------- -----------

'Descripción de la bandera

' 0 a 9 no abierto

' -1 a -9 abierto

' p>

' 10 Ray

' 11 Abierto nulo (sin prejuicios)

' 12 Abierto nulo (juzgado)

' 13 Marcado

' 14 Signo de interrogación

Atenuar qué (1 a 30, 1 a 16) mientras 'Punto

Atenuar guardar (1 a 30) 1 a 16) Mientras 'Guardar

Atenuar mX Mientras

Atenuar mis Coordenadas As Largas

Atenuar mTime Mientras

Atenuar MineFlag mientras 'Marcar minas

Atenuar OpenFlagAs Long 'Abierto

Atenuar ahoraAncho mientras

Atenuar ahoraAltura mientras

Atenuar TotMine siempre que 'Total Thunder

Private Sub Command1_Click()

Timer1.Enabled = True

Label2 = "00:00"

Label1 = TotMine

Label3 = "¡¡Vamos, buena suerte!!"

Picture1.Enabled = True

Para X = 0 hasta NowWidth - 1

Para Y = 0 hasta NowHeight - 1

Imagen1.PaintPicture imagen1(9).p>

BorrarStart NowWidth, NowHeight, TotMine

Escribir número NowWidth, NowHeight

Fin Sub

Subcomando privado2_Click()

Si Command2.Caption = "Mostrar código fuente"

Frame2.Visible = False

End If

End Sub

Sub privado Form_Load( )

Atenuar X mientras

Atenuar Y mientras

Mostrar

NowHeight = 16

owWidth = 30

TotMine = 40

Picture1.ScaleWidth = NowWidth

Para X = 0 a NowWidth - 1

Para Y = 0 a NowHeight - 1

Imagen1.PaintPicture imagen1(9).Imagen, X, Y

BorrarStart NowWidth , NowHeight, TotMine

EscribirNúmero NowWidth, NowHeight

Salir de Sub

'------------------ --------

Para X = 1 a NowWidth

Para Y = 1 a NowHeight

Si qué (X, Y) = 10 Entonces

Imagen1.PaintPicture imagen1(9).PaintPicture imagen1(13).Picture, X - 1, Y - 1

ElseIf What(X, Y) gt;= 1 And What(X, Y) lt;= 9 Then

Imagen1.PaintPicture image1(What(X, Y)).Imagen, X - 1, Y - 1

Else p>

Imagen1.PaintPicture imagen1(9).Imagen, X - 1, Y - 1

Finalizar si

End Sub

Subimagen privada1_ MouseDown(Botón como entero, Mayús como entero, X como

Único, Y como único)

Atenuar T durante el tiempo

Atenuar X1 durante el tiempo

Atenuar Y1 durante el tiempo

Atenuar x2 como único

Atenuar y2 como único

mX = Int(X)

mY = Int(Y)

Si Botón = vbLeftButton Entonces

'Botón izquierdo presionado

Si What(mX 1, mY 1) gt;= 0 Y What(mX 1, mY 1) lt;= 10 Entonces

Imagen1.PaintPicture imagen1(14).Picture, mX, mY

Finalizar si

ElseIf Button = vbRightButton Then

'Botón derecho presionado

'Procesar solo si está abierto

Si Qué(mX 1, mY 1) gt;= -9 Y Qué(mX 1, mY 1)

lt; = -1 entonces

T = 0

'Calcular la marca extraída

Para X1 = mX A mX 2

Para Y1 = mY A mY 2

Si X1 = mX 1 Y Y1 = mY 1 Entonces

De lo contrario

Si X1 gt;= 1 Y X1 lt; AhoraAncho Entonces

Si Y1 gt; = 1 Y Y1 lt; = AhoraAltura Entonces

Si Qué(X1, Y1) = 13 Entonces

T = T 1

Finalizar si

EndIf

Finalizar si

'Si el número de marcas es mayor o igual al número de minas, no procese

If T gt; = -(What(mX 1, mY 1)) Then Exit Sub

'Si el número de marcadores es igual al número de minas, abre

Si T = -Qué(mX 1, mY 1) Entonces

Para X1 = mX a mX 2

Para Y1 = mY a mY 2

Si X1 = mX 1 e Y1 = mY 1 entonces

De lo contrario

Si X1 gt; = 1 y X1 lt; = NowWidth entonces

Si Y1 lt; = 1 y Y1 lt; = NowHeight entonces

0, x2, y2

Finalizar si

Salir Sub

Fin si

'Si el número de marcas es menor que el número de minas, entonces Si X1 = mX a mX 2

Para Y1 = mY a mY 2

Si X1 = mX 1 e Y1 = mY 1 entonces

De lo contrario

Si X1 gt;= 1 Y X1 lt;= AhoraAncho Entonces

Si Y1 gt;= 1 Y Y1 lt; = AhoraAlto Entonces

Si Qué(X1, Y1 ) gt;= 0 Y qué(X1, Y1) lt;= 10 Entonces

' Imagen1.PaintPicture imagen1(

14).Imagen, X1 - 1, Y1 -

' Imagen1.Imagen, X1 - 1, Y1 - 1

Finalizar si

Fin Sub

Subimagen privada1_MouseUp(Botón como entero, Mayús como entero, X como único,

Y como único)

Si botón = vbLeftButton Entonces

' Botón izquierdo Haga clic

Si qué (mX 1, mY 1) = 10 Entonces

'Señale el rayo

Temporizador1.Enabled = Falso

Picture1.PaintPicture image1(13).Picture, mX, mY

Picture1.Enabled = False

Label3 = "¡Guau! ¡Hiciste clic en Raye! ¡¡Empieza de nuevo!!"

EndGame

Timer1 = False

Picture1.Enabled = False

Salir Sub

ElseIf What(mX 1, mY 1) gt;= 1 Y Qué(mX 1, mY 1) lt;= 9 Entonces

'Señala el número

OpenFlag = OpenFlag 1

Imagen1.PaintPicture imagen1(Qué(mX 1, mY 1)).mY 1) = -Qué(mX 1, mY 1)

ElseIf Qué(mX 1, mY 1) = 0 Entonces

'Señalar nulo

Imagen1.PaintPicture imagen1(0).Imagen, mX, mY

Qué(mX 1, mY 1) = 11

OpenBlank mX 1, mY 1

Fin si

Si MineFlag OpenFlag = NowHeight * NowWidth Then

Label3 = "¡Felicitaciones! ¡Pasaste! "

Timer1.Enabled = False

Imagen1.Enabled = False Imagen1.PaintPicture imagen1(10).Imagen, mX, mY

MineFlag = MineFlag 1

Etiqueta1 = TotMine - MineFlag

ElseIf What(mX 1, mY 1) = 13 Then

'¿Ya está marcado, entonces cámbialo a?

What(mX 1, mY 1) = 14

MineFlag = MineFlag - 1

Etiqueta1 = TotMine - MineFlag

Imagen1.PaintPicture imagen1(11).Imagen, mX, mY

ElseIf What(mX 1, mY 1) = 14 Entonces

'¿Marcado? Entonces

Qué(mX 1, mY 1) = Guardar(mX 1, mY 1)

Imagen1.PaintPicture imagen1(9).Imagen, mX, mY

End If

End Sub

Sub privado ClearStart(ByVal mWidth As Long, ByVal mHeight As Long, ByVal

MineNumber As Long)

'Posición de luz predeterminada

Aleatorio

mTime = 0

MineFlag = 0

OpenFlag = 0

'Borrar la matriz

Borrar qué

For T = 1 To MineNumber

aa：

'Obtener una coordenada arbitraria (X, Y)

X = Rnd * (mWidth - 1)

Y = Rnd * (mHeight - 1 )

'Si se han obtenido las coordenadas, volver a obtenerlas

If What(X 1, Y 1) = 10 Then GoTo aa

'Marca la posición actual coordenadas extraídas

Qué(X 1, Y 1) = 10 Entonces Qué(X 1, Y 1) = 10 Entonces Qué(X 1, Y 1) = 10 Entonces Qué(X 1, Y 1 ) = 10 Entonces Qué(X 1, Y 1) = 10 1, Y 1) = 10

Guardar(X 1, Y 1) = 10

End Sub

Número de escritura de sub privado (ByVal mWidth As Long, ByVal mHeight As Long)

' Escribir mensaje

Dim X As Long

Atenuar Y mientras

Atenuar InicioX mientras

Atenuar InicioY mientras

Atenuar FinX mientras

Atenuar FinY1

Si StartX = 0 entonces StartX = 1

'Finalizar en la siguiente columna de la columna actual

EndX = X 1

Si EndX gt;mWidth Entonces EndX = mW

idth

For Y = 1 To mHeight

'Si la posición actual no es Ray, comienza el cálculo

If What(X, Y) lt;gt; 10 Entonces

'Comienza desde la fila anterior de la fila actual

StartY = Y - 1

Si StartY = 0 entonces StartY = 1

'Finalizar el cálculo en la siguiente línea de la línea actual

EndY = Y 1

If EndY gt; StartY To EndY

If TT = Y y T = X Entonces

'Si es la posición actual, no cuenta

En caso contrario

'Si es una mina, entonces cuenta

Si What(T . TT) = 10 entonces mNNTT) = 10 entonces mNumber = mNumber 1

Finalizar si

Siguiente paso

Si mNumber = 0 Entonces

'Si no hay minas alrededor, abre la ubicación actual

What(X, Y) = 0

Guardar(X, Y) = 0

De lo contrario

'Escribe mi número

Qué(X, Y) = mNumber

Guardar(X, Y) = mNumber

Finalizar si

End Sub

Private Sub Timer1_Timer()

Atenuar sTime como cadena

Atenuar M mientras

Atenuar mS mientras

Atenuar sM como cadena

Atenuar sS como cadena

mTime = mTime 1

mM = Int( mTime / 60)

mS = mTime - mM

mM = Int( mTime / 60)

ElseIf What(mX - 1, mY - 1) gt = 1 And What(mX - 1) , mY - 1)

lt;= 9 Entonces

Imagen1.PaintImagen imagen1(Qué(mX - 1, mY -

1)).Imagen, mX - 2, mY - 2

Qué(mX - 1, mY - 1) = -Qué(mX - 1, mY - 1)

OpenFlag = OpenFlag 1

Finalizar si

'Abrir el vértice nuevamente

Si mY - 1 gt = 1 Entonces

Si What(mX, mY - 1) = 0 Entonces

What(mX, mY - 1) = 11

Picture1.PaintPicture image1(0).OpenFlag = OpenFlag 1

ElseIf What(mX, mY - 1) gt

;= 1 Y Qué(mX, mY - 1) lt;= 9 Entonces

Imagen1.PaintPicture imagen1(Qué(mX, mY - 1)).Imagen, mX

- 1, mY - 2

Qué(mX, mY - 1) = -Qué(mX, mY - 1)

OpenFlag = OpenFlag 1

Fin si

End If

'Abre el punto en la parte superior derecha

If mY - 1 gt; = 1 And mX 1 lt; = NowWidth Then

Si Qué(mX 1, mY - 1) = 0 Entonces

Qué(mX 1, mY - 1) = 11

Imagen1.PaintPicture imagen1(0). Imagen, mX, mY - 2

OpenFlag = OpenFlag 1

ElseIf What(mX 1, mY - 1) gt;= 1 And What(mX 1, mY - 1)

lt;= 9 Entonces

Imagen1.PaintImagen imagen1(Qué(mX 1, mY -

1)).Imagen, mX, mY - 2

Qué(mX 1, mY - 1) = -Qué(mX 1, mY - 1)

OpenFlag = OpenFlag 1

Finalizar si

End If

'Abre el punto correcto nuevamente

If mX 1 lt; = NowWidth Then

If What(mX 1, mY) = 0 Then

Qué(mX 1, mY) = 11

Imagen1.PaintPicture imagen1(0).Imagen, mX, mY - 1

OpenFlag = OpenFlag 1

ElseIf What(mX 1, mY) gt;= 1 And What(mX 1, mY) lt;= 9 Then

Imagen1.PaintPicture imagen1(What(mX 1, mY) ).Imagen, mX,

mY - 1

Qué(mX 1, mY) = -Qué(mX 1, mY)

OpenFlag = OpenFlag 1

End If

'Abrir de nuevo la esquina inferior derecha

If mY 1 lt; = NowHeight And mX 1 lt; ; = NowWidth Entonces

Si Qué(mX 1, mY 1) = 0 Entonces

Qué(mX 1, mY 1) = 11

Imagen1.Pai

ntPicture image1(0).Picture, mX, mY

OpenFlag = OpenFlag 1

ElseIf What(mX 1, mY 1) gt;= 1 And What(mX 1, mY 1 )

lt;= 9 Entonces

Imagen1.PaintImagen imagen1(Qué(mX 1, mY

1).Imagen, mX, mY

Qué(mX 1, mY 1) = -Qué(mX 1, mY 1)

OpenFlag = OpenFlag 1

Finalizar si

'Abre el siguiente punto

If mY 1 lt; = NowHeight Then

If What(mX, mY 1) = 0 Then

Qué(mX, mY 1) = 11

Imagen1.PaintPicture imagen1(0).Imagen, mX - 1, mY

OpenFlag = OpenFlag 1

ElseIf What(mX， mY 1) gt；= 1 1) gt；= 1 And What(mX， mY 1) lt；= 9 Entonces

Imagen1.PaintPicture imagen1(What(mX， mY 1 )).Imagen, mX

- 1, mY

Qué(mX, mY 1) = - Qué(mX, mY 1)

OpenFlag = OpenFlag 1

End If

'Finalmente abre el punto de la esquina inferior izquierda

If mY 1 lt = NowHeight And mX; - 1 gt; = 1 Entonces

Si Qué(mX - 1, mY 1) = 0 Entonces

Qué(mX - 1, mY 1) = 11

Imagen1.PaintPicture imagen1(0).Picture, mX - 2, mY

OpenFlag = OpenFlag 1

ElseIf What(mX - 1, mY 1) gt; Qué( mX - 1, mY 1)

lt; = 9 Entonces

Imagen1.PaintPicture imagen1(Qué(mX - 1, mY

1). Imagen, mX - 2, mY

Qué(mX - 1, mY 1) = -Qué(mX - 1, mY 1)

OpenFlag = OpenFlag 1

End If

'Marque este punto como el punto de juicio después de cuatro puntos de juicio

¿Qué (mX, mY) = 12

Finalizar si

Si continuar = falso, entonces salir Do

bucle

Fin Sub

Private Sub EndGame()

Atenuar X mientras

Atenuar Y mientras

Para Y = 1 hasta NowHeight

Para X = 1 a NowWidth

Si What(X, Y) = 10 Entonces

Imagen1 .PaintPicture imagen1(13).Picture，

De lo contrario

Si Qué(X, Y) = 13 Entonces

Si Guardar(X, Y) lt;gt; 10 Entonces

Imagen1 .PaintPicture imagen1( 12).Imagen, X - 1, Y - 1

Finalizar si

ElseIf What(X, Y) = 14 Then

If Save(X, Y) = 10 Entonces

Imagen1.PaintPicture imagen1(13).Imagen, X - 1, Y - 1

Finalizar si

Fin Sub

上篇: ¿Qué es Flush iFinD? 下篇: Cómo formatear un teléfono Huawei a la configuración de fábrica