Jump to content

Recommended Posts

Posted

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 👍

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
Posted

Código uma beca complicado  ?

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.

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.