1. Este site usa cookies. Ao continuar a usar este site está a concordar com o nosso uso de cookies. Saber Mais.

Bingo em Vb6

Discussão em 'Programação' iniciada por PAuluska, 20 de Janeiro de 2008. (Respostas: 3; Visualizações: 2077)

  1. 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
     
  2. naoliveira

    naoliveira Power Member

    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:

    Código:
    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.

    Código:
    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.
     
  3. 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
     
  4. '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
     

Partilhar esta Página