Flavio17 Posted May 12, 2009 at 03:35 PM Report #263447 Posted May 12, 2009 at 03:35 PM 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
blueveia Posted May 13, 2009 at 08:40 PM Report #263955 Posted May 13, 2009 at 08:40 PM 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.
Flavio17 Posted May 14, 2009 at 12:50 PM Author Report #264123 Posted May 14, 2009 at 12:50 PM ok obrigado
Recommended Posts
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 accountSign in
Already have an account? Sign in here.
Sign In Now