• Revista PROGRAMAR: Já está disponível a edição #53 da revista programar. Faz já o download aqui!

Flavio17

Jogo do MineSweeper

3 mensagens neste tópico

Estou a fazer um jogo em vb6 que é o MineSweeper . E estou com dúvidas em fazer os números à volta das minas e como fazer desaparecer vários quadrados de uma vez quando se clica ..

Se alguém souber como fazer diga , e aceito sugestões :thumbsup:

Deixo o meu código para ajudar a visualizar 

Dim T As Integer, minesleft As Integer, minesnumber As Integer, msg As Integer, rand As Integer, i As Long, v(129) As Integer

Private Sub apresent_Click(Index As Integer)

Command1_Click
FormMineSweeper.Hide
Apresentação.Show

End Sub

Private Sub cmdnovojogo_Click(Index As Integer)

Command1_Click

End Sub

Private Sub cmdnummines_Click(Index As Integer)

minesnumber = Val(InputBox("Quantas minas quer inserir no jogo?", "Número de minas"))

If minesnumber > 100 Then
    msg = MsgBox("O número máximo de minas é 100. Por favor, volte a inserir o número de minas.", vbOKOnly + vbCritical, "ERRO!")
ElseIf minesnumber < 10 Then
    msg = MsgBox("O número mínimo de minas é 10. Por favor, volte a inserir o número de minas.", vbOKOnly + vbCritical, "ERRO!")
ElseIf minesnumber = vbCancel Then
    msg = MsgBox("Operação cancelada.", vbOKOnly + vbInformation, "")
End If

If minesnumber > 0 And minesnumber < 100 Then
    If MsgBox("Quer iniciar um novo jogo?", vbYesNo + vbQuestion, "Novo Jogo") = vbYes Then
        Label1.Caption = minesnumber
        Command1_Click
    End If
End If

End Sub

Private Sub cmdquadrado_Click(Index As Integer)

Timer1.Enabled = True

cmdquadrado(Index).Visible = False

If v(Index) = 1 Then
    Timer1.Interval = 9999
    msg = MsgBox("Pisaste uma mina... Morreste... LoL..." & Chr(13) & Chr(13) & "Queres tentar outra vez?", vbYesNo + vbCritical + vbSystemModal, "BoOm!")
    If msg = vbYes Then
        Command1_Click
    ElseIf msg = vbNo Then
        msg = MsgBox("Se quiseres tentar de novo carrega na tecla F2...", vbOKOnly + vbInformation, "")
    End If
End If

End Sub

Private Sub cmdsair_Click(Index As Integer)

If MsgBox("Tem a certeza que quer sair?", vbYesNo + vbQuestion, "Sair do jogo?") = vbYes Then
    End
End If

End Sub


Private Sub Command1_Click()

Dim x As Integer, y As Integer, min As Integer

Timer1.Enabled = True
T = 0

For i = 0 To 129
    v(i) = 0
Next i

minesnumber = Val(Label1.Caption)

For x = 0 To 129
    cmdquadrado(x).Caption = ""
    cmdquadrado(x).Visible = True
Next x

For y = 0 To 129
    Image1(y).Picture = LoadPicture("f:\Programação\Trabalho 3 - MineSweeper\mina.bmp")
    Image1(y).Visible = False
Next y

Randomize
For min = 0 To minesnumber
    rand = Int(Rnd() * 129)
    For i = 0 To 129
        If i = rand Then
            v(i) = 1
        End If
    Next i
    Image1(rand).Visible = True
Next min

For x = 0 To 129
    cmdquadrado(x).Enabled = True
Next x
Command1.Enabled = True
Label2.FontSize = 28

End Sub

Private Sub Form_Load()

Dim x As Integer

For x = 0 To 129
    cmdquadrado(x).Caption = ""
    cmdquadrado(x).Visible = True
    cmdquadrado(x).MousePointer = 99
Next x

Timer1.Enabled = False

Label1.Caption = 10
minesnumber = Val(Label1.Caption)

End Sub

Private Sub tempos_Click(Index As Integer)

FormMineSweeper.Hide
FormTempos.Show

End Sub

Private Sub Timer1_Timer()

Dim msg As Integer

If T <= 9 Then
    Label2.Caption = "00" & T
ElseIf T <= 99 Then
    Label2.Caption = "0" & T
ElseIf T <= 999 Then
    Label2.Caption = T
ElseIf T > 999 Then
    msg = MsgBox("Acabou o tempo", vbOKOnly + vbExclamation, "Minesweeper")
End If

T = T + 1

End Sub

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Código uma beca complicado  :rant_01:

Tive a ler mas não percebi lá muito bem, acho que devias centrar mais no jogo em si do que nos outputs para o utilizador.

Aqui está um exemplo de 1 código simples e leve para um jogo de minesweeper

Option Explicit
Private X, Y, z As Integer

Private Sub Form_Load()
X = 10
Y = 10
z = 20
criar_campo
End Sub

Private Sub menEditar_Click()
eliminar_campo
X = Val(InputBox("Quantos campos deseja na horizontal?"))
Y = Val(InputBox("Quantos campos deseja na vertical?"))
z = Val(InputBox("Quantas minas deseja?"))
criar_campo
End Sub

Private Sub criar_campo()
Dim i, j, n As Integer
For j = 1 To Y
    For i = 1 To X
        n = (j - 1) * X + i
        Load pctCampo(n)
        pctCampo(n).Left = frmHaupt.ScaleWidth / X * (i - 1)
        pctCampo(n).Top = frmHaupt.ScaleHeight / Y * (j - 1)
        pctCampo(n).Width = frmHaupt.ScaleWidth / X
        pctCampo(n).Height = frmHaupt.ScaleHeight / Y
        pctCampo(n).Visible = True
        pctCampo(n).Tag = 0
    Next
Next
localizar_minas
End Sub

Private Sub eliminar_campo()
Dim j, i As Integer
For j = 1 To Y
    For i = 1 To X
        Unload pctCampo((j - 1) * X + i)
    Next
Next
End Sub

Private Sub localizar_minas()
Dim hohe, breite, n, i, ok As Integer
For i = 1 To z
    Do
        Randomize (Timer)
        breite = Int(Rnd * X) + 1
        hohe = Int(Rnd * Y)
        n = hohe * X + breite
        If pctCampo(n).Tag = 0 Then
            pctCampo(n).Tag = 1
            ok = 1
        End If
    Loop Until ok = 1
Next
End Sub

Private Sub menNovo_Click()
eliminar_campo
criar_campo
End Sub

Private Sub menSair_Click()
Dim sair
sair = MsgBox("Deseja Sair?", vbYesNo)
If sair = vbYes Then
    Unload Me
End If
End Sub

Private Sub pctCampo_Click(Index As Integer)
Dim i, n, a As Integer
If Not (pctCampo(Index) = "X") Then
If pctCampo(Index).Tag = 1 Then
    MsgBox ("Perdeste")
    eliminar_campo
    criar_campo
Else
    For i = 1 To 8
        Select Case i
            Case 1
                n = -X - 1
            Case 2
                n = -X
            Case 3
                n = -X + 1
            Case 4
                n = -1
            Case 5
                n = 1
            Case 6
                n = X - 1
            Case 7
                n = X
            Case 8
                n = X + 1
        End Select
        If Index + n >= 1 Then
            If pctCampo(Index + n).Tag = 1 Then
                a = a + 1
            End If
        End If
    Next
    pctCampo(Index).Print a
End If
End If
End Sub

Private Sub pctCampo_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
pctCampo(Index).Print "X"
End If
End Sub

Direitos de Autor:

-Este código não me pertence, mas o autor permite-me fazer uso deste podendo o partilhar com outros.

-Código apenas para fins aprendizagem e partilha de exemplos não deve ser utilizado para qualquer fim lucrativo.

Quanto à form, adiciona apenas uma Picture Box como um array e com o nome : pctCampo    ( se mudares muda também o código)

Ainda na form adiciona um menu ( aquela barra superior onde ves Ficheiro ... Editar ... Ver...Favoritos...) chamado Jogo com sub menus: -Novo

          -Editar

          -Sair (opcional)

-Espero que consigas obter alguma informação útil apartir de este código.

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Crie uma conta ou ligue-se para comentar

Só membros podem comentar

Criar nova conta

Registe para ter uma conta na nossa comunidade. É fácil!


Registar nova conta

Entra

Já tem conta? Inicie sessão aqui.


Entrar Agora