|
-
Apr 1st, 2022, 08:13 PM
#1
Thread Starter
New Member
I need help with turning an If statement to a select case statement
I am working on a slot machine project in vb6. I am trying to figure out how to change this:
If (a = 1 And b = 1 And c <> 1) Or (a = 1 And c = 1 And b <> 1) Or (b = 1 And c = 1 And a <> 1) Or _
(a = 2 And b = 2 And c <> 2) Or (a = 2 And c = 2 And b <> 2) Or (b = 2 And c = 2 And a <> 2) Or _
(a = 4 And b = 4 And c <> 4) Or (a = 4 And c = 4 And b <> 4) Or (b = 4 And c = 4 And a <> 4) Or _
(a <> 1 And b = 1 And c = 1) Or (b <> 1 And c = 1 And a = 1) Or (c <> 1 And b = 1 And a = 1) Or _
(a <> 2 And b = 2 And c = 2) Or (b <> 2 And c = 2 And a = 2) Or (c <> 2 And b = 2 And a = 2) Or _
(a <> 4 And b = 4 And c = 4) Or (b <> 4 And c = 4 And a = 4) Or (c <> 4 And b = 4 And a = 4) Then
into a select case statement if possible. I am very new to programming but have come a good way. I am using the Rnd function to come up with 3 random numbers which associates itself to 3 different pictures out of 30 pictures. The problem is that when I program all the losing numbers to deduct money or whatever that there's to many combinations of the above code to put in an If Then statement. Would anybody have a suggestion or show me the way I would put it in a select case statement? I got the slot machine game to work good but it misses a majority because I don't kno how to catch them all properly.
-
Apr 2nd, 2022, 09:10 AM
#2
Re: I need help with turning an If statement to a select case statement
I can't be sure what is going on there but you may want to consider nested select case or nested if statements.
Code:
If a=1 then
If b=1 and c<>1 or ....
else if a=2 then
if b=1 and ....
.....
End If
Select case A
Case 1
Select Case B
case 1
case 2
Case else
End Select
Case 2
Case 3
End Select
That said from the sound of yoru description I think you may be going about this backwards. You say you are trying to calculate all the loosing numbers but what about calculating the winning numbers. That if statement treats all those combinations the same so they are all losers but what abotu just finding the winning values and if they are not winners then they are loosers.
-
Apr 2nd, 2022, 09:32 AM
#3
Re: I need help with turning an If statement to a select case statement
I wish I still had my old slot machine program I built circa 2000. It was pretty cool...used it in lieu of real slots for an annual "Casino Night" party (ended up purchasing 3 slot machines from Texas around 2007---and built my own craps, roulette and poker tables (unfortunately, along with the slot machine program I built being lost due to a house fire (2005), I sold all my Casino stuff before moving to my current location.
Good luck with the program...I enjoyed mine.
Sam I am (as well as Confused at times).
-
Apr 2nd, 2022, 06:24 PM
#4
Re: I need help with turning an If statement to a select case statement
I know this probably isn't what you're thinking, but you've got a single condition, so an IF statement is the correct way to do it. However, this will do the same thing:
Code:
Select Case True
Case (a = 1 And b = 1 And c <> 1) Or (a = 1 And c = 1 And b <> 1) Or (b = 1 And c = 1 And a <> 1) Or _
(a = 2 And b = 2 And c <> 2) Or (a = 2 And c = 2 And b <> 2) Or (b = 2 And c = 2 And a <> 2) Or _
(a = 4 And b = 4 And c <> 4) Or (a = 4 And c = 4 And b <> 4) Or (b = 4 And c = 4 And a <> 4) Or _
(a <> 1 And b = 1 And c = 1) Or (b <> 1 And c = 1 And a = 1) Or (c <> 1 And b = 1 And a = 1) Or _
(a <> 2 And b = 2 And c = 2) Or (b <> 2 And c = 2 And a = 2) Or (c <> 2 And b = 2 And a = 2) Or _
(a <> 4 And b = 4 And c = 4) Or (b <> 4 And c = 4 And a = 4) Or (c <> 4 And b = 4 And a = 4)
'
' Do your work.
'
End Select
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
-
Apr 2nd, 2022, 07:16 PM
#5
Re: I need help with turning an If statement to a select case statement
No idea how "win" and "lose" are defined. Spelling that out in concise and logical prose should help lead to a simple answer.
But there is always:
Code:
Option Explicit
Private Sub Command1_Click()
Dim A As Byte
Dim B As Byte
Dim C As Byte
A = Int(Rnd() * 10)
B = Int(Rnd() * 10)
C = Int(Rnd() * 10)
lblA.Caption = CStr(A)
lblB.Caption = CStr(B)
lblC.Caption = CStr(C)
If A = B And B = C Then
lblResult.Caption = "3 same"
ElseIf A = B Or B = C Or C = A Then
lblResult.Caption = "2 same"
Else
lblResult.Caption = "NONE same"
End If
End Sub
Private Sub Form_Load()
Randomize
End Sub
-
Apr 3rd, 2022, 11:03 AM
#6
Re: I need help with turning an If statement to a select case statement
A select case statement won’t help.
You need to figure out a way to flatten the logic
What is the core concept you want to check for?
I assume you are looking for All 3 values the same
and if not show a lose message?
could it be as simple as if a= B and a=c then win else lose?
Without caring if the actually value was 1-x at the initial stage.
a wild card would make it a little more tricky but I didnt see evidence of one in your code.
Then once you decided you have a win do further calculations.
Or once you know it’s a loss then you could do a simple test to see which one didn’t match etc
Break it down into simple logical steps anyway
Last edited by dz32; Apr 3rd, 2022 at 11:31 AM.
-
Apr 3rd, 2022, 11:32 AM
#7
Re: I need help with turning an If statement to a select case statement
I don't know if the numbers are powers of 2 or not, however here I offer both solutions.
Code:
Private Sub Form_Click()
Dim a&, b&, c&
Dim N&
Dim I&, J&
Dim R&
Dim Win As Boolean
N = 4
'-------------------------------- Comment this or below (case Numbers are 1 to N)
' a = (1 + Int(Rnd * N))
' b = (1 + Int(Rnd * N))
' c = (1 + Int(Rnd * N))
' Win = (a = b) And (b = c)
' If Win Then J = a
'-------------------------------- Comment this or above (case Numbers are Power of 2)
a = 2 ^ ( Int(Rnd * N))
b = 2 ^ ( Int(Rnd * N))
c = 2 ^ ( Int(Rnd * N))
If ((a And b) And c) Then Win = True: J = a
'-----------------------------------------
Print a, b, c, Win, J
End Sub
Private Sub Form_Load()
Randomize Timer
End Sub
Last edited by reexre; Apr 3rd, 2022 at 11:49 AM.
-
Apr 3rd, 2022, 11:45 AM
#8
Re: I need help with turning an If statement to a select case statement
 Originally Posted by Elroy
I know this probably isn't what you're thinking, but you've got a single condition, so an IF statement is the correct way to do it. However, this will do the same thing:
Code:
Select Case True
Case (a = 1 And b = 1 And c <> 1) Or (a = 1 And c = 1 And b <> 1) Or (b = 1 And c = 1 And a <> 1) Or _
(a = 2 And b = 2 And c <> 2) Or (a = 2 And c = 2 And b <> 2) Or (b = 2 And c = 2 And a <> 2) Or _
(a = 4 And b = 4 And c <> 4) Or (a = 4 And c = 4 And b <> 4) Or (b = 4 And c = 4 And a <> 4) Or _
(a <> 1 And b = 1 And c = 1) Or (b <> 1 And c = 1 And a = 1) Or (c <> 1 And b = 1 And a = 1) Or _
(a <> 2 And b = 2 And c = 2) Or (b <> 2 And c = 2 And a = 2) Or (c <> 2 And b = 2 And a = 2) Or _
(a <> 4 And b = 4 And c = 4) Or (b <> 4 And c = 4 And a = 4) Or (c <> 4 And b = 4 And a = 4)
'
' Do your work.
'
End Select
Well it is written as a single condition in a manner of speaking but it is really a bunch of conditions in one line all of which end up giving a single result. My guess is that the reason the OP is asking for a select case is that he/she wants to add more and has exceeded the max line length.
This could be done with a select case something like
Code:
Select Case True
Case (a = 1 And b = 1 And c <> 1)
Case (a = 1 And c = 1 And b <> 1)
' and so on
End Select
Nesting may be a better option or a nested If ElseIf structure but I think the bottom line and best approach is to use different logic from the get go. Calculate the winning values of which there are probably far fewer and if it is not a winner then it is a looser.
-
Apr 3rd, 2022, 12:48 PM
#9
Fanatic Member
Re: I need help with turning an If statement to a select case statement
I'm with others on this, a 6-line if/then is extreme overkill...if we're assuming the values of A/B/C correspond to different symbols then simply checking to see if A=B is enough for a 2-symbol match and then checking if B=C is enough for a 3-symbol match. If you're going to provide only limited 2-symbol matches (for instance, allowing 1 or 2 cherries but not 1 or 2 bells), there'll be ways to account for that for each symbol type using logic. Two checks, first one calculates match length and second one calculates if that symbol pays out for that level of matching.
There's 18 comparisons (technically 54, 3 in each block) being done with the original if/then, but if you check if A=B and B=C (and only check if B=C *if* A=B is successful, so a nested if/then) that's just two, followed by a referencing of that symbol against an array which tells you what payout you get from that symbol at that match length. If the array says 0, there's no payout. If you had 12 different symbols (fruit machines generally have 6) and 3 reels, then payout(12,3) could store a single for each payout in each case and it would be easy to reference to check.
VERY quick bit of pseudocode (writing it in here rather than in VB) but here's what I mean:
Code:
dim(payout(12,3)
payout(1,1)=20:payout(1,2)=50:payout(1,3)=100
payout(2,1)=0:payout(2,2)=0:payout(2,3)=200
'(Add more values here...this is just an example)
match=1
If A=B then
match=2
if B=C then
match=3
end if
end if
paid = payout(a,match)
This basically uses the first reel's value to determine what the symbol is (obviously reels are more complicated than that, they're random to an extent...it's just an example) and uses the nested if/then to determine the length of the match...then "paid" gets the total payout amount from the array
-
Apr 3rd, 2022, 05:31 PM
#10
Re: I need help with turning an If statement to a select case statement
Arizonasworld85, maybe this'll help.
I sometimes use a Select Case statement for "exclusion" rather than actual multiple action tests. For example ...
Code:
' uMsg is a Long.
Select Case uMsg
Case 132, 512, 513 ' Ignore these.
Case 33, 32, 533 ' Also ignore these.
Case Else
' THIS is what I really want!!!
Debug.Print Format$(uMsg), Format$(wParam), Format$(lParam), WindowsMessage(uMsg)
End Select
... I use this Select Case to ignore certain conditions. I could ignore as many values as I wanted.
If you used "Select Case True", you could ignore any expression you wanted. To do that in your case, you'd reverse your logic (all ANDs become ORs, all = become <>, and vice-versa). But then, using this "exclude" approach, you could break it into smaller pieces (several Case tests).
IDK, you're not giving us feedback, so it's all shots in the dark.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
-
Apr 3rd, 2022, 05:43 PM
#11
Re: I need help with turning an If statement to a select case statement
Yep I was thinking that using the else portion of the select case would be an option there. You could have as many cases as needed and it would exit as soon as one is true rather than testing all of them every time and the else part only executes when all the cases fall through.
Still it seems the logic needs to be reworked and simplified. Would help if the OP actually stated clearly what the conditions for a win or loss are. When I post a question, or start to post a question I try to be as detailed as possible and more often than not I find the solution while trying to explain the problem without ever submitting the post.
-
Apr 4th, 2022, 01:28 AM
#12
Re: I need help with turning an If statement to a select case statement
Why so complicated?
He has 30 pictures.
Going by the "one-armed-bandit" those 30 pictures can appear on any of the 3 rolls.
As a precondition: each picture can only appear once on each roll.
Meaning: He has a pre-set set of "winning" permutations.
My first approach would be: calculate all possible "permutations" (which is the correct phrase! Not Combination!).
From statistics (and above presumptions) those are permutations with repeat (Remember: "7" - "7" - "7" --> Jackpot!).
Store those possible permutations somewhere (Database?)
make a second array/collection of "winning" permutations
Store them somewhere.
Run the Game.
You need a single "random" draw out of the possible results.
Compare the drawn result if it's in the winning set.
Done!
EDIT: If you don't want to store all possible permutations, i'd still keep the "winning" sets somewhere.
You could use my Lottery-algorithm in the codebank
https://www.vbforums.com/showthread....=1#post5556369
It would be a call "ResultArray=Lottery(3,30,False,True)"
EDIT 2: Another Approach:
Build all winning permutations at startup and store them in an array as a string (e.g. "7-7-7")
Do your draws, reformat the result of the draw to pattern "X-Y-Z", and use the Filter-Function on the winning-array.
If you don't have a Match, the Ubound of the Resultarray is -1
Code:
Sub main()
Dim Win(0 To 3) As String
Dim Result() As String
Win(0) = "7-7-7"
Win(1) = "10-10-10"
Win(2) = "20-20-20"
Win(3) = "30-30-30"
Result = Filter(Win, "1-2-3")
Debug.Print UBound(Result)
End Sub
EDIT 3: Or instead of an array a Collection (or Dictionary) with the "Permutation" being the Key, and a Double being the Value (indicating Winning factor e.g. "7-7-7" --> 3.5 --> Money x 3.5)
Bottom Line: The losing sets far outstrip the winning sets, so i'd check if it's a winning set. Not found is an automatic loss
Last edited by Zvoni; Apr 4th, 2022 at 02:40 AM.
Last edited by Zvoni; Tomorrow at 31:69 PM.
----------------------------------------------------------------------------------------
One System to rule them all, One Code to find them,
One IDE to bring them all, and to the Framework bind them,
in the Land of Redmond, where the Windows lie
---------------------------------------------------------------------------------
People call me crazy because i'm jumping out of perfectly fine airplanes.
---------------------------------------------------------------------------------
Code is like a joke: If you have to explain it, it's bad
-
Apr 4th, 2022, 03:19 AM
#13
Fanatic Member
Re: I need help with turning an If statement to a select case statement
Originally Posted by Zvoni
Bottom Line: The losing sets far outstrip the winning sets, so i'd check if it's a winning set. Not found is an automatic loss
Surprisingly not as true as you might believe..."1-1-1" is a win, obviously, but "1-1-2" to "1-1-30" would also be a win as so would "1-2-2" to "1-30-30"...it's a match on the first reel or first and second that complicates matters.
Oh, and it's "combinations", not "permutations"...you say it yourself, combinations are permutations with repeat...and repeating values are winners, so it *is* with repeat. I get your point (to a degree, you're right) but it is a combination which INCLUDES double and triple numbers, and no that isn't just called a permutation.
-
Apr 4th, 2022, 03:49 AM
#14
Re: I need help with turning an If statement to a select case statement
You only need one set of conditions because it doesn't matter what the actual number is:
vb Code:
If (a = b And a <> c) Or (a = c And a <> b) Or (b = c And b <> a) Then
-
Apr 4th, 2022, 04:13 AM
#15
Re: I need help with turning an If statement to a select case statement
Originally Posted by SmUX2k
Surprisingly not as true as you might believe..."1-1-1" is a win, obviously, but "1-1-2" to "1-1-30" would also be a win as so would "1-2-2" to "1-30-30"...it's a match on the first reel or first and second that complicates matters.
In that case: Store all possible Permutations (see below) in a Collection/Dictionary, the Permutation being the Key, the Money-Factor the Value
Oh, and it's "combinations", not "permutations"...you say it yourself, combinations are permutations with repeat...and repeating values are winners, so it *is* with repeat. I get your point (to a degree, you're right) but it is a combination which INCLUDES double and triple numbers, and no that isn't just called a permutation.
Combination = Order doesn't matter (e.g. "classic" Lottery)
Permutation = Order does matter (e.g. Horse race)
If it's with/without repeat doesn't matter to the definition.
So the question is: is in this context "7-20-7" equal to "7-7-20"?
EDIT:
Going by the assumption above (starting from the 1st Reel)
1st Reel has no match in the 2nd Reel no matter what's in the 3rd reel = Loss
First two Reels match, but not the third = Win of 2.5 the money
Alle three reels match =Win of 4.5 the money
Aircode
Code:
Sub main()
Dim x As Long
Dim y As Long
Dim z As Long
'Dim i as long
Dim w As String
Dim c As New Collection
'Dim c(1 To 27000, 1 To 1) As String
Result As String
'i=1
For x = 1 To 30
For y = 1 To 30
For z = 1 To 30
Select Case True
Case x <> y
w = "0"
Case x = y And y <> z
w = "2.5"
Case x = y And y = z
w = "4.5"
End Select
c.Add w, CStr(x) & "-" & CStr(y) & "-" & CStr(z)
'c(i,1)=w
'i=i+1
Next
Next
Next
'Do your draws, can be each reel for itself (Formatted to Result="X-Y-Z"), or one draw in Range 1 to 27000, then use the Index for Result
Debug.Print c(Result)
End Sub
It's easy to expand the Select Case, if e.g. 2nd+3rd Reel match constitutes a win
Code:
Sub main()
Dim x As Long
Dim y As Long
Dim z As Long
Dim w As Double
Dim c As New Collection
'Dim c(1 To 30, 1 To 30, 1 To 30) As Double
Result As String
For x = 1 To 30
For y = 1 To 30
For z = 1 To 30
Select Case True
Case x <> y And y <> z And x <> z 'All 3 reels don't match
'This is just to make it more clear.
'I know that this condition could be put to Case Else
w = 0
Case x <> y And y = z '2nd and 3rd Reel match, but not the 1st
w = 1.5
Case x = y And y <> z '1st and 2nd Reel match, but not the 3rd
w = 2.5
Case x = z And x <> y '1st and 3rd Reel match, but not the 2nd
w = 3
Case x = y And y = z 'All 3 reels match
w = 4.5
End Select
c.Add Cstr(w), CStr(x) & "-" & CStr(y) & "-" & CStr(z)
'c(x, y, z)=w
Next
Next
Next
'Do your draws, Formatted to Result="X-Y-Z" if Collection, or direct index-Access if Array
Debug.Print c(Result)
'Debug.Print c(x, y, z)
End Sub
Last edited by Zvoni; Apr 4th, 2022 at 04:57 AM.
Last edited by Zvoni; Tomorrow at 31:69 PM.
----------------------------------------------------------------------------------------
One System to rule them all, One Code to find them,
One IDE to bring them all, and to the Framework bind them,
in the Land of Redmond, where the Windows lie
---------------------------------------------------------------------------------
People call me crazy because i'm jumping out of perfectly fine airplanes.
---------------------------------------------------------------------------------
Code is like a joke: If you have to explain it, it's bad
-
Apr 4th, 2022, 05:15 AM
#16
Re: I need help with turning an If statement to a select case statement
its not the complete solution, the OP want to know if the result has 2 of the same.
but Im sure he also want to check if theres 3 of the same as well.
Code:
Select Case True
Case a = b And a = c: MsgBox "found all 3"
Case a = b, a = c, b = c: MsgBox "found 2"
End Select
so what we do is first we take the "all 3", and if thats not the case, we check if at least 2 are the same.
-
Apr 4th, 2022, 07:44 AM
#17
Re: I need help with turning an If statement to a select case statement
After thinking about it, my algorithm above could even be expanded to include a symbol appearing multiple times per reel
(say a Cherry appears 5 times on each reel vs. a "7" which appears only once).
Payout could be calculated via a "weight" of the Symbol (a Seven weighing way more than a cherry)
Last edited by Zvoni; Tomorrow at 31:69 PM.
----------------------------------------------------------------------------------------
One System to rule them all, One Code to find them,
One IDE to bring them all, and to the Framework bind them,
in the Land of Redmond, where the Windows lie
---------------------------------------------------------------------------------
People call me crazy because i'm jumping out of perfectly fine airplanes.
---------------------------------------------------------------------------------
Code is like a joke: If you have to explain it, it's bad
-
Apr 5th, 2022, 11:42 AM
#18
Thread Starter
New Member
 Re: I need help with turning an If statement to a select case statement
Originally Posted by SamOscarBrown
I wish I still had my old slot machine program I built circa 2000. It was pretty cool...used it in lieu of real slots for an annual "Casino Night" party (ended up purchasing 3 slot machines from Texas around 2007---and built my own craps, roulette and poker tables (unfortunately, along with the slot machine program I built being lost due to a house fire (2005), I sold all my Casino stuff before moving to my current location.
Good luck with the program...I enjoyed mine.
Thanks everyone! Yeah I am really enjoying this little project. I am new to programming, but really love what I have learned so far! The IF then statement I have above is just one section that checks for Matches. I just want some different opinions.
-
Apr 5th, 2022, 11:53 AM
#19
Thread Starter
New Member
Re: I need help with turning an If statement to a select case statement
Originally Posted by DataMiser
Well it is written as a single condition in a manner of speaking but it is really a bunch of conditions in one line all of which end up giving a single result. My guess is that the reason the OP is asking for a select case is that he/she wants to add more and has exceeded the max line length.
This could be done with a select case something like
Code:
Select Case True
Case (a = 1 And b = 1 And c <> 1)
Case (a = 1 And c = 1 And b <> 1)
' and so on
End Select
Nesting may be a better option or a nested If ElseIf structure but I think the bottom line and best approach is to use different logic from the get go. Calculate the winning values of which there are probably far fewer and if it is not a winner then it is a looser.
Yes it is many conditions. When I tried to code ALL the losers VB6 gave me a message saying it was too complicated and would shutdown on me. So I am trying to find ideas and get opinions of different better ways. Any knowledge, replies, help, anything is greatly appreciated. I have tried google and many other search engines trying to research. But it seems that finding things is getting harder to find anymore.
-
Apr 5th, 2022, 12:16 PM
#20
Thread Starter
New Member
Re: I need help with turning an If statement to a select case statement
Originally Posted by baka
its not the complete solution, the OP want to know if the result has 2 of the same.
but Im sure he also want to check if theres 3 of the same as well.
Code:
Select Case True
Case a = b And a = c: MsgBox "found all 3"
Case a = b, a = c, b = c: MsgBox "found 2"
End Select
so what we do is first we take the "all 3", and if thats not the case, we check if at least 2 are the same.
Yes That is what I am trying to do. Instead of having a bunch of a If Then statements to check for 2 of a kind or three of a kind I am trying to find a simpler solution. Here is the module I am using. It is by far not done. I have been working on it for a couple weeks now, so please bare with me on the un-professionalism I am still learning. Here's part of the module.
Code:
Public iCredits As Integer
Public Balance As Integer
Public Profits As Integer
Public Pic1 As Integer
Public Pic2 As Integer
Public Pic3 As Integer
Public D As Integer
Public picCounter As Integer
Public picCounter2 As Integer
Public iCounter As Integer
Public iBet As Integer
Public FreeSpin As Integer
Public Jackpot As Integer
Public Sub SaveResource(intID As Integer, strFile As String)
Dim bData() As Byte, intFree As Long
bData = LoadResData(intID, "WAV")
intFree = FreeFile
Open strFile For Binary Access Write As #intFree
Put #intFree, 1, bData
Close #intFree
End Sub
Public Sub Spin()
iCounter = iCounter + 20
Randomize Timer
Pic1 = Int((10 * Rnd) + 1)
Pic2 = Int((10 * Rnd) + 1)
Pic3 = Int((10 * Rnd) + 1)
D = 3 + Int(Rnd * 3)
frmMain.mmcSpin.Notify = False
frmMain.mmcSpin.Wait = True
frmMain.mmcSpin.Shareable = False
frmMain.mmcSpin.DeviceType = "WaveAudio"
frmMain.mmcSpin.FileName = Environ("temp") & "\Spin.wav"
frmMain.mmcSpin.Command = "Open"
frmMain.mmcSpin.Command = "Play"
With frmMain.lblInfo
.Caption = "Good Luck!!"
.Alignment = D - 3
End With
Select Case Pic1
Case 1
frmMain.img1.Picture = frmMain.imgPics.ListImages(1).Picture ' Bananas
Case 2
frmMain.img1.Picture = frmMain.imgPics.ListImages(2).Picture ' Plum
Case 3
frmMain.img1.Picture = frmMain.imgPics.ListImages(3).Picture ' Lemon
Case 4
frmMain.img1.Picture = frmMain.imgPics.ListImages(4).Picture ' Grapes
Case 5
frmMain.img1.Picture = frmMain.imgPics.ListImages(5).Picture ' Cherries
Case 6
frmMain.img1.Picture = frmMain.imgPics.ListImages(6).Picture ' Strawberry
Case 7
frmMain.img1.Picture = frmMain.imgPics.ListImages(7).Picture ' Bar
Case 8
frmMain.img1.Picture = frmMain.imgPics.ListImages(14).Picture ' Free Spin
Case 9
frmMain.img1.Picture = frmMain.imgPics.ListImages(8).Picture ' Heart
Case 10
frmMain.img1.Picture = frmMain.imgPics.ListImages(9).Picture ' 7
Case 11
frmMain.img1.Picture = frmMain.imgPics.ListImages(10).Picture ' Bell
' Case 12
' frmMain.img1.Picture = frmMain.imgPics.ListImages(11).Picture ' Diamond
'Case 13
' frmMain.img1.Picture = frmMain.imgPics.ListImages(12).Picture ' Golden Horse Shoe
'Case 14
' frmMain.img1.Picture = frmMain.imgPics.ListImages(13).Picture ' Gold Bricks
'Case 15
' frmMain.img1.Picture = frmMain.imgPics.ListImages(15).Picture ' 2 Free Spins
'Case 16
' frmMain.img1.Picture = frmMain.imgPics.ListImages(16).Picture ' 5 free Spins
End Select
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Select Case Pic2
Case 1
frmMain.img2.Picture = frmMain.imgPics.ListImages(1).Picture ' Bananas
Case 2
frmMain.img2.Picture = frmMain.imgPics.ListImages(2).Picture ' Plum
Case 3
frmMain.img2.Picture = frmMain.imgPics.ListImages(3).Picture ' Lemon
Case 4
frmMain.img2.Picture = frmMain.imgPics.ListImages(4).Picture ' Grapes
Case 5
frmMain.img2.Picture = frmMain.imgPics.ListImages(5).Picture ' Cherries
Case 6
frmMain.img2.Picture = frmMain.imgPics.ListImages(6).Picture ' Strawberry
Case 7
frmMain.img2.Picture = frmMain.imgPics.ListImages(7).Picture ' Bar
Case 8
frmMain.img2.Picture = frmMain.imgPics.ListImages(14).Picture ' Free Spin
Case 9
frmMain.img2.Picture = frmMain.imgPics.ListImages(8).Picture ' Heart
Case 10
frmMain.img2.Picture = frmMain.imgPics.ListImages(9).Picture ' 7
Case 11
frmMain.img2.Picture = frmMain.imgPics.ListImages(10).Picture ' Bell
'Case 12
' frmMain.img2.Picture = frmMain.imgPics.ListImages(11).Picture ' Diamond
'Case 13
' frmMain.img2.Picture = frmMain.imgPics.ListImages(12).Picture ' Golden Horse Shoe
'Case 14
' frmMain.img2.Picture = frmMain.imgPics.ListImages(13).Picture ' Gold Bricks
'Case 15
' frmMain.img2.Picture = frmMain.imgPics.ListImages(15).Picture ' 2 Free Spins
'Case 16
'frmMain.img2.Picture = frmMain.imgPics.ListImages(16).Picture ' 5 free Spins
End Select
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Select Case Pic3
Case 1
frmMain.img3.Picture = frmMain.imgPics.ListImages(1).Picture ' Bananas
Case 2
frmMain.img3.Picture = frmMain.imgPics.ListImages(2).Picture ' Plum
Case 3
frmMain.img3.Picture = frmMain.imgPics.ListImages(3).Picture ' Lemon
Case 4
frmMain.img3.Picture = frmMain.imgPics.ListImages(4).Picture ' Grapes
Case 5
frmMain.img3.Picture = frmMain.imgPics.ListImages(5).Picture ' Cherries
Case 6
frmMain.img3.Picture = frmMain.imgPics.ListImages(6).Picture ' Strawberry
Case 7
frmMain.img3.Picture = frmMain.imgPics.ListImages(7).Picture ' Bar
Case 8
frmMain.img3.Picture = frmMain.imgPics.ListImages(14).Picture ' Free Spin
Case 9
frmMain.img3.Picture = frmMain.imgPics.ListImages(8).Picture ' Heart
Case 10
frmMain.img3.Picture = frmMain.imgPics.ListImages(9).Picture ' 7
Case 11
frmMain.img3.Picture = frmMain.imgPics.ListImages(10).Picture ' Bell
'Case 12
'frmMain.img3.Picture = frmMain.imgPics.ListImages(11).Picture ' Diamond
'Case 13
'frmMain.img3.Picture = frmMain.imgPics.ListImages(12).Picture ' Golden Horse Shoe
'Case 14
'frmMain.img3.Picture = frmMain.imgPics.ListImages(13).Picture ' Gold Bricks
'Case 15
'frmMain.img3.Picture = frmMain.imgPics.ListImages(15).Picture ' 2 Free Spins
'Case 16
'frmMain.img3.Picture = frmMain.imgPics.ListImages(16).Picture ' 5 free Spins
End Select
If iCounter > 500 Then
Debug.Print Pic1
Debug.Print Pic2
Debug.Print Pic3
frmMain.tmrSpin.Enabled = False
frmMain.mmcSpin.Command = "Stop"
frmMain.lblInfo.Alignment = 2
If (Pic1 = 1 And Pic2 = 1 And Pic3 <> 1) Or (Pic1 = 1 And Pic3 = 1 And Pic2 <> 1) Or (Pic2 = 1 And Pic3 = 1 And Pic1 <> 1) Or (Pic1 = 2 And Pic2 = 2 And Pic3 <> 2) Or (Pic1 = 2 And Pic3 = 2 And Pic2 <> 2) Or (Pic3 = 2 And Pic2 = 2 And Pic1 <> 2) Or _
(Pic1 = 3 And Pic2 = 3 And Pic3 <> 3) Or (Pic1 = 3 And Pic3 = 3 And Pic2 <> 3) Or (Pic2 = 3 And Pic3 = 3 And Pic1 <> 3) Then
frmMain.mmcWinner.Command = "Close"
frmMain.mmcWinner.Notify = False
frmMain.mmcWinner.Wait = True
frmMain.mmcLevel.Shareable = False
frmMain.mmcWinner.DeviceType = "WaveAudio"
frmMain.mmcWinner.FileName = Environ("temp") & "\Winner.wav"
frmMain.mmcWinner.Command = "Open"
frmMain.mmcWinner.Command = "Play"
frmMain.lblInfo.Caption = "You Win 10 Credits!"
frmMain.sbBar.SimpleText = "Status: Won 10 Credits..."
iCredits = Str$(iCredits) + 10
Profits = Str$(Profits) - 10
Balance = Str$(iCredits)
frmMain.lblBal.Caption = Str$(Balance)
frmInfo.lblProfits = Str$(Profits)
frmMain.lblCredits.Caption = Str$(iCredits)
iBet = 0
iCounter = 0
Exit Sub
End If
If (Pic1 = 4 And Pic2 = 4 And Pic3 <> 4) Or (Pic1 = 4 And Pic3 = 4 And Pic2 <> 4) Or (Pic3 = 4 And Pic2 = 4 And Pic1 <> 4) Or _
(Pic1 = 5 And Pic2 = 5 And Pic3 <> 5) Or (Pic1 = 5 And Pic3 = 5 And Pic2 <> 5) Or (Pic3 = 5 And Pic2 = 5 And Pic1 <> 5) Then
frmMain.mmcWinner.Command = "Close"
frmMain.mmcWinner.Notify = False
frmMain.mmcWinner.Wait = True
frmMain.mmcLevel.Shareable = False
frmMain.mmcWinner.DeviceType = "WaveAudio"
frmMain.mmcWinner.FileName = Environ("temp") & "\Winner.wav"
frmMain.mmcWinner.Command = "Open"
frmMain.mmcWinner.Command = "Play"
frmMain.lblInfo.Caption = "You Win 30 Credits!"
frmMain.sbBar.SimpleText = "Status: Won 30 Credits..."
iCredits = Str$(iCredits) + 30
Profits = Str$(Profits) - 30
Balance = Str$(iCredits)
frmMain.lblBal.Caption = Str$(Balance)
frmInfo.lblProfits = Str$(Profits)
frmMain.lblCredits.Caption = Str$(iCredits)
iBet = 0
iCounter = 0
Exit Sub
End If
If (Pic1 = 6 And Pic2 = 6 And Pic3 <> 6) Or (Pic1 = 6 And Pic3 = 6 And Pic2 <> 6) Or (Pic3 = 6 And Pic2 = 6 And Pic1 <> 6) Then
frmMain.mmcWinner.Command = "Close"
frmMain.mmcWinner.Notify = False
frmMain.mmcWinner.Wait = True
frmMain.mmcLevel.Shareable = False
frmMain.mmcWinner.DeviceType = "WaveAudio"
frmMain.mmcWinner.FileName = Environ("temp") & "\Winner.wav"
frmMain.mmcWinner.Command = "Open"
frmMain.mmcWinner.Command = "Play"
frmMain.lblInfo.Caption = "You Win 50 Credits!"
frmMain.sbBar.SimpleText = "Status: Won 10 Credits..."
iCredits = Str$(iCredits) + 50
Profits = Str$(Profits) - 50
Balance = Str$(iCredits)
frmMain.lblBal.Caption = Str$(Balance)
frmInfo.lblProfits = Str$(Profits)
frmMain.lblCredits.Caption = Str$(iCredits)
iBet = 0
iCounter = 0
Exit Sub
End If
If (Pic1 = 1 And Pic2 = 1 And Pic3 = 1) Or (Pic1 = 2 And Pic2 = 2 And Pic3 = 2) Or (Pic1 = 3 And Pic2 = 3 And Pic3 = 3) Then
frmMain.mmcWinner.Command = "Close"
frmMain.mmcWinner.Notify = False
frmMain.mmcWinner.Wait = True
frmMain.mmcWinner.Shareable = False
frmMain.mmcWinner.DeviceType = "WaveAudio"
frmMain.mmcWinner.FileName = Environ("temp") & "\Winner.wav"
frmMain.mmcWinner.Command = "Open"
frmMain.mmcWinner.Command = "Play"
If (picCounter = 500) Or (picCounter = 1800) Or (picCounter = 2800) Or (picCounter = 3800) Then
frmMain.mmcLevel.Command = "Close"
frmMain.img2Times.Visible = True
frmMain.tmrLevelUp.Enabled = True
frmMain.mmcLevel.Notify = False
frmMain.mmcLevel.Wait = True
frmMain.mmcLevel.Shareable = False
frmMain.mmcLevel.DeviceType = "WaveAudio"
frmMain.mmcLevel.FileName = Environ("temp") & "\LevelUp.wav"
frmMain.mmcLevel.Command = "Open"
frmMain.mmcLevel.Command = "Play"
Select Case picCounter
Case 500
frmMain.lblInfo.Caption = "Bonus Level Up! You Win Double! 500 bonus Credits!"
frmMain.sbBar.SimpleText = "Status: Won 500 bonus Credits..."
iCredits = Str$(iCredits) + 500
Profits = Str$(Profits) - 500
Balance = Str$(iCredits)
frmMain.lblBal.Caption = Str$(Balance)
frmInfo.lblProfits = Str$(Profits)
frmMain.lblCredits.Caption = Str$(iCredits)
iBet = 0
iCounter = 0
DoEvents
frmMain.img2Times.Visible = False
Exit Sub
Case 1800
frmMain.lblInfo.Caption = "Bonus Level Up! You Win Double! 1800 bonus Credits!"
frmMain.sbBar.SimpleText = "Status: Won 2800 bonus Credits..."
iCredits = Str$(iCredits) + 1800
Profits = Str$(Profits) - 1800
Balance = Str$(iCredits)
frmMain.lblBal.Caption = Str$(Balance)
frmInfo.lblProfits = Str$(Profits)
frmMain.lblCredits.Caption = Str$(iCredits)
iBet = 0
DoEvents
frmMain.img2Times.Visible = False
iCounter = 0
Exit Sub
Case 2800
frmMain.lblInfo.Caption = "Bonus Level Up! You Win Double! 2800 bonus Credits!"
frmMain.sbBar.SimpleText = "Status: Won 2800 bonus Credits..."
iCredits = Str$(iCredits) + 2800
Profits = Str$(Profits) - 2800
Balance = Str$(iCredits)
frmMain.lblBal.Caption = Str$(Balance)
frmInfo.lblProfits = Str$(Profits)
frmMain.lblCredits.Caption = Str$(iCredits)
iBet = 0
DoEvents
frmMain.img2Times.Visible = False
picCounter = 0
Exit Sub
Case 3800
frmMain.lblInfo.Caption = "Bonus Level Up! You Win Double! 3800 bonus Credits!"
frmMain.sbBar.SimpleText = "Status: Won 3800 bonus Credits..."
iCredits = Str$(iCredits) + 3800
Profits = Str$(Profits) - 3800
Balance = Str$(iCredits)
frmMain.lblBal.Caption = Str$(Balance)
frmInfo.lblProfits = Str$(Profits)
frmMain.lblCredits.Caption = Str$(iCredits)
iBet = 0
DoEvents
frmMain.img2Times.Visible = False
iCounter = 0
Exit Sub
Case Else
frmMain.lblInfo.Caption = "You Win 600 Credits!"
frmMain.sbBar.SimpleText = "Status: Won 200 bonus Credits..."
iCredits = Str$(iCredits) + 600
Profits = Str$(Profits) - 600
Balance = Str$(iCredits)
frmMain.lblBal.Caption = Str$(Balance)
frmInfo.lblProfits = Str$(Profits)
frmMain.lblCredits.Caption = Str$(iCredits)
iBet = 0
picCounter = Str$(picCounter) + 1
iCounter = 0
Exit Sub
End Select
Exit Sub
End If
End If
If (Pic1 = 4 And Pic2 = 4 And Pic3 = 4) Or (Pic1 = 5 And Pic2 = 5 And Pic3 = 5) Or (Pic1 = 6 And Pic2 = 6 And Pic3 = 6) Then
frmMain.mmcWinner.Command = "Close"
frmMain.mmcWinner.Notify = False
frmMain.mmcWinner.Wait = True
frmMain.mmcWinner.Shareable = False
frmMain.mmcWinner.DeviceType = "WaveAudio"
frmMain.mmcWinner.FileName = Environ("temp") & "\Winner.wav"
frmMain.mmcWinner.Command = "Open"
frmMain.mmcWinner.Command = "Play"
If (picCounter = 1200) Or (picCounter = 2200) Or (picCounter = 3200) Then
frmMain.img3Times.Visible = True
frmMain.tmrLevelUp.Enabled = True
frmMain.mmcLevel.Command = "Close"
frmMain.mmcLevel.Notify = False
frmMain.mmcLevel.Wait = True
frmMain.mmcLevel.Shareable = False
frmMain.mmcLevel.DeviceType = "WaveAudio"
frmMain.mmcLevel.FileName = Environ("temp") & "\LevelUp.wav"
frmMain.mmcLevel.Command = "Open"
frmMain.mmcLevel.Command = "Play"
Select Case picCounter
Case 1200
frmMain.lblInfo.Caption = "Bonus Level Up! You Win Triple! 2400 bonus Credits!"
frmMain.sbBar.SimpleText = "Status: Won 2400 bonus Credits..."
iCredits = Str$(iCredits) + 2400
Profits = Str$(Profits) - 2400
Balance = Str$(iCredits)
frmMain.lblBal.Caption = Str$(Balance)
frmInfo.lblProfits = Str$(Profits)
frmMain.lblCredits.Caption = Str$(iCredits)
iBet = 0
DoEvents
frmMain.img3Times.Visible = False
iCounter = 0
Exit Sub
Case 2200
frmMain.lblInfo.Caption = "Bonus Level Up! You Win Double! 2200 bonus Credits!"
frmMain.sbBar.SimpleText = "Status: Won 2600 bonus Credits..."
iCredits = Str$(iCredits) + 2600
Profits = Str$(Profits) - 2600
Balance = Str$(iCredits)
frmMain.lblBal.Caption = Str$(Balance)
frmInfo.lblProfits = Str$(Profits)
frmMain.lblCredits.Caption = Str$(iCredits)
iBet = 0
DoEvents
frmMain.img3Times.Visible = False
iCounter = 0
Case 3200
frmMain.lblInfo.Caption = "Bonus Level Up! You Win Double! 3200 bonus Credits!"
frmMain.sbBar.SimpleText = "Status: Won 3200 bonus Credits..."
iCredits = Str$(iCredits) + 3200
Profits = Str$(Profits) - 3200
Balance = Str$(iCredits)
frmMain.lblBal.Caption = Str$(Balance)
frmInfo.lblProfits = Str$(Profits)
frmMain.lblCredits.Caption = Str$(iCredits)
iBet = 0
DoEvents
frmMain.img3Times.Visible = False
iCounter = 0
picCounter = 0
Exit Sub
Case Else
frmMain.lblInfo.Caption = "You Win 3200 Credits!"
frmMain.sbBar.SimpleText = "Status: Won 1200 bonus Credits..."
iCredits = Str$(iCredits) + 800
Profits = Str$(Profits) - 8200
Balance = Str$(iCredits)
frmMain.lblBal.Caption = Str$(Balance)
frmInfo.lblProfits = Str$(Profits)
frmMain.lblCredits.Caption = Str$(iCredits)
iBet = 0
DoEvents
frmMain.img3Times.Visible = False
picCounter = 0
iCounter = 0
Exit Sub
End Select
End If
End If
' Bar
If (Pic1 = 7 And Pic2 = 7 And Pic3 <> 7) Or (Pic1 = 7 And Pic3 = 7 And Pic2 <> 7) Or (Pic2 = 7 And Pic3 = 7 And Pic1 <> 7) Then
frmMain.mmcWinner.Command = "Close"
frmMain.mmcWinner.Notify = False
frmMain.mmcWinner.Wait = True
frmMain.mmcWinner.Shareable = False
frmMain.mmcWinner.DeviceType = "WaveAudio"
frmMain.mmcWinner.FileName = Environ("temp") & "\Winner.wav"
frmMain.mmcWinner.Command = "Open"
frmMain.mmcWinner.Command = "Play"
frmMain.lblInfo.Caption = "You Win 800 Credits!"
frmMain.sbBar.SimpleText = "Status: Won 800 bonus Credits..."
iCredits = Str$(iCredits) + 800
Profits = Str$(Profits) - 800
Balance = Str$(iCredits)
frmMain.lblBal.Caption = Str$(Balance)
frmInfo.lblProfits = Str$(Profits)
frmMain.lblCredits.Caption = Str$(iCredits)
iBet = 0
iCounter = 0
Exit Sub
End If
' Heart and 7
If (Pic1 = 8 And Pic2 = 8 And Pic3 <> 8) Or (Pic1 = 8 And Pic3 = 8 And Pic2 <> 8) Or (Pic2 = 8 And Pic3 = 8 And Pic1 <> 8) Then
frmMain.mmcWinner.Command = "Close"
frmMain.mmcWinner.Notify = False
frmMain.mmcWinner.Wait = True
frmMain.mmcLevel.Shareable = False
frmMain.mmcWinner.DeviceType = "WaveAudio"
frmMain.mmcWinner.FileName = Environ("temp") & "\Winner.wav"
frmMain.mmcWinner.Command = "Open"
frmMain.mmcWinner.Command = "Play"
frmMain.mmcWinner.Command = "Close"
frmMain.mmcWinner.Notify = False
frmMain.mmcWinner.Wait = True
frmMain.mmcLevel.Shareable = False
frmMain.mmcWinner.DeviceType = "WaveAudio"
frmMain.mmcWinner.FileName = Environ("temp") & "\Winner.wav"
frmMain.mmcWinner.Command = "Open"
frmMain.mmcWinner.Command = "Play"
frmMain.lblInfo.Caption = "You Win a Free Spin!"
frmMain.sbBar.SimpleText = "Status: Won a Free Spin..."
iCredits = Str$(iCredits + iBet)
Balance = Str$(iCredits)
FreeSpin = Str$(FreeSpin) + 1
frmMain.lblFree.Caption = "Free Spin " & Str$(FreeSpin)
frmMain.lblFree.Enabled = True
frmMain.imgFree.Enabled = True
frmMain.lblBal.Caption = Str$(Balance)
frmInfo.lblProfits = Str$(Profits)
frmMain.lblCredits.Caption = Str$(iCredits)
iBet = 0
DoEvents
frmMain.img2Times.Visible = False
iCounter = 0
Exit Sub
End If
Last edited by Arizonasworld85; Apr 5th, 2022 at 12:39 PM.
-
Apr 5th, 2022, 12:19 PM
#21
Re: I need help with turning an If statement to a select case statement
OMG, please find the code button. It's this one:
You can still edit your post and fix it. You should re-paste your code though so we can see the indentation (once it's surrounded by the code tags).
EDITED: Thank you for fixing it. 
Last edited by Elroy; Apr 5th, 2022 at 02:37 PM.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
-
Apr 5th, 2022, 12:37 PM
#22
Thread Starter
New Member
Re: I need help with turning an If statement to a select case statement
That's only half of the module because I couldn't post the whole module. This work for the most part but every few times it not catch certain pairs, I have re-worked the code a little since the first post.
Last edited by Arizonasworld85; Apr 5th, 2022 at 12:41 PM.
-
Apr 5th, 2022, 01:14 PM
#23
Fanatic Member
Re: I need help with turning an If statement to a select case statement
Looking at the full code, there are numerous "fixes" you're missing that would greatly reduce the length of the code...you did say you're still learning, so here's a few suggestions:
The code doesn't *need* to be in a module, it could be in the same form...if it was, any reference to elements of the form wouldn't need to begin "frmMain." making things slightly more readable. I'm not saying change that, it's entirely up to you, but it is something I would consider. Another option is "With frmMain" (with an "End With" at the end) on any section that references the main form...essentially if you use the with you don't need "frmMain" at the start of each reference.
Having img1, img2 and img3 means you need 3 sections each controlling the individual image...if you set them up as an array, you could reference each one individually using the same code for all 3...As an example, img(1), img(2) and img(3) is how it would look, and a for/next loop around it would be able to run it 3x.
The select case for the payout is overly huge...you should be able to create a function (which WOULD go into a module but doesn't have to) that could do the output based on input...as an example the function would take the total winnings as an input and it'll do all the work for that value (displaying the output, adding the amount to the total, etc).
In the section where you play the WAV file, you COULD move that entire block into a function and call the function "playWAV1" (as an example)...then in your main code, rather than having 7 lines of code in the main code you could just have "playWAV1"...it doesn't shorten things, but it DOES simplify things for you when debugging or reading your code.
Refactoring this code (this is known as refactoring, when you rebuild the code to do the same thing with less code or making it faster or more efficient) would probably take it down to 50 lines, at a guess.
These are all things you would learn to do over time, so no need to understand the suggestions...if you wanted to, you could look into it one at a time and see if you can implement the suggestions. MAKE A BACKUP before you play around though, so you have a working copy!
-
Apr 5th, 2022, 01:42 PM
#24
Thread Starter
New Member
Re: I need help with turning an If statement to a select case statement
Originally Posted by SmUX2k
Looking at the full code, there are numerous "fixes" you're missing that would greatly reduce the length of the code...you did say you're still learning, so here's a few suggestions:
The code doesn't *need* to be in a module, it could be in the same form...if it was, any reference to elements of the form wouldn't need to begin "frmMain." making things slightly more readable. I'm not saying change that, it's entirely up to you, but it is something I would consider. Another option is "With frmMain" (with an "End With" at the end) on any section that references the main form...essentially if you use the with you don't need "frmMain" at the start of each reference.
Having img1, img2 and img3 means you need 3 sections each controlling the individual image...if you set them up as an array, you could reference each one individually using the same code for all 3...As an example, img(1), img(2) and img(3) is how it would look, and a for/next loop around it would be able to run it 3x.
The select case for the payout is overly huge...you should be able to create a function (which WOULD go into a module but doesn't have to) that could do the output based on input...as an example the function would take the total winnings as an input and it'll do all the work for that value (displaying the output, adding the amount to the total, etc).
In the section where you play the WAV file, you COULD move that entire block into a function and call the function "playWAV1" (as an example)...then in your main code, rather than having 7 lines of code in the main code you could just have "playWAV1"...it doesn't shorten things, but it DOES simplify things for you when debugging or reading your code.
Refactoring this code (this is known as refactoring, when you rebuild the code to do the same thing with less code or making it faster or more efficient) would probably take it down to 50 lines, at a guess.
These are all things you would learn to do over time, so no need to understand the suggestions...if you wanted to, you could look into it one at a time and see if you can implement the suggestions. MAKE A BACKUP before you play around though, so you have a working copy!
Thanks for your feed back. This is the way a person learns, by getting feed back! I like some of your ideas, that I didn't think about. I have read and studied many books, but I learn more by seeing things being done. Sometimes reading stuff just goes over my head but if I see it being done I understand. I've seen a few suggestions that I might implement in my code. I really want to get good at programming. Again! Thanks everyone for your input and ideas!!. If I ever get it up and running good enough to show off I will post project for anyone interested.
-
Apr 6th, 2022, 05:47 AM
#25
Fanatic Member
Re: I need help with turning an If statement to a select case statement
Originally Posted by Arizonasworld85
Thanks for your feed back. This is the way a person learns, by getting feed back!
I've been there, and I'm still there with advanced VB techniques, so I know the suggestions could be useful if only to give new things to learn within the language
Originally Posted by Arizonasworld85
I like some of your ideas, that I didn't think about. I have read and studied many books, but I learn more by seeing things being done.
There's many people like us. Before I got into VB6 I was a QBasic coder, and (like with VB) I could do things that it wasn't designed to do (like making it access the internet through cURL)...it took me many attempts to get hooked into how VB6 works. I'm doing the same now with Visual Studio, but until I get my head around how VS works I'll be stuck with VB6's limitations. I think the issue for me is more to do with bugfixing and understanding the logic of what went wrong...if there's a bug in my VB6 code I can recognise where the issue might be, but if I encounter a bug in VS I'm totally lost (and the error messages are notoriously vague in both)...it's experience in both cases.
I started in this forum (after getting a few responses to support questions) by posting responses to others, and at times I would even spend some time writing code for people who needed something specific...my code is sloppy but it usually works and does the job needed :-)
-
Apr 7th, 2022, 10:52 PM
#26
Thread Starter
New Member
Re: I need help with turning an If statement to a select case statement
Originally Posted by Arizonasworld85
Yes That is what I am trying to do. Instead of having a bunch of a If Then statements to check for 2 of a kind or three of a kind I am trying to find a simpler solution. Here is the module I am using. It is by far not done. I have been working on it for a couple weeks now, so please bare with me on the un-professionalism I am still learning. Here's part of the module.
Code:
Public iCredits As Integer
Public Balance As Integer
Public Profits As Integer
Public Pic1 As Integer
Public Pic2 As Integer
Public Pic3 As Integer
Public D As Integer
Public picCounter As Integer
Public picCounter2 As Integer
Public iCounter As Integer
Public iBet As Integer
Public FreeSpin As Integer
Public Jackpot As Integer
Public Sub SaveResource(intID As Integer, strFile As String)
Dim bData() As Byte, intFree As Long
bData = LoadResData(intID, "WAV")
intFree = FreeFile
Open strFile For Binary Access Write As #intFree
Put #intFree, 1, bData
Close #intFree
End Sub
Public Sub Spin()
iCounter = iCounter + 20
Randomize Timer
Pic1 = Int((10 * Rnd) + 1)
Pic2 = Int((10 * Rnd) + 1)
Pic3 = Int((10 * Rnd) + 1)
D = 3 + Int(Rnd * 3)
frmMain.mmcSpin.Notify = False
frmMain.mmcSpin.Wait = True
frmMain.mmcSpin.Shareable = False
frmMain.mmcSpin.DeviceType = "WaveAudio"
frmMain.mmcSpin.FileName = Environ("temp") & "\Spin.wav"
frmMain.mmcSpin.Command = "Open"
frmMain.mmcSpin.Command = "Play"
With frmMain.lblInfo
.Caption = "Good Luck!!"
.Alignment = D - 3
End With
Select Case Pic1
Case 1
frmMain.img1.Picture = frmMain.imgPics.ListImages(1).Picture ' Bananas
Case 2
frmMain.img1.Picture = frmMain.imgPics.ListImages(2).Picture ' Plum
Case 3
frmMain.img1.Picture = frmMain.imgPics.ListImages(3).Picture ' Lemon
Case 4
frmMain.img1.Picture = frmMain.imgPics.ListImages(4).Picture ' Grapes
Case 5
frmMain.img1.Picture = frmMain.imgPics.ListImages(5).Picture ' Cherries
Case 6
frmMain.img1.Picture = frmMain.imgPics.ListImages(6).Picture ' Strawberry
Case 7
frmMain.img1.Picture = frmMain.imgPics.ListImages(7).Picture ' Bar
Case 8
frmMain.img1.Picture = frmMain.imgPics.ListImages(14).Picture ' Free Spin
Case 9
frmMain.img1.Picture = frmMain.imgPics.ListImages(8).Picture ' Heart
Case 10
frmMain.img1.Picture = frmMain.imgPics.ListImages(9).Picture ' 7
Case 11
frmMain.img1.Picture = frmMain.imgPics.ListImages(10).Picture ' Bell
' Case 12
' frmMain.img1.Picture = frmMain.imgPics.ListImages(11).Picture ' Diamond
'Case 13
' frmMain.img1.Picture = frmMain.imgPics.ListImages(12).Picture ' Golden Horse Shoe
'Case 14
' frmMain.img1.Picture = frmMain.imgPics.ListImages(13).Picture ' Gold Bricks
'Case 15
' frmMain.img1.Picture = frmMain.imgPics.ListImages(15).Picture ' 2 Free Spins
'Case 16
' frmMain.img1.Picture = frmMain.imgPics.ListImages(16).Picture ' 5 free Spins
End Select
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Select Case Pic2
Case 1
frmMain.img2.Picture = frmMain.imgPics.ListImages(1).Picture ' Bananas
Case 2
frmMain.img2.Picture = frmMain.imgPics.ListImages(2).Picture ' Plum
Case 3
frmMain.img2.Picture = frmMain.imgPics.ListImages(3).Picture ' Lemon
Case 4
frmMain.img2.Picture = frmMain.imgPics.ListImages(4).Picture ' Grapes
Case 5
frmMain.img2.Picture = frmMain.imgPics.ListImages(5).Picture ' Cherries
Case 6
frmMain.img2.Picture = frmMain.imgPics.ListImages(6).Picture ' Strawberry
Case 7
frmMain.img2.Picture = frmMain.imgPics.ListImages(7).Picture ' Bar
Case 8
frmMain.img2.Picture = frmMain.imgPics.ListImages(14).Picture ' Free Spin
Case 9
frmMain.img2.Picture = frmMain.imgPics.ListImages(8).Picture ' Heart
Case 10
frmMain.img2.Picture = frmMain.imgPics.ListImages(9).Picture ' 7
Case 11
frmMain.img2.Picture = frmMain.imgPics.ListImages(10).Picture ' Bell
'Case 12
' frmMain.img2.Picture = frmMain.imgPics.ListImages(11).Picture ' Diamond
'Case 13
' frmMain.img2.Picture = frmMain.imgPics.ListImages(12).Picture ' Golden Horse Shoe
'Case 14
' frmMain.img2.Picture = frmMain.imgPics.ListImages(13).Picture ' Gold Bricks
'Case 15
' frmMain.img2.Picture = frmMain.imgPics.ListImages(15).Picture ' 2 Free Spins
'Case 16
'frmMain.img2.Picture = frmMain.imgPics.ListImages(16).Picture ' 5 free Spins
End Select
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Select Case Pic3
Case 1
frmMain.img3.Picture = frmMain.imgPics.ListImages(1).Picture ' Bananas
Case 2
frmMain.img3.Picture = frmMain.imgPics.ListImages(2).Picture ' Plum
Case 3
frmMain.img3.Picture = frmMain.imgPics.ListImages(3).Picture ' Lemon
Case 4
frmMain.img3.Picture = frmMain.imgPics.ListImages(4).Picture ' Grapes
Case 5
frmMain.img3.Picture = frmMain.imgPics.ListImages(5).Picture ' Cherries
Case 6
frmMain.img3.Picture = frmMain.imgPics.ListImages(6).Picture ' Strawberry
Case 7
frmMain.img3.Picture = frmMain.imgPics.ListImages(7).Picture ' Bar
Case 8
frmMain.img3.Picture = frmMain.imgPics.ListImages(14).Picture ' Free Spin
Case 9
frmMain.img3.Picture = frmMain.imgPics.ListImages(8).Picture ' Heart
Case 10
frmMain.img3.Picture = frmMain.imgPics.ListImages(9).Picture ' 7
Case 11
frmMain.img3.Picture = frmMain.imgPics.ListImages(10).Picture ' Bell
'Case 12
'frmMain.img3.Picture = frmMain.imgPics.ListImages(11).Picture ' Diamond
'Case 13
'frmMain.img3.Picture = frmMain.imgPics.ListImages(12).Picture ' Golden Horse Shoe
'Case 14
'frmMain.img3.Picture = frmMain.imgPics.ListImages(13).Picture ' Gold Bricks
'Case 15
'frmMain.img3.Picture = frmMain.imgPics.ListImages(15).Picture ' 2 Free Spins
'Case 16
'frmMain.img3.Picture = frmMain.imgPics.ListImages(16).Picture ' 5 free Spins
End Select
If iCounter > 500 Then
Debug.Print Pic1
Debug.Print Pic2
Debug.Print Pic3
frmMain.tmrSpin.Enabled = False
frmMain.mmcSpin.Command = "Stop"
frmMain.lblInfo.Alignment = 2
If (Pic1 = 1 And Pic2 = 1 And Pic3 <> 1) Or (Pic1 = 1 And Pic3 = 1 And Pic2 <> 1) Or (Pic2 = 1 And Pic3 = 1 And Pic1 <> 1) Or (Pic1 = 2 And Pic2 = 2 And Pic3 <> 2) Or (Pic1 = 2 And Pic3 = 2 And Pic2 <> 2) Or (Pic3 = 2 And Pic2 = 2 And Pic1 <> 2) Or _
(Pic1 = 3 And Pic2 = 3 And Pic3 <> 3) Or (Pic1 = 3 And Pic3 = 3 And Pic2 <> 3) Or (Pic2 = 3 And Pic3 = 3 And Pic1 <> 3) Then
frmMain.mmcWinner.Command = "Close"
frmMain.mmcWinner.Notify = False
frmMain.mmcWinner.Wait = True
frmMain.mmcLevel.Shareable = False
frmMain.mmcWinner.DeviceType = "WaveAudio"
frmMain.mmcWinner.FileName = Environ("temp") & "\Winner.wav"
frmMain.mmcWinner.Command = "Open"
frmMain.mmcWinner.Command = "Play"
frmMain.lblInfo.Caption = "You Win 10 Credits!"
frmMain.sbBar.SimpleText = "Status: Won 10 Credits..."
iCredits = Str$(iCredits) + 10
Profits = Str$(Profits) - 10
Balance = Str$(iCredits)
frmMain.lblBal.Caption = Str$(Balance)
frmInfo.lblProfits = Str$(Profits)
frmMain.lblCredits.Caption = Str$(iCredits)
iBet = 0
iCounter = 0
Exit Sub
End If
If (Pic1 = 4 And Pic2 = 4 And Pic3 <> 4) Or (Pic1 = 4 And Pic3 = 4 And Pic2 <> 4) Or (Pic3 = 4 And Pic2 = 4 And Pic1 <> 4) Or _
(Pic1 = 5 And Pic2 = 5 And Pic3 <> 5) Or (Pic1 = 5 And Pic3 = 5 And Pic2 <> 5) Or (Pic3 = 5 And Pic2 = 5 And Pic1 <> 5) Then
frmMain.mmcWinner.Command = "Close"
frmMain.mmcWinner.Notify = False
frmMain.mmcWinner.Wait = True
frmMain.mmcLevel.Shareable = False
frmMain.mmcWinner.DeviceType = "WaveAudio"
frmMain.mmcWinner.FileName = Environ("temp") & "\Winner.wav"
frmMain.mmcWinner.Command = "Open"
frmMain.mmcWinner.Command = "Play"
frmMain.lblInfo.Caption = "You Win 30 Credits!"
frmMain.sbBar.SimpleText = "Status: Won 30 Credits..."
iCredits = Str$(iCredits) + 30
Profits = Str$(Profits) - 30
Balance = Str$(iCredits)
frmMain.lblBal.Caption = Str$(Balance)
frmInfo.lblProfits = Str$(Profits)
frmMain.lblCredits.Caption = Str$(iCredits)
iBet = 0
iCounter = 0
Exit Sub
End If
If (Pic1 = 6 And Pic2 = 6 And Pic3 <> 6) Or (Pic1 = 6 And Pic3 = 6 And Pic2 <> 6) Or (Pic3 = 6 And Pic2 = 6 And Pic1 <> 6) Then
frmMain.mmcWinner.Command = "Close"
frmMain.mmcWinner.Notify = False
frmMain.mmcWinner.Wait = True
frmMain.mmcLevel.Shareable = False
frmMain.mmcWinner.DeviceType = "WaveAudio"
frmMain.mmcWinner.FileName = Environ("temp") & "\Winner.wav"
frmMain.mmcWinner.Command = "Open"
frmMain.mmcWinner.Command = "Play"
frmMain.lblInfo.Caption = "You Win 50 Credits!"
frmMain.sbBar.SimpleText = "Status: Won 10 Credits..."
iCredits = Str$(iCredits) + 50
Profits = Str$(Profits) - 50
Balance = Str$(iCredits)
frmMain.lblBal.Caption = Str$(Balance)
frmInfo.lblProfits = Str$(Profits)
frmMain.lblCredits.Caption = Str$(iCredits)
iBet = 0
iCounter = 0
Exit Sub
End If
If (Pic1 = 1 And Pic2 = 1 And Pic3 = 1) Or (Pic1 = 2 And Pic2 = 2 And Pic3 = 2) Or (Pic1 = 3 And Pic2 = 3 And Pic3 = 3) Then
frmMain.mmcWinner.Command = "Close"
frmMain.mmcWinner.Notify = False
frmMain.mmcWinner.Wait = True
frmMain.mmcWinner.Shareable = False
frmMain.mmcWinner.DeviceType = "WaveAudio"
frmMain.mmcWinner.FileName = Environ("temp") & "\Winner.wav"
frmMain.mmcWinner.Command = "Open"
frmMain.mmcWinner.Command = "Play"
If (picCounter = 500) Or (picCounter = 1800) Or (picCounter = 2800) Or (picCounter = 3800) Then
frmMain.mmcLevel.Command = "Close"
frmMain.img2Times.Visible = True
frmMain.tmrLevelUp.Enabled = True
frmMain.mmcLevel.Notify = False
frmMain.mmcLevel.Wait = True
frmMain.mmcLevel.Shareable = False
frmMain.mmcLevel.DeviceType = "WaveAudio"
frmMain.mmcLevel.FileName = Environ("temp") & "\LevelUp.wav"
frmMain.mmcLevel.Command = "Open"
frmMain.mmcLevel.Command = "Play"
Select Case picCounter
Case 500
frmMain.lblInfo.Caption = "Bonus Level Up! You Win Double! 500 bonus Credits!"
frmMain.sbBar.SimpleText = "Status: Won 500 bonus Credits..."
iCredits = Str$(iCredits) + 500
Profits = Str$(Profits) - 500
Balance = Str$(iCredits)
frmMain.lblBal.Caption = Str$(Balance)
frmInfo.lblProfits = Str$(Profits)
frmMain.lblCredits.Caption = Str$(iCredits)
iBet = 0
iCounter = 0
DoEvents
frmMain.img2Times.Visible = False
Exit Sub
Case 1800
frmMain.lblInfo.Caption = "Bonus Level Up! You Win Double! 1800 bonus Credits!"
frmMain.sbBar.SimpleText = "Status: Won 2800 bonus Credits..."
iCredits = Str$(iCredits) + 1800
Profits = Str$(Profits) - 1800
Balance = Str$(iCredits)
frmMain.lblBal.Caption = Str$(Balance)
frmInfo.lblProfits = Str$(Profits)
frmMain.lblCredits.Caption = Str$(iCredits)
iBet = 0
DoEvents
frmMain.img2Times.Visible = False
iCounter = 0
Exit Sub
Case 2800
frmMain.lblInfo.Caption = "Bonus Level Up! You Win Double! 2800 bonus Credits!"
frmMain.sbBar.SimpleText = "Status: Won 2800 bonus Credits..."
iCredits = Str$(iCredits) + 2800
Profits = Str$(Profits) - 2800
Balance = Str$(iCredits)
frmMain.lblBal.Caption = Str$(Balance)
frmInfo.lblProfits = Str$(Profits)
frmMain.lblCredits.Caption = Str$(iCredits)
iBet = 0
DoEvents
frmMain.img2Times.Visible = False
picCounter = 0
Exit Sub
Case 3800
frmMain.lblInfo.Caption = "Bonus Level Up! You Win Double! 3800 bonus Credits!"
frmMain.sbBar.SimpleText = "Status: Won 3800 bonus Credits..."
iCredits = Str$(iCredits) + 3800
Profits = Str$(Profits) - 3800
Balance = Str$(iCredits)
frmMain.lblBal.Caption = Str$(Balance)
frmInfo.lblProfits = Str$(Profits)
frmMain.lblCredits.Caption = Str$(iCredits)
iBet = 0
DoEvents
frmMain.img2Times.Visible = False
iCounter = 0
Exit Sub
Case Else
frmMain.lblInfo.Caption = "You Win 600 Credits!"
frmMain.sbBar.SimpleText = "Status: Won 200 bonus Credits..."
iCredits = Str$(iCredits) + 600
Profits = Str$(Profits) - 600
Balance = Str$(iCredits)
frmMain.lblBal.Caption = Str$(Balance)
frmInfo.lblProfits = Str$(Profits)
frmMain.lblCredits.Caption = Str$(iCredits)
iBet = 0
picCounter = Str$(picCounter) + 1
iCounter = 0
Exit Sub
End Select
Exit Sub
End If
End If
If (Pic1 = 4 And Pic2 = 4 And Pic3 = 4) Or (Pic1 = 5 And Pic2 = 5 And Pic3 = 5) Or (Pic1 = 6 And Pic2 = 6 And Pic3 = 6) Then
frmMain.mmcWinner.Command = "Close"
frmMain.mmcWinner.Notify = False
frmMain.mmcWinner.Wait = True
frmMain.mmcWinner.Shareable = False
frmMain.mmcWinner.DeviceType = "WaveAudio"
frmMain.mmcWinner.FileName = Environ("temp") & "\Winner.wav"
frmMain.mmcWinner.Command = "Open"
frmMain.mmcWinner.Command = "Play"
If (picCounter = 1200) Or (picCounter = 2200) Or (picCounter = 3200) Then
frmMain.img3Times.Visible = True
frmMain.tmrLevelUp.Enabled = True
frmMain.mmcLevel.Command = "Close"
frmMain.mmcLevel.Notify = False
frmMain.mmcLevel.Wait = True
frmMain.mmcLevel.Shareable = False
frmMain.mmcLevel.DeviceType = "WaveAudio"
frmMain.mmcLevel.FileName = Environ("temp") & "\LevelUp.wav"
frmMain.mmcLevel.Command = "Open"
frmMain.mmcLevel.Command = "Play"
Select Case picCounter
Case 1200
frmMain.lblInfo.Caption = "Bonus Level Up! You Win Triple! 2400 bonus Credits!"
frmMain.sbBar.SimpleText = "Status: Won 2400 bonus Credits..."
iCredits = Str$(iCredits) + 2400
Profits = Str$(Profits) - 2400
Balance = Str$(iCredits)
frmMain.lblBal.Caption = Str$(Balance)
frmInfo.lblProfits = Str$(Profits)
frmMain.lblCredits.Caption = Str$(iCredits)
iBet = 0
DoEvents
frmMain.img3Times.Visible = False
iCounter = 0
Exit Sub
Case 2200
frmMain.lblInfo.Caption = "Bonus Level Up! You Win Double! 2200 bonus Credits!"
frmMain.sbBar.SimpleText = "Status: Won 2600 bonus Credits..."
iCredits = Str$(iCredits) + 2600
Profits = Str$(Profits) - 2600
Balance = Str$(iCredits)
frmMain.lblBal.Caption = Str$(Balance)
frmInfo.lblProfits = Str$(Profits)
frmMain.lblCredits.Caption = Str$(iCredits)
iBet = 0
DoEvents
frmMain.img3Times.Visible = False
iCounter = 0
Case 3200
frmMain.lblInfo.Caption = "Bonus Level Up! You Win Double! 3200 bonus Credits!"
frmMain.sbBar.SimpleText = "Status: Won 3200 bonus Credits..."
iCredits = Str$(iCredits) + 3200
Profits = Str$(Profits) - 3200
Balance = Str$(iCredits)
frmMain.lblBal.Caption = Str$(Balance)
frmInfo.lblProfits = Str$(Profits)
frmMain.lblCredits.Caption = Str$(iCredits)
iBet = 0
DoEvents
frmMain.img3Times.Visible = False
iCounter = 0
picCounter = 0
Exit Sub
Case Else
frmMain.lblInfo.Caption = "You Win 3200 Credits!"
frmMain.sbBar.SimpleText = "Status: Won 1200 bonus Credits..."
iCredits = Str$(iCredits) + 800
Profits = Str$(Profits) - 8200
Balance = Str$(iCredits)
frmMain.lblBal.Caption = Str$(Balance)
frmInfo.lblProfits = Str$(Profits)
frmMain.lblCredits.Caption = Str$(iCredits)
iBet = 0
DoEvents
frmMain.img3Times.Visible = False
picCounter = 0
iCounter = 0
Exit Sub
End Select
End If
End If
' Bar
If (Pic1 = 7 And Pic2 = 7 And Pic3 <> 7) Or (Pic1 = 7 And Pic3 = 7 And Pic2 <> 7) Or (Pic2 = 7 And Pic3 = 7 And Pic1 <> 7) Then
frmMain.mmcWinner.Command = "Close"
frmMain.mmcWinner.Notify = False
frmMain.mmcWinner.Wait = True
frmMain.mmcWinner.Shareable = False
frmMain.mmcWinner.DeviceType = "WaveAudio"
frmMain.mmcWinner.FileName = Environ("temp") & "\Winner.wav"
frmMain.mmcWinner.Command = "Open"
frmMain.mmcWinner.Command = "Play"
frmMain.lblInfo.Caption = "You Win 800 Credits!"
frmMain.sbBar.SimpleText = "Status: Won 800 bonus Credits..."
iCredits = Str$(iCredits) + 800
Profits = Str$(Profits) - 800
Balance = Str$(iCredits)
frmMain.lblBal.Caption = Str$(Balance)
frmInfo.lblProfits = Str$(Profits)
frmMain.lblCredits.Caption = Str$(iCredits)
iBet = 0
iCounter = 0
Exit Sub
End If
' Heart and 7
If (Pic1 = 8 And Pic2 = 8 And Pic3 <> 8) Or (Pic1 = 8 And Pic3 = 8 And Pic2 <> 8) Or (Pic2 = 8 And Pic3 = 8 And Pic1 <> 8) Then
frmMain.mmcWinner.Command = "Close"
frmMain.mmcWinner.Notify = False
frmMain.mmcWinner.Wait = True
frmMain.mmcLevel.Shareable = False
frmMain.mmcWinner.DeviceType = "WaveAudio"
frmMain.mmcWinner.FileName = Environ("temp") & "\Winner.wav"
frmMain.mmcWinner.Command = "Open"
frmMain.mmcWinner.Command = "Play"
frmMain.mmcWinner.Command = "Close"
frmMain.mmcWinner.Notify = False
frmMain.mmcWinner.Wait = True
frmMain.mmcLevel.Shareable = False
frmMain.mmcWinner.DeviceType = "WaveAudio"
frmMain.mmcWinner.FileName = Environ("temp") & "\Winner.wav"
frmMain.mmcWinner.Command = "Open"
frmMain.mmcWinner.Command = "Play"
frmMain.lblInfo.Caption = "You Win a Free Spin!"
frmMain.sbBar.SimpleText = "Status: Won a Free Spin..."
iCredits = Str$(iCredits + iBet)
Balance = Str$(iCredits)
FreeSpin = Str$(FreeSpin) + 1
frmMain.lblFree.Caption = "Free Spin " & Str$(FreeSpin)
frmMain.lblFree.Enabled = True
frmMain.imgFree.Enabled = True
frmMain.lblBal.Caption = Str$(Balance)
frmInfo.lblProfits = Str$(Profits)
frmMain.lblCredits.Caption = Str$(iCredits)
iBet = 0
DoEvents
frmMain.img2Times.Visible = False
iCounter = 0
Exit Sub
End If
Thanks for everyone's feed back. I got it working great now!
-
Apr 7th, 2022, 11:30 PM
#27
Re: I need help with turning an If statement to a select case statement
I actually thought the example that dilettante gave back in post #5 addressed the finding of 3 match or 2 match fairly straight forward.
And then if you had to chose different rewards depending on what the matches were, you could do the Select Case on the matched value, or if the reward values and action are easily defined by putting the information in a UDT and using an array of the UDT you can index into the array and not need a Case Statement, e.g. here is a slightly extended (but not fully implemented) version of his code.
Code:
Option Explicit
Private Sub Command1_Click()
Dim A As Byte
Dim B As Byte
Dim C As Byte
A = Int(Rnd() * 10)
B = Int(Rnd() * 10)
C = Int(Rnd() * 10)
lblA.Caption = CStr(A)
lblB.Caption = CStr(B)
lblC.Caption = CStr(C)
If A = B And B = C Then
lblResult.Caption = "3 same"
Select Case A 'Doesn't matter which of the three you use as your "key" to the rewards
Case 0
'process a 3-way match on symbol 0
Case 1
'process a 3-way match on symbol 1
'etc....
End Select
'or
Process3WayMatch A 'Call sub that uses the symbol index to fetch and award 3 way match values
ElseIf A = B Or B = C Or C = A Then
lblResult.Caption = "2 same"
Dim MatchIdx As Byte
If A = B Or B = C Then
MatchIdx = B 'use B as the matched symbol
Else
MatchIdx = A 'A must match C, so A or C could be used
End If
Select Case MatchIdx
Case 0
'process a 2-way match on symbol 0
Case 1
'process a 2-way match on symbol 1
'etc....
End Select
'or
Process2WayMatch MatchIdx 'Call sub that uses the symbol index to fetch and award 2 way match values
Else
lblResult.Caption = "NONE same"
End If
End Sub
Private Sub Form_Load()
Randomize
End Sub
Another note on your code. You shouldn't use Randomize Timer in your Spin function as that actually makes the results less random (i.e. it reduces your random values from a pool of around 16 million values to a pool of around 32 thousand).
Randomize should only be called once at the start of the program, and you don't need to pass Timer as a parameter. That is an old QB and earlier requirement. Just calling Randomize will do that internally automatically.
You'll note that posted examples call Randomize in the Form_Load Sub.
Last edited by passel; Apr 7th, 2022 at 11:42 PM.
"Anyone can do any amount of work, provided it isn't the work he is supposed to be doing at that moment" Robert Benchley, 1930
-
Apr 9th, 2022, 07:39 PM
#28
Thread Starter
New Member
Re: I need help with turning an If statement to a select case statement
Originally Posted by passel
I actually thought the example that dilettante gave back in post #5 addressed the finding of 3 match or 2 match fairly straight forward.
And then if you had to chose different rewards depending on what the matches were, you could do the Select Case on the matched value, or if the reward values and action are easily defined by putting the information in a UDT and using an array of the UDT you can index into the array and not need a Case Statement, e.g. here is a slightly extended (but not fully implemented) version of his code.
Code:
Option Explicit
Private Sub Command1_Click()
Dim A As Byte
Dim B As Byte
Dim C As Byte
A = Int(Rnd() * 10)
B = Int(Rnd() * 10)
C = Int(Rnd() * 10)
lblA.Caption = CStr(A)
lblB.Caption = CStr(B)
lblC.Caption = CStr(C)
If A = B And B = C Then
lblResult.Caption = "3 same"
Select Case A 'Doesn't matter which of the three you use as your "key" to the rewards
Case 0
'process a 3-way match on symbol 0
Case 1
'process a 3-way match on symbol 1
'etc....
End Select
'or
Process3WayMatch A 'Call sub that uses the symbol index to fetch and award 3 way match values
ElseIf A = B Or B = C Or C = A Then
lblResult.Caption = "2 same"
Dim MatchIdx As Byte
If A = B Or B = C Then
MatchIdx = B 'use B as the matched symbol
Else
MatchIdx = A 'A must match C, so A or C could be used
End If
Select Case MatchIdx
Case 0
'process a 2-way match on symbol 0
Case 1
'process a 2-way match on symbol 1
'etc....
End Select
'or
Process2WayMatch MatchIdx 'Call sub that uses the symbol index to fetch and award 2 way match values
Else
lblResult.Caption = "NONE same"
End If
End Sub
Private Sub Form_Load()
Randomize
End Sub
Another note on your code. You shouldn't use Randomize Timer in your Spin function as that actually makes the results less random (i.e. it reduces your random values from a pool of around 16 million values to a pool of around 32 thousand).
Randomize should only be called once at the start of the program, and you don't need to pass Timer as a parameter. That is an old QB and earlier requirement. Just calling Randomize will do that internally automatically.
You'll note that posted examples call Randomize in the Form_Load Sub.
I appreciate it! I didn't know about the Randomize. I got the slot machine program working good now. I am trying to build a 5 reel slot machine game now. Thanks for the knowledge!
-
Apr 10th, 2022, 08:07 AM
#29
Fanatic Member
Re: I need help with turning an If statement to a select case statement
Originally Posted by Arizonasworld85
I appreciate it! I didn't know about the Randomize. I got the slot machine program working good now. I am trying to build a 5 reel slot machine game now. Thanks for the knowledge!
The RND function within VB6, and in most languages, is a PRNG...a pseudo-random number generator. Given a specific seed (using the randomize command) you can have RND generate a repeatable set of numbers (repeatable by re-using that seed and resetting the randomizer). It can be useful, like with Minecraft and building a world using a seed, but it can also cause limitations if you need TRUE randomness. I personally use randomize with the current time (removing the ":" from Time and turning the result from string to a number)...the level of randomness YOU need aren't that great that you would need to worry about maximising randomness, so (as mentioned) a simple "randomize" would be sufficient. Also, you would probably have noticed that the RNG is a PRNG eventually when you repeatedly ran the app and saw the same reels pop up every time you started.
There have been stress tests done here in the past to test how random the RND function is (billions and billions of numbers generated, and the coverage collated)...I can't find the thread now, but essentially they showed that coverage of each number was generally uniform over time, it wasn't 100% random but at the same time it was (randomness is complicated)...it is far more random than you need it to be, but you CAN make it more random (which isn't a thing, it's more "differently" random) with the method you were using, or the one I mentioned that I use...just remember you're adding very slightly to entropy rather than randomness.
Another option you have, and an option that real slot machines use, is to have the randomiser decide if your next spin is a win or a loss (I assume you've seen slot machines with a payout percentage of 80% or more...your win is determined based on previous losses in these machines, though a competent player can buck the odds with slots that have extra features)...if the randomiser decides a win, you then have it decide the level of win with a weighting system that favours the lower value rewards, and have the slot machine app "simulate" the spinning of the reels until those symbols come up. Extra work, but always an option :-)
-
Apr 10th, 2022, 10:30 AM
#30
Re: I need help with turning an If statement to a select case statement
VB's Rnd is not very good PRNG, it's more on the side of the worse ones. The PRNG repeats after 65536 generations (or was it 32768?) not billions, so the generally the algorithm is weak and dated but is probably fast and easy to implement in the range of several SHIFT and XOR instructions.
For cryptographically strong PRNG (based on entropy from real world) just use OS provided ones. Easiest would be to use this API function:
Code:
Private Declare Function RtlGenRandom Lib "advapi32" Alias "SystemFunction036" (RandomBuffer As Any, ByVal RandomBufferLength As Long) As Long
This can provide whatever number of bits of randomness you need with strong cryptographic guarantees like it would never repeat (not in a billion iterations but never). Obviously this is seeded by the OS using whatever entropy source is readily available on your device -- probably mouse movement, keyboard strokes, CPU temperature. This means you cannot reseed it with something like Randomize unfortunately.
cheers,
</wqw>
-
Apr 10th, 2022, 10:48 AM
#31
Re: I need help with turning an If statement to a select case statement
Here are a few truly random VB6 functions (via API calls):
Code:
Option Explicit
'
Private Declare Function CryptAcquireContextW Lib "advapi32.dll" (hProv As Long, ByVal pszContainer As Long, ByVal pszProvider As Long, ByVal dwProvType As Long, ByVal dwFlags As Long) As Boolean
Private Declare Function CryptGenRandom Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwlen As Long, pbBuffer As Any) As Boolean
Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
'
Public Declare Function GetMem2 Lib "msvbvm60" (ByRef Source As Any, ByRef Dest As Any) As Long ' Always ignore the returned value, it's useless.
Public Declare Function GetMem4 Lib "msvbvm60" (ByRef Source As Any, ByRef Dest As Any) As Long ' Always ignore the returned value, it's useless.
Public Declare Function GetMem8 Lib "msvbvm60" (ByRef Source As Any, ByRef Dest As Any) As Long ' Always ignore the returned value, it's useless.
'
Private Function RandomAnsiString(iLen As Long) As String
' Generates random ANSI strings with characters in the full range of &h00 to &hff.
Dim hCrypt As Long
Const PROV_RSA_FULL As Long = 1&
Const CRYPT_VERIFYCONTEXT As Long = &HF0000000
'
Dim bb() As Byte
ReDim bb(iLen - 1&)
'
Call CryptAcquireContextW(hCrypt, 0&, 0&, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) ' Initialize advapi32.
Call CryptGenRandom(hCrypt, iLen, bb(0)) ' Get our random bytes.
Call CryptReleaseContext(hCrypt, 0&) ' Turn off advapi32.
'
RandomAnsiString = StrConv(bb, vbUnicode) ' Put ANSI bytes into Unicode VB6 string.
End Function
Private Function RandomDecimal() As Variant
' This will return a random decimal number between 0 and 1, inclusive of 0 and exclusive of 1, with 64 bits (8 bytes) of precision.
Dim v1 As Variant
Dim v2 As Variant
Dim hCrypt As Long
Const PROV_RSA_FULL As Long = 1&
Const CRYPT_VERIFYCONTEXT As Long = &HF0000000
'
v1 = CDec(0) ' Create a Decimal number (zero).
Call CryptAcquireContextW(hCrypt, 0&, 0&, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) ' Initialize advapi32.
Call CryptGenRandom(hCrypt, 8&, ByVal PtrAdd(VarPtr(v1), 8&)) ' Get 8 bytes of random bits, and stuff into low order of Decimal.
Call CryptReleaseContext(hCrypt, 0&) ' Turn off advapi32.
'
v2 = CDec(0) ' Create another Decimal number (zero).
GetMem4 1&, ByVal PtrAdd(VarPtr(v2), 4&) ' Turn on low bit of high (third) byte of mantissa, making: &h100000000.
'
RandomDecimal = v1 / v2 ' Since v2 is 1 higher than v1 can ever be, the results will never reach ONE.
End Function
Private Function RndDbl() As Double
Static hCrypt As Long
Const CRYPT_VERIFYCONTEXT As Long = &HF0000000
Const PROV_RSA_FULL As Long = 1&
Const dDenom As Double = 922337203685478# ' 922337203685477.5808 the largest currency.
'
Dim bb(7) As Byte
Dim c As Currency
'
' Make sure we're initialized.
If hCrypt = 0& Then Call CryptAcquireContextW(hCrypt, 0&, 0&, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT)
Call CryptGenRandom(hCrypt, 8&, bb(0)) ' Get our random bytes.
CryptReleaseContext hCrypt, 0&
bb(7) = bb(7) And &H7F ' Make sure our Currency isn't negative.
GetMem8 bb(0), c ' Move our bytes to a Currency.
'
RndDbl = CDbl(c) / dDenom ' Convert to Double and set to 0-to-1.
'
'Private Sub DoDistributionTest()
' ' Do a Kolmogorov-Smirnov type test for bias.
' Dim bins(1 To 10)
' Dim d As Double
' Dim i As Long
' '
' For i = 1 To 20000
' d = RndDbl
' '
' Select Case d
' Case Is > 0.9!: bins(10) = bins(10) + 1
' Case Is > 0.8!: bins(9) = bins(9) + 1
' Case Is > 0.7!: bins(8) = bins(8) + 1
' Case Is > 0.6!: bins(7) = bins(7) + 1
' Case Is > 0.5!: bins(6) = bins(6) + 1
' Case Is > 0.4!: bins(5) = bins(5) + 1
' Case Is > 0.3!: bins(4) = bins(4) + 1
' Case Is > 0.2!: bins(3) = bins(3) + 1
' Case Is > 0.1!: bins(2) = bins(2) + 1
' Case Else: bins(1) = bins(1) + 1
' End Select
' Next
' '
' ' Report.
' Debug.Print "--------------"
' Debug.Print "Bins:"
' For i = 1 To 10
' Debug.Print bins(i)
' Next
'End Sub
'
End Function
Public Function PtrAdd(ByVal Ptr As Long, ByVal iOffset As Long) As Long
' For adding (or subtracting) a small number from a pointer.
' Use PtrAddEx for adding (or subtracting) large numbers from a pointer.
PtrAdd = (Ptr Xor &H80000000) + iOffset Xor &H80000000
End Function
Those initialize and de-initialize the Crypt calls on every call, which is somewhat inefficient. The following is a Class (in its entirety, so paste to Notepad and then save with the name RndLong.cls, and then include in your project). It's got the VB_PredeclaredId turned on, so you don't need to instantiate it, just use it.
Code:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
End
Attribute VB_Name = "RndLong"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'
Private Declare Function CryptAcquireContextW Lib "advapi32.dll" (hProv As Long, ByVal pszContainer As Long, ByVal pszProvider As Long, ByVal dwProvType As Long, ByVal dwFlags As Long) As Boolean
Private Declare Function CryptGenRandom Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwlen As Long, pbBuffer As Any) As Boolean
Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
'
Dim hCrypt As Long
'
Private Sub Class_Initialize()
Const PROV_RSA_FULL As Long = 1&
Const CRYPT_VERIFYCONTEXT As Long = &HF0000000
Call CryptAcquireContextW(hCrypt, 0&, 0&, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) ' Initialize advapi32.
End Sub
Public Function RndLong(Optional ByVal iMin As Long = 0&, Optional ByVal iMax As Long = &H7FFFFFFF) As Long
Attribute Value.VB_UserMemId = 0
' Generates a truly random number (Long) in whatever range is specified.
' Negatives are allowed.
' Default min & max is the entire positive range of a Long.
'
Dim iLen As Long
If iMin > iMax Then iLen = iMin: iMin = iMax: iMax = iLen ' Swap min & max if needed.
'
' We do our work as Currency so we get plenty of range.
Dim cRng As Currency
Dim cMin As Currency, cMax As Currency
cMin = CCur(iMin): cMax = CCur(iMax)
cRng = cMax - cMin + 1@
Select Case cRng ' How many bytes of randomness do we actually need.
Case Is > 16777216@: iLen = 4&
Case Is > 65536@: iLen = 3&
Case Is > 256@: iLen = 2&
Case Else: iLen = 1&
End Select
'
Dim cVal As Currency
Call CryptGenRandom(hCrypt, iLen, cVal) ' Get our random bits, just shoved into low bytes of Currency.
cVal = cVal * 10000@ ' Adjust for fixed Currency decimal.
While cVal >= cRng: cVal = cVal - cRng: Wend ' Any other way will introduce bias in the return.
cVal = cVal + cMin ' Correct for min.
'
RndLong = CLng(cVal) ' Return value. If all is as it should be, cVal will be in Long range.
End Function
Private Sub Class_Terminate()
Call CryptReleaseContext(hCrypt, 0&) ' Turn off advapi32.
End Sub
Once in your project, just call RndLong just like any other VB6 function.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
-
Apr 10th, 2022, 01:04 PM
#32
Re: I need help with turning an If statement to a select case statement
Originally Posted by wqweto
... The PRNG repeats after 65536 generations (or was it 32768?) not billions, so the generally the algorithm is weak and dated but is probably fast and easy to implement in the range of several SHIFT and XOR instructions...
cheers,
</wqw>
As I mentioned it was around 16 million values before the sequence repeats, i.e. 2^24 values to be precise.
That is because rnd returns a Single between the value of 0 to 1.0, not including 1.0, and the mantissa of a single gives you 24-bits of resolution.
But the seed to Randomize is truncated to a positive 16-bit integer to select the starting point of where you jump into that 16 million sequence so there are only 32768 places you can start in the sequence.
That is why if you do Randomize before every call to Rnd the first call will be one of those 32K entry points in the sequence.
"Anyone can do any amount of work, provided it isn't the work he is supposed to be doing at that moment" Robert Benchley, 1930
-
Apr 10th, 2022, 01:56 PM
#33
Fanatic Member
Re: I need help with turning an If statement to a select case statement
Originally Posted by wqweto
For cryptographically strong PRNG (based on entropy from real world) just use OS provided ones. Easiest would be to use this API function:
Code:
Private Declare Function RtlGenRandom Lib "advapi32" Alias "SystemFunction036" (RandomBuffer As Any, ByVal RandomBufferLength As Long) As Long
This can provide whatever number of bits of randomness you need with strong cryptographic guarantees like it would never repeat (not in a billion iterations but never). Obviously this is seeded by the OS using whatever entropy source is readily available on your device -- probably mouse movement, keyboard strokes, CPU temperature. This means you cannot reseed it with something like Randomize unfortunately.
By its very description, you're describing a RNG and not a PRNG...knowing the seed and the current position in the sequence (something you can calculate with more and more reliability the more numbers in the sequence you know), you would be able to accurately guess the next sequence in a PRNG because it is deterministic. I've never tested the repeat potential of the PRNG in VB but it's usually accurate enough for basic projects where you're not likely to suffer financial loss if someone could "break" the sequence and pre-empt results for their own profit (like in a real-world gambling app).
RNGs are entropic (generally) while PRNGs are deterministic...both give sequences of numbers in a seemingly random order, only one is truly random.
For some people (I've made use of it in a few of my projects, and of course I mentioned that minecraft's world generation essentially uses a PRNG to generate everything) a PRNG's repeatability is vital to their project.
You mention that VB's Rnd is "not very good" as a PRNG...I mentioned a test that was done here to ensure random scatter of results, and IIRC they requested billions of values between 1 and 1,000,000 and compared the amount of times each value was generated...for the most part it was evenly scattered, there was no bias towards lower or higher numbers and no numbers were totally ignored. I did a quick search and did finally find https://www.vbforums.com/showthread....ight=PRNG+test which not only offers an alternative PRNG to RND but also provides (in post #5) proof that the RND function potentially gives truly perfect distribution (not the actual proof I was after, it was more detailed)
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|
Reply With Quote
