I know vb 6.0 is ancient history but i like using it.. always have.
My question is that i have a timer and a textbox.. i have the timer set to 250 interval.. i can get it to produce 20 random numbers.. but i cannot get it to produce 20 unique random numbers.. it must pick 20 unique numbers from 1 to 80.
when you quote a post could you please do it via the "Reply With Quote" button or if it multiple post click the "''+" button then "Reply With Quote" button.
If this thread is finished with please mark it "Resolved" by selecting "Mark thread resolved" from the "Thread tools" drop-down menu. https://get.cryptobrowser.site/30/4111672
i'm not using picture boxes.. i am using an array of command boxes... incase anyone was curious as to how i was doing this.. the buttons are graphical with just colors.. i have the sounds and all.. just the unique 20 random numbers is the problem...
Private Function RndMath1() As Integer
Dim a As Integer
Randomize
a = Int(Rnd * 80 + 1)
Text1.Text = a
If a = 1 And Command2(1).BackColor = &H8000000F Then 'MISS
Command2(1).BackColor = &HFF&
Else
If a = 1 And Command2(1).BackColor = &H80FF& Then 'HIT
Command2(1).BackColor = &HFF00&
Call HIT 'Play hit sound
End If
End If
If a = 2 And Command2(2).BackColor = &H8000000F Then 'MISS
Command2(2).BackColor = &HFF&
Else
If a = 2 And Command2(2).BackColor = &H80FF& Then 'HIT
Command2(2).BackColor = &HFF00&
Call HIT
End If
End If
If a = 3 And Command2(3).BackColor = &H8000000F Then 'MISS
Command2(2).BackColor = &HFF&
Else
If a = 3 And Command2(3).BackColor = &H80FF& Then 'HIT
Command2(3).BackColor = &HFF00&
Call HIT
End If
End If
If a = 4 And Command2(4).BackColor = &H8000000F Then 'MISS
Command2(4).BackColor = &HFF&
Else
If a = 4 And Command2(4).BackColor = &H80FF& Then 'HIT
Command2(4).BackColor = &HFF00&
Call HIT
End If
End If
If a = 5 And Command2(5).BackColor = &H8000000F Then 'MISS
Command2(5).BackColor = &HFF&
Else
If a = 5 And Command2(5).BackColor = &H80FF& Then 'HIT
Command2(5).BackColor = &HFF00&
Call HIT
End If
End If
If a = 6 And Command2(6).BackColor = &H8000000F Then 'MISS
Command2(6).BackColor = &HFF&
Else
If a = 6 And Command2(6).BackColor = &H80FF& Then 'HIT
Command2(6).BackColor = &HFF00&
Call HIT
End If
End If
If a = 7 And Command2(7).BackColor = &H8000000F Then 'MISS
Command2(7).BackColor = &HFF&
Else
If a = 7 And Command2(7).BackColor = &H80FF& Then 'HIT
Command2(7).BackColor = &HFF00&
Call HIT
End If
End If
If a = 8 And Command2(8).BackColor = &H8000000F Then 'MISS
Command2(2).BackColor = &HFF&
Else
If a = 8 And Command2(8).BackColor = &H80FF& Then 'HIT
Command2(8).BackColor = &HFF00&
Call HIT
End If
End If
If a = 9 And Command2(9).BackColor = &H8000000F Then 'MISS
Command2(4).BackColor = &HFF&
Else
If a = 9 And Command2(9).BackColor = &H80FF& Then 'HIT
Command2(9).BackColor = &HFF00&
Call HIT
End If
End If
If a = 10 And Command2(10).BackColor = &H8000000F Then 'MISS
Command2(5).BackColor = &HFF&
Else
If a = 10 And Command2(10).BackColor = &H80FF& Then 'HIT
Command2(10).BackColor = &HFF00&
Call HIT
End If
End If
If a = 11 And Command2(11).BackColor = &H8000000F Then 'MISS
Command2(11).BackColor = &HFF&
Else
If a = 11 And Command2(11).BackColor = &H80FF& Then 'HIT
Command2(11).BackColor = &HFF00&
Call HIT
End If
End If
If a = 12 And Command2(12).BackColor = &H8000000F Then 'MISS
Command2(12).BackColor = &HFF&
Else
If a = 2 And Command2(2).BackColor = &H80FF& Then 'HIT
Command2(12).BackColor = &HFF00&
Call HIT
End If
End If
If a = 13 And Command2(13).BackColor = &H8000000F Then 'MISS
Command2(13).BackColor = &HFF&
Else
If a = 13 And Command2(13).BackColor = &H80FF& Then 'HIT
Command2(13).BackColor = &HFF00&
Call HIT
End If
End If
If a = 14 And Command2(14).BackColor = &H8000000F Then 'MISS
Command2(14).BackColor = &HFF&
Else
If a = 14 And Command2(14).BackColor = &H80FF& Then 'HIT
Command2(14).BackColor = &HFF00&
Call HIT
End If
End If
If a = 15 And Command2(15).BackColor = &H8000000F Then 'MISS
Command2(15).BackColor = &HFF&
Else
If a = 15 And Command2(15).BackColor = &H80FF& Then 'HIT
Command2(15).BackColor = &HFF00&
Call HIT
End If
End If
If a = 16 And Command2(16).BackColor = &H8000000F Then 'MISS
Command2(16).BackColor = &HFF&
Else
If a = 16 And Command2(16).BackColor = &H80FF& Then 'HIT
Command2(16).BackColor = &HFF00&
Call HIT
End If
End If
If a = 17 And Command2(17).BackColor = &H8000000F Then 'MISS
Command2(17).BackColor = &HFF&
Else
If a = 17 And Command2(17).BackColor = &H80FF& Then 'HIT
Command2(17).BackColor = &HFF00&
Call HIT
End If
End If
If a = 18 And Command2(18).BackColor = &H8000000F Then 'MISS
Command2(18).BackColor = &HFF&
Else
If a = 18 And Command2(18).BackColor = &H80FF& Then 'HIT
Command2(18).BackColor = &HFF00&
Call HIT
End If
End If
If a = 19 And Command2(19).BackColor = &H8000000F Then 'MISS
Command2(19).BackColor = &HFF&
Else
If a = 19 And Command2(19).BackColor = &H80FF& Then 'HIT
Command2(19).BackColor = &HFF00&
Call HIT
End If
End If
If a = 20 And Command2(20).BackColor = &H8000000F Then 'MISS
Command2(17).BackColor = &HFF&
Else
If a = 20 And Command2(20).BackColor = &H80FF& Then 'HIT
Command2(20).BackColor = &HFF00&
Call HIT
End If
End If
If a = 21 And Command2(21).BackColor = &H8000000F Then 'MISS
Command2(21).BackColor = &HFF&
Else
If a = 21 And Command2(21).BackColor = &H80FF& Then 'HIT
Command2(21).BackColor = &HFF00&
Call HIT
End If
End If
RndMath1 = z
Text2.Text = Text2.Text + 1
If Text2.Text = 20 Then
Timer1.Enabled = False
End If
End Function
Private Sub Command1_Click()
Timer1.Enabled = True
End Sub
Private Sub Command2_Click(Index As Integer)
'Lets's pick out numbers
If Command2(Index).BackColor = &H8000000F Then 'change back color if we selected a number
Command2(Index).BackColor = &H80FF& 'change it's backcolor to show we picked that number
Text3.Text = Text3.Text + 1
Else
'If we change our mind on a number
Command2(Index).BackColor = &H8000000F 'set button to default color
Text3.Text = Text3.Text - 1
End If
If Text3.Text = 20 Then
Command1.Enabled = True
Else
Command1.Enabled = False 'hmmmmmmmmmmmmmmmmmmmmmmmmm
End If
Command2(0).SetFocus
End Sub
Private Sub Timer1_Timer()
z = RndMath1 'draw a new number every 1/2 second
End Sub
Private Function HIT()
res = sndPlaySound("doublepoint.wav", SND_ASYNC) 'Play this sound if a number you picked was drawn
End Function
i'm not using picture boxes.. i am using an array of command boxes... incase anyone was curious as to how i was doing this.. the buttons are graphical with just colors.. i have the sounds and all.. just the unique 20 random numbers is the problem...
Read posts #1, #4, #10 and #13 they should provide all the help you need. The example in post #20 might give you an idea too.
when you quote a post could you please do it via the "Reply With Quote" button or if it multiple post click the "''+" button then "Reply With Quote" button.
If this thread is finished with please mark it "Resolved" by selecting "Mark thread resolved" from the "Thread tools" drop-down menu. https://get.cryptobrowser.site/30/4111672
Here try this and modify as you need, let me know if you don't understand something.
Pretty simple, start new project add this code (no controls).
Code:
Option Explicit
Dim WithEvents Command1 As CommandButton
Dim WithEvents List1 As ListBox
Private Function RndNumArr(FromNumber As Integer, ToNumber As Integer, ArraySize As Integer) As Integer()
Dim RndCol As New Collection
Dim RndArr() As Integer
Dim RndNum As Integer
Dim i As Integer
Randomize
ReDim RndArr(ArraySize - 1)
For i = FromNumber To ToNumber
RndCol.Add CStr(i)
Next
For i = 0 To ArraySize - 1
RndNum = ((RndCol.Count - 1) - FromNumber + 1) * Rnd + FromNumber
RndArr(i) = RndCol.Item(RndNum)
RndCol.Remove RndNum
Next
RndNumArr = RndArr
End Function
Private Sub Command1_Click()
Dim i As Integer
Dim j As Integer
Dim Unique_Number() As Integer
Unique_Number = RndNumArr(1, 80, 20)
List1.Clear
For i = 0 To 19 'Show your 20 unique numbers
List1.AddItem Unique_Number(i)
Next
'Simple test to see if any two numbers are the same
For i = 0 To 19
For j = 0 To 19
If i <> j Then If List1.List(i) = List1.List(j) Then MsgBox "Error Same Number Found!"
Next
Next
End Sub
Private Sub Form_Load()
Me.Move 500, 500, 3000, 10000
Set List1 = Controls.Add("VB.ListBox", "List1")
With List1
.Move 0, 0, 2000, 8000
.Visible = True
End With
Set Command1 = Controls.Add("VB.CommandButton", "Command1")
With Command1
.Move 0, 8000, 2000, 800
.Caption = "Randomize Numbers"
.Visible = True
End With
End Sub
Your functions above should be subs since they do not return anything.
when you quote a post could you please do it via the "Reply With Quote" button or if it multiple post click the "''+" button then "Reply With Quote" button.
If this thread is finished with please mark it "Resolved" by selecting "Mark thread resolved" from the "Thread tools" drop-down menu. https://get.cryptobrowser.site/30/4111672
but i am not looking for a listbox type of thing.. nightwalker has a good project going.. similar to what i intended... i already tweaked it to what i am looking to do... his project just seems to have one issue i cannot tweak... hoping he will do so for me so i can complete it.
when you quote a post could you please do it via the "Reply With Quote" button or if it multiple post click the "''+" button then "Reply With Quote" button.
If this thread is finished with please mark it "Resolved" by selecting "Mark thread resolved" from the "Thread tools" drop-down menu. https://get.cryptobrowser.site/30/4111672
You could modify the code in the OP to use a loop and reduce the amount of code quite a bit
Code:
If a = 1 And Command2(1).BackColor = &H8000000F Then 'MISS
Command2(1).BackColor = &HFF&
Else
If a = 1 And Command2(1).BackColor = &H80FF& Then 'HIT
Command2(1).BackColor = &HFF00&
Call HIT 'Play hit sound
End If
End If
If this were in a loop using a index var then you could get rid of the next 20 copies of that bit of code.
Something like
Code:
Dim X As Integer
For X = 1 To 21
If a = X And Command2(X).BackColor = &H8000000F Then 'MISS
Command2(X).BackColor = &HFF&
Else
If a = X And Command2(X).BackColor = &H80FF& Then 'HIT
Command2(X).BackColor = &HFF00&
Call HIT 'Play hit sound
End If
End If
Next
[/code]Dim X As Integer
For X = 1 To 21
If a = X And Command2(X).BackColor = &H8000000F Then 'MISS
Command2(X).BackColor = &HFF&
Else
If a = X And Command2(X).BackColor = &H80FF& Then 'HIT
Command2(X).BackColor = &HFF00&
Call HIT 'Play hit sound
End If
End If
Next[/code]
works well.. ty... just need to the unique 20 random numbers from 1 to 80 now...
If you do indeed have 80 buttons named Command2() indexed 0 to 80, with the Command2(0) doing the focus thing, then this code should work for you.
Note: RollNumbers
Code:
Private Function RndNumArr(FromNumber As Integer, ToNumber As Integer, ArraySize As Integer) As Integer()
Dim RndCol As New Collection
Dim RndArr() As Integer
Dim RndNum As Integer
Dim i As Integer
Randomize
ReDim RndArr(ArraySize - 1)
For i = FromNumber To ToNumber
RndCol.Add CStr(i)
Next
For i = 0 To ArraySize - 1
RndNum = ((RndCol.Count - 1) - FromNumber + 1) * Rnd + FromNumber
RndArr(i) = RndCol.Item(RndNum)
RndCol.Remove RndNum
Next
RndNumArr = RndArr
End Function
Private Sub RollNumbers() As Integer
Dim UniqueNumber() As Integer
Dim iNumber As Integer
Dim iButton As Integer
UniqueNumber = RndNumArr
For iNumber = 0 To 19
For iButton = 1 To 80
If iNumber = UniqueNumber(iNumber) Then
command2(iNumber).BackColor = &HFF& 'Miss
Else
command2(iNumber).BackColor = &HFF00& 'Hit
Call HIT
End If
Next iButton
Next iNumber
End Sub
All in one Sub.
Code:
Private Sub RollNumbers()
Dim RndCol As New Collection
Dim RndArr() As Integer
Dim RndNum As Integer
Dim i As Integer
Dim j As Integer
Randomize
ReDim RndArr(19)
'Randomize Numbers (20 unique numbers)
For i = 1 To 80
RndCol.Add CStr(i)
Next
For i = 0 To 19
RndNum = (RndCol.Count - 1) * Rnd + 1
RndArr(i) = RndCol.Item(RndNum)
RndCol.Remove RndNum
Next
'Check which unique number was picked
For i = 1 To 80
command2(j).BackColor = &HFF& 'Miss
For j = 0 To 19
If RndArr(j) = i Then
command2(i).BackColor = &HFF00& 'Hit
Call Hit
Exit For
End If
Next
Next
End Sub
All you need to code is your timer code, with this you should be able to figure it out. Everything is there.
Last edited by Max187Boucher; May 24th, 2014 at 11:11 PM.
you'll see the rnd fuction and timer1 coding... the timer draws the numbers into a textbox... i have no problem doing.. it's just they are not unique...
when you quote a post could you please do it via the "Reply With Quote" button or if it multiple post click the "''+" button then "Reply With Quote" button.
If this thread is finished with please mark it "Resolved" by selecting "Mark thread resolved" from the "Thread tools" drop-down menu. https://get.cryptobrowser.site/30/4111672
Here's a pretty much complete Keno game I wrote when I was helping out isnoend with his version of the game some time ago. I just did it for fun so there aren't extensive comments and you'll have to figure out how to play it but you can bet on multiple cards, have random selections made for you etc. Oh, and there are configuration options to adjust payout odds to match well-known casinos
Take from it what you like...
If you don't know where you're going, any road will take you there...
Private Sub Timer1_Timer()
Static UniqueNumber() As Integer
Static i As Integer
Dim j As Integer
If i = 0 Then UniqueNumber = RndNumArr(1, 80, 20)
Debug.Print UniqueNumber(i)
For j = 1 To 80
If j = UniqueNumber(i) Then
Command2(j - 1).BackColor = vbGreen
'Hit 'Play sound
End If
Next
i = i + 1
If i = 20 Then
i = 0
Timer1.Enabled = False
MsgBox "Game Over"
End If
End Sub
The 20 in red is actually 21 in my keno(updated), just change it to 20 like the code above.
got the buttons how i want them, working the way i want them, added the hit sound... now working on the cash/betting part. after that will be the wins and such..
If this thread is finished with please mark it "Resolved" by selecting "Mark thread resolved" from the "Thread tools" drop-down menu.
when you quote a post could you please do it via the "Reply With Quote" button or if it multiple post click the "''+" button then "Reply With Quote" button.
If this thread is finished with please mark it "Resolved" by selecting "Mark thread resolved" from the "Thread tools" drop-down menu. https://get.cryptobrowser.site/30/4111672
Did this function somehow get overlooked in the code I posted?
Code:
Public Function GetRandomPicks(pNumberOfPicks As Integer, pSampleSize As Integer) As Integer()
Dim thesePicks() As Integer
Dim Sample() As Integer
Dim i As Integer, thisIndex As Integer
ReDim thesePicks(1 To pNumberOfPicks)
ReDim Sample(1 To pSampleSize)
'start with a straight sequence of numbers from 1 to SampleSize
For i = 1 To pSampleSize
Sample(i) = i
Next i
'shuffle them about so that the upper part of the sample contains the random numbers chosen...
For i = 1 To pNumberOfPicks
Randomize
thisIndex = Int(((pSampleSize - i) * Rnd) + 1)
thesePicks(i) = Sample(thisIndex)
Sample(thesePicks(i)) = pSampleSize + 1 - i
Next i
GetRandomPicks = thesePicks
End Function
Returns an array of X unique picks from a sample of Y possible numbers....
If you don't know where you're going, any road will take you there...
when you quote a post could you please do it via the "Reply With Quote" button or if it multiple post click the "''+" button then "Reply With Quote" button.
If this thread is finished with please mark it "Resolved" by selecting "Mark thread resolved" from the "Thread tools" drop-down menu. https://get.cryptobrowser.site/30/4111672
having a blast at this old topic.. no really i am... i seen this when it started and where it went.. it went well btw. it was a slow process at first but it blew up bigger than expected.. more involved.. shame the project ended after the release.. was hoping for upgrades and such.. oh well - wow, it's been that long? really? wow!