View Full Version : Bingo em Vb6


PAuluska
20-01-2008, 22:13
Estou a fazer um projecto para a escola no qual tenho 90 bolas, cada uma pisca conforme fica true, mas ainda tenho um certo problema...
Eu queria que o computador tirasse todas as bolas com o mesmo tempo de intervalo e para isso teria de por com que o randimize nunca escolhesse de novo as bolas que estão em true e que passá-se logo para o próximo número. Será que me podem ajudar?

(Fica aqui o meu código)

Sub espera(t As Integer)
Timer1.Interval = t * 10
Timer1.Enabled = True
Do While Timer1.Enabled
DoEvents
Loop
End Sub

Private Sub Command1_Click()
Dim Mbolas(1 To 90) As Boolean
For I = 1 To 90
Mbolas(I) = False
Next I
Randomize
Contabola = 0
While Contabola <= 90
bola = Int((Rnd * 90) + 1)
If Not Mbolas(bola) Then
Contabolas = Contabolas + 1
Mbolas(bola) = True
End If
Mostrador.Caption = bola
For j = 1 To 100
Mostrador.Move (Left + (j + 1000))
espera (1)
Next j
Select Case bola
Case 1
Shape1.BackColor = vbYellow
Case 2
Shape2.BackColor = vbYellow
Case 3
Shape3.BackColor = vbYellow
Case 4
Shape4.BackColor = vbYellow
Case 5
Shape5.BackColor = vbYellow
Case 6
Shape6.BackColor = vbYellow
Case 7
Shape7.BackColor = vbYellow
Case 8
Shape8.BackColor = vbYellow
Case 9
Shape9.BackColor = vbYellow
Case 10
Shape10.BackColor = vbYellow
Case 11
Shape11.BackColor = vbYellow
Case 12
Shape12.BackColor = vbYellow
Case 13
Shape13.BackColor = vbYellow
Case 14
Shape14.BackColor = vbYellow
Case 15
Shape15.BackColor = vbYellow
Case 16
Shape16.BackColor = vbYellow
Case 17
Shape17.BackColor = vbYellow
Case 18
Shape18.BackColor = vbYellow
Case 19
Shape19.BackColor = vbYellow
Case 20
Shape20.BackColor = vbYellow
Case 21
Shape21.BackColor = vbYellow
Case 22
Shape22.BackColor = vbYellow
Case 23
Shape23.BackColor = vbYellow
Case 24
Shape24.BackColor = vbYellow
Case 25
Shape25.BackColor = vbYellow
Case 26
Shape26.BackColor = vbYellow
Case 27
Shape27.BackColor = vbYellow
Case 28
Shape28.BackColor = vbYellow
Case 29
Shape29.BackColor = vbYellow
Case 30
Shape30.BackColor = vbYellow
Case 31
Shape31.BackColor = vbYellow
Case 32
Shape32.BackColor = vbYellow
Case 33
Shape33.BackColor = vbYellow
Case 34
Shape34.BackColor = vbYellow
Case 35
Shape35.BackColor = vbYellow
Case 36
Shape36.BackColor = vbYellow
Case 37
Shape37.BackColor = vbYellow
Case 38
Shape38.BackColor = vbYellow
Case 39
Shape39.BackColor = vbYellow
Case 40
Shape40.BackColor = vbYellow
Case 41
Shape41.BackColor = vbYellow
Case 42
Shape42.BackColor = vbYellow
Case 43
Shape43.BackColor = vbYellow
Case 44
Shape44.BackColor = vbYellow
Case 45
Shape45.BackColor = vbYellow
Case 46
Shape46.BackColor = vbYellow
Case 47
Shape47.BackColor = vbYellow
Case 48
Shape48.BackColor = vbYellow
Case 49
Shape49.BackColor = vbYellow
Case 50
Shape50.BackColor = vbYellow
Case 51
Shape51.BackColor = vbYellow
Case 52
Shape52.BackColor = vbYellow
Case 53
Shape53.BackColor = vbYellow
Case 54
Shape54.BackColor = vbYellow
Case 55
Shape55.BackColor = vbYellow
Case 56
Shape56.BackColor = vbYellow
Case 57
Shape57.BackColor = vbYellow
Case 58
Shape58.BackColor = vbYellow
Case 59
Shape59.BackColor = vbYellow
Case 60
Shape60.BackColor = vbYellow
Case 61
Shape61.BackColor = vbYellow
Case 62
Shape62.BackColor = vbYellow
Case 63
Shape63.BackColor = vbYellow
Case 64
Shape64.BackColor = vbYellow
Case 65
Shape65.BackColor = vbYellow
Case 66
Shape66.BackColor = vbYellow
Case 67
Shape67.BackColor = vbYellow
Case 68
Label68.BackColor = vbYellow
Case 69
Shape69.BackColor = vbYellow
Case 70
Shape70.BackColor = vbYellow
Case 71
Shape71.BackColor = vbYellow
Case 72
Shape72.BackColor = vbYellow
Case 73
Shape73.BackColor = vbYellow
Case 74
Shape74.BackColor = vbYellow
Case 75
Shape75.BackColor = vbYellow
Case 76
Shape76.BackColor = vbYellow
Case 77
Shape77.BackColor = vbYellow
Case 78
Shape78.BackColor = vbYellow
Case 79
Shape79.BackColor = vbYellow
Case 80
Shape80.BackColor = vbYellow
Case 81
Shape81.BackColor = vbYellow
Case 82
Shape82.BackColor = vbYellow
Case 83
Shape83.BackColor = vbYellow
Case 84
Shape84.BackColor = vbYellow
Case 85
Shape85.BackColor = vbYellow
Case 86
Shape86.BackColor = vbYellow
Case 87
Shape87.BackColor = vbYellow
Case 88
Shape88.BackColor = vbYellow
Case 89
Shape89.BackColor = vbYellow
Case 90
Shape90.BackColor = vbYellow
End Select
Wend
End Sub

Private Sub Timer1_Timer()
Timer1.Enabled = False
End Sub

naoliveira
21-01-2008, 13:55
Para começar altera as tuas shapes para um array de shapes, depois em vez de usares 90 case fazes apenas isto:
Shape(x).BackColor = vbYellow ' x corresponde à bola saída

Para não voltar a repetir as bolas saídas podes fazer de, pelo menos, 2 maneiras, uma é criar uma array de 90 posições e a 1ª coisa que fazes é 'randomizar' as bolas dentro dessas 90 posições (em vez de a posição 1 corresponder à bola 1, vai antes crresponder a outra bola aleatória) depois é só sacares as bolas por ordem da array:


Dim arrBolas(1 To 90) As Boolean
'aqui fazes o randomize das bolas, não é difícil
Dim Mbolas(1 To 90) As Boolean
For I = 1 To 90
Mbolas(I) = False
Next I
Randomize
dim intProximaBola as integer
' aqui começa a exteracção das bolas, que vai demorar sempre o mesmo tempo
for intProximaBola = 1 to 90
' array com as bolas sorteadas aleatóriamente
Bola = arrBolas(intProximaBola )
Mbolas(Bola) = True
' isto não sei o que faz, por isso deixei como estava
Mostrador.Caption = bola
For j = 1 To 100
Mostrador.Move (Left + (j + 1000))
espera (1)
Next j
' depois de passares as shapes para um array é só fazeres isto
Shape(Bola).BackColor = vbYellow
next intProximaBola
outra opção é trocares a bola saída sempre com a última posição da array, por exemplo, tens a array ordenada de 1 a 90, fazes o randomize entre 1 e 90, se sair o 37, trocas o 37 com o 90 e a seguir fazes o randomize entre o 1 e o 89, sai o 23, trocas o 23 com o 89, etc, etc, etc.


Dim arrBolas(1 To 90) As Boolean
Dim Mbolas(1 To 90) As Boolean
For I = 1 To 90
Mbolas(I) = False
arrBolas(I) = I
Next I
Randomize
Contabola = 0
for Contabola = 90 to 1 step -1
bola = Int((Rnd * Contabola) + 1) ' gera nº entre 1 e Contabola
bola = arrBolas (bola)
Mbolas(bola) = True
' trocas as posições, usa uma variável auxilar
aux = arrBoas(Contabola) ' última posição ainda não mexida
arrBolas (Contabola) = arr(Bola)
arrBolas (Bola) = aux
Mostrador.Caption = bola
For j = 1 To 100
Mostrador.Move (Left + (j + 1000))
espera (1)
Next j
' depois de passares as shapes para um array é só fazeres isto
Shape(Bola).BackColor = vbYellow
Next Contabola
Eu prefiro a 1ª opção. Se estudares bem o algoritmo acho que consegues faze-lo só com um array.

PAuluska
28-01-2008, 13:01
A ideia do 2º algoritmo não parece má, no entanto e posso não ter percebido bem, fiquei com a ideia que desse modo as ultimas bolas saem sempre primeiro em detrimento das primeiras bolas

A ideia mesmo é marcar as bolas falsas (as que não saíram ainda) e à medida que forem saindo passam a verdadeiras.
o Programa só mostra as bolas falsa.
Se a bola saída aleatoriamente for verdadeira (já saiu) então ele vai apresentar a PRÓXIMA falsa (passando essa a verdadeira)

O professor da PAuluska

PAuluska
10-03-2008, 13:06
'Uma das possíveis soluções
'põe os 90 elementos da matriz como falsos

For I = 0 To 89
mBolas(I) = False
Next I
Randomize
ContaBolas = 0

'Enquanto não tirar as 90 bolas
While ContaBolas <= 89
'tira um indice aleatório
Indice = Int((Rnd * 89) + 1)
'só sai quando a bola ainda não tiver saído
'senão vai passar ao índice seguinte
Do
Indice = Indice + 1
'faz o vector circular
If Indice = 90 Then Indice = 0
Loop Until Not mBolas(Indice)
'mostra a bola sorteada
Mostrador.Caption = Indice
'marca no vector a bola como já saída
mBolas(Indice) = True
ContaBolas = ContaBolas + 1
Wend