Random Numbers not selected properly vb6
I hired a coder to write code fo a 20 card keno game that works like the keno games at the casinos.
the user can select 20 cards with each card marking upto 10 numbers from 1 to 80
example Card A select upto 10 numbers of the 80 on the board.
Card B select upto 10 numbers of the 80 on the board.
Card C the same
All the way to card T 20 cards
With each run the program randomly selects 20 numbers out of the 80 on the board.
If you are lucky and the random numbers hit the ones you selected you win.
I like marking my numbers in the first 40.
i have made patterns that can win about 50% of the time when run in my program
But trying the same numbers at the casino i never can get the same results.
I have included in the program the the most popular numbers hit (see attachment)
After millions of runs on 3 different computers i have determined that the numbers 60 thru 80 are always hit less than the numbers 1 thru 60
I posted a question about this a few months ago and the answer i got was to be sure the randomize was not in a loop with each randomize.
I adjusted the randomize and made sure it was not in a loop, but the problem remains.
to the point:
The numbers 1 thru 60 are hit more often than the numbers 60 tru 80.
How can this be fixed ?
I have even searched the web looking for a randomize ocx to no avail
Card marking video:
http://real20cardkeno.com/Videos/BigJackPot.asp
most-hit-numbers.jpg
the user can select 20 cards with each card marking upto 10 numbers from 1 to 80
example Card A select upto 10 numbers of the 80 on the board.
Card B select upto 10 numbers of the 80 on the board.
Card C the same
All the way to card T 20 cards
With each run the program randomly selects 20 numbers out of the 80 on the board.
If you are lucky and the random numbers hit the ones you selected you win.
I like marking my numbers in the first 40.
i have made patterns that can win about 50% of the time when run in my program
But trying the same numbers at the casino i never can get the same results.
I have included in the program the the most popular numbers hit (see attachment)
After millions of runs on 3 different computers i have determined that the numbers 60 thru 80 are always hit less than the numbers 1 thru 60
I posted a question about this a few months ago and the answer i got was to be sure the randomize was not in a loop with each randomize.
I adjusted the randomize and made sure it was not in a loop, but the problem remains.
to the point:
The numbers 1 thru 60 are hit more often than the numbers 60 tru 80.
How can this be fixed ?
I have even searched the web looking for a randomize ocx to no avail
Card marking video:
http://real20cardkeno.com/Videos/BigJackPot.asp
most-hit-numbers.jpg
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
You should not have "randomize" in the loop. Just do it once outside of the loop.
ASKER
Thanks MartinLiss
Not that good at coding thats why i hired a coder.
Wish i could get a response from the coder
How would i do that in the above code ?
Not that good at coding thats why i hired a coder.
Wish i could get a response from the coder
How would i do that in the above code ?
Sub RandomTest()
Dim i As Integer
Dim r As Integer
Dim c1to60 As Integer
Dim c61to80 As Integer
Dim ratio As Single
Randomize 'let the system time be the randomising seed
Do While True
For i = 1 To 1000
r = Int(Rnd * 80) + 1 'get a number between 1 and 80 inclusive
If r < 61 Then
c1to60 = c1to60 + 1
Else
c61to80 = c61to80 + 1
End If
Next i
ratio = c1to60 / c61to80
MsgBox "Ratio is " & ratio & ". (expected ratio is 3)"
Loop
End Sub
Basically you should call Randomize just ONCE in the application when it starts.
ASKER
Thanks Idle_Mind
The randomize can only be be done after cards are marked and a bet made, then clicking the start button is enabled and clicked to start the randomize.
Also their is a feature AutoPlay which basically clicks the start button for a new randomize of 20 numbers a user defined number of times.
I am trying to figure how to implement MartinLiss's code into my Sub Start .
.
The randomize can only be be done after cards are marked and a bet made, then clicking the start button is enabled and clicked to start the randomize.
Also their is a feature AutoPlay which basically clicks the start button for a new randomize of 20 numbers a user defined number of times.
I am trying to figure how to implement MartinLiss's code into my Sub Start .
.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Martin seems to have made a pasting error, so his code is the same as mine. I suspect that he meant to paste something else.
Actually the code was simply a demo to show that the Rnd function produces results distributed in an even fashion.
Actually the code was simply a demo to show that the Rnd function produces results distributed in an even fashion.
@Graham, My code isn't the same as yours in that I moved Randomize out of the loop.
ASKER
Thanks everyone for the comments, but i am at a loss as to what needs to be done to fix my problem
Put a breakpoint in line 160 (click in the left-hand margin of that line) and when the code gets there press F5. Does line 160 get executed more than once? If so move it into the Form_Load event.
Sorry Martin. I did you a disservice.
Actually there are two loops with the Randomize in the outer loop, so that it is reseeded after every run of the inner loop. This should ensure that the user's response time will select insert a truly random seed for each run of the inner loop.
Actually there are two loops with the Randomize in the outer loop, so that it is reseeded after every run of the inner loop. This should ensure that the user's response time will select insert a truly random seed for each run of the inner loop.
There are many undefined variables, so it is difficult to test the code.
The question arises: if you don't feel confident with VB6 coding, why not talk to our original coder who must have a good understanding of the project and how it has been implemented.
The question arises: if you don't feel confident with VB6 coding, why not talk to our original coder who must have a good understanding of the project and how it has been implemented.
ASKER
the coder I hired was thru Freelancer and he has apparently dropped out and has not responded to my requests
ASKER
Thanks MartinLiss
Put a breakpoint in line 160 (click in the left-hand margin of that line) and when the code gets there press F5. Does line 160 get executed more than once? If so move it into the Form_Load event.
It gets hit once(Randomize) each time the start button is clicked
Put a breakpoint in line 160 (click in the left-hand margin of that line) and when the code gets there press F5. Does line 160 get executed more than once? If so move it into the Form_Load event.
It gets hit once(Randomize) each time the start button is clicked
Yes. That's always a danger. FYI some experts here will take on paid projects. Those that do will say so and have contact information in their profiles.
Meanwhile I, and perhaps the others, will try to see if defining all the variables locally can get the procedure working in a test environment.
Meanwhile I, and perhaps the others, will try to see if defining all the variables locally can get the procedure working in a test environment.
ASKER
I will try to find variables that are not declared
ASKER
Dim mNumberOfLowWins As Currency 'for lstResult
Dim mNumberOfMedWins As Currency 'for lstResult
Dim mNumberOfBigWins As Currency 'for lstResult
Dim mlblResult2 As String 'for lstResult
Dim mTotalWinLost As Currency 'for lstResult
Dim mAveLowCredit As Currency 'for lstResult
Dim mLowCredit As Currency 'for lstResult
Dim mLossAmount As Currency 'for lstResult
Dim mLost As Currency 'for lstResult
Dim mWon As Currency 'for lstResult
Dim mRuns As Long 'for lstResult
Dim mHighDollarAmount As Currency 'for lstResult
Dim mBiggestWin As String 'for lstResult
Dim mWins As Integer 'for lstResult
Dim mLosses As Integer 'for lstResult
Dim mWinAmount As Currency 'for lstResult
Dim mNumberofResults As Integer 'for lstResult.listcount
'=========================
Dim mckbAutoStart As Boolean
Private mLastFileName As String '01-14-13
Private mLastWin As Currency
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private mFormCaption As String
Private mStopWhenWinReaches As Boolean
Private mStopDollarWinAmount As Currency
Private mDoNotClearCredits As Boolean
Private mAddUpWinning As Boolean
Private mStopLosses As Boolean
Private mStartCredits As Currency
Private mSaveStats As Boolean
Private mHighestValue As Currency
Private mpicOpenOptionsisExpaneded
Private mDoNotDisplaySaveMessage As Boolean 'rmxx 09-29-12 to not show file saved message
Private mStopRuns As Integer
Private mPicNumberCounterIsExpande
Private m_SortOrder As SortSettings 'rm 06-13-12
Private m_SortColumn As Integer 'rm 06-13-12
Private tempvarforcnt As Integer
Dim mStopJackPot As Boolean
Private mSavedfileIsOpen As Boolean 'set to true when opening a saved file 08-16-12
Private mSavedfileIsDirty As Boolean ' set to true if a saved file is changed 08-16-12
Private mIsDirty As Boolean 'checked on form unload if user wants to save changes to a new game 8-16-12
Private mDisableCommandButtons As Boolean 'rmx 08-08-12 disable command buttons when randomize in progress
Private mDoNotPromptSavedFile As Boolean, mCmdOpenBtnClkd As Boolean, cmdSaveBtnClkd As Boolean
Private mUnSavedfileIsOpen As Boolean, mExitWOrun As Boolean, mFrmUnloading As Boolean, mWinInProgress As Boolean
Private mCmdQuickPckOneClkd As Boolean, mCmdQuickPiclAllClkd As Boolean, mcmdQuickSpots As Boolean
Private mUnSavedfileIsDirty As Boolean
Private mEnableEraseAll As Boolean, mEnableEraseOne As Boolean 'KVS - v6.8
Private mNegativeAmountToStop As Currency
Private mStopAtNegativeAmount As Boolean
Private Declare Function sndPlaySound Lib "winmm" Alias "sndPlaySoundA" (lpszSoundName As Any, ByVal uFlags As Long) As Long
Const SND_SYNC = &H0 ' Play synchronously (default).
Const SND_NOSTOP = &H10 ' Do not stop any currently playing sound.
Private Declare Function PlaySoundData Lib "winmm.dll" Alias "PlaySoundA" (lpData As Any, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Const SND_ASYNC = &H1 ' /* play synchronously (default) */
Const SND_NODEFAULT = &H2 '/* silence (!default) if sound not found */
Const SND_MEMORY = &H4 '/* pszSound points to a memory file */
Const SND_LOOP = &H8 '/* loop the sound until next sndPlaySound */
Dim sndData() As Byte
Dim mEndNum As Long
Dim iCnt As Long
Dim mFormIsLoading As Boolean
Dim mCurrentDollarMode As String
Private clsINIFile As cInifile
'Modified by Subramanian KV, India. E-Mail : maney_1984@yahoo.com
'KVS - v2.2
'Declare public variable for the Text and Number for the Card - KVS
'Public sel_text_val As String, clval As Integer, s_fr_astrk
Public sel_text_val As String, clval As Integer, s_fr_astrk
Private totruns As Integer
Private mAutoPlayClicked As Boolean, mAutoPlayTimesToRun As Integer, mStartButtonClicked As Boolean, mStopAutoPlayClicked As Boolean
Private mAutoPlayStarted As Boolean, mAutoPlayStop As Boolean, bAutoPlay As Boolean, mhitjackpot As Boolean
Private mStartedButtonClicked As Boolean, mAutoPlayDisPlayed As Boolean, mAutoPlayButtonClicked As Boolean, mStopAutoPlayButtonClicked
Private mRandDone As Boolean, mranddonebet As Boolean, mranddonenobet As Boolean, mNextRand As Boolean, mFileOpenCanClk As Boolean
Private WinAmount As Double, mMinusCrdt As Boolean, WinCurentRun As Double
Private sCurRunChars As String, nIncreaseStake As Integer
Private TotalCrdtWinThisSession As Double, TotalMinusCrdSession As Double
Private TotalCrdtWinCurrent As Double, TotalMinusCurrent As Double
Private mCreditsAdded As String, mTotCredits As String, mCreditFrmFile As Currency
Const Blue As Long = 65536
Const Green As Long = 256
Const Red As Long = 1
Private Const FormColor As Long = (0 * Red) + (191 * Green) + (197 * Blue)
Private Declare Sub Sleep Lib "Kernel32.dll" (ByVal dwMilliseconds As Long)
Private Type KenoBoard
Index As Integer
Letter As String
Colour As Long
SelectedCount As Integer
Stake As Integer
LastGameWinnings As Long
End Type
Private KenoBoards(1 To 20) As KenoBoard
Private mCurrentBoardIndex As Integer
Private mColCardStat As Collection
Private Type Session
Balance As Long
Plays As Long
End Type
Private Type KenoNumber
Index As Integer
Selected As Boolean
AssignedLetters As String
Hit As Boolean
End Type
Private KenoNumbers(1 To 80) As KenoNumber
Private LettersColors(1 To 20) As Long
Const MAX_SELECTIONS As Integer = 10
Const BOARD_CELL_WIDTH As Long = 700 '900
Const CELL_MOUSE_SENSITIVITY As Long = 300
Const DRAWN_NUMBERS As Integer = 20
Private SoundSelect() As Byte
Private mSession As Session
Private mSelecting As Boolean
Public mBetMode As Integer
Private mSpeed As Integer
Private mBetCount As Integer
Private mCreditMode As Integer
Private mStkcnt As Integer 'KVS - v1.8
Dim mNumberOfMedWins As Currency 'for lstResult
Dim mNumberOfBigWins As Currency 'for lstResult
Dim mlblResult2 As String 'for lstResult
Dim mTotalWinLost As Currency 'for lstResult
Dim mAveLowCredit As Currency 'for lstResult
Dim mLowCredit As Currency 'for lstResult
Dim mLossAmount As Currency 'for lstResult
Dim mLost As Currency 'for lstResult
Dim mWon As Currency 'for lstResult
Dim mRuns As Long 'for lstResult
Dim mHighDollarAmount As Currency 'for lstResult
Dim mBiggestWin As String 'for lstResult
Dim mWins As Integer 'for lstResult
Dim mLosses As Integer 'for lstResult
Dim mWinAmount As Currency 'for lstResult
Dim mNumberofResults As Integer 'for lstResult.listcount
'=========================
Dim mckbAutoStart As Boolean
Private mLastFileName As String '01-14-13
Private mLastWin As Currency
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private mFormCaption As String
Private mStopWhenWinReaches As Boolean
Private mStopDollarWinAmount As Currency
Private mDoNotClearCredits As Boolean
Private mAddUpWinning As Boolean
Private mStopLosses As Boolean
Private mStartCredits As Currency
Private mSaveStats As Boolean
Private mHighestValue As Currency
Private mpicOpenOptionsisExpaneded
Private mDoNotDisplaySaveMessage As Boolean 'rmxx 09-29-12 to not show file saved message
Private mStopRuns As Integer
Private mPicNumberCounterIsExpande
Private m_SortOrder As SortSettings 'rm 06-13-12
Private m_SortColumn As Integer 'rm 06-13-12
Private tempvarforcnt As Integer
Dim mStopJackPot As Boolean
Private mSavedfileIsOpen As Boolean 'set to true when opening a saved file 08-16-12
Private mSavedfileIsDirty As Boolean ' set to true if a saved file is changed 08-16-12
Private mIsDirty As Boolean 'checked on form unload if user wants to save changes to a new game 8-16-12
Private mDisableCommandButtons As Boolean 'rmx 08-08-12 disable command buttons when randomize in progress
Private mDoNotPromptSavedFile As Boolean, mCmdOpenBtnClkd As Boolean, cmdSaveBtnClkd As Boolean
Private mUnSavedfileIsOpen As Boolean, mExitWOrun As Boolean, mFrmUnloading As Boolean, mWinInProgress As Boolean
Private mCmdQuickPckOneClkd As Boolean, mCmdQuickPiclAllClkd As Boolean, mcmdQuickSpots As Boolean
Private mUnSavedfileIsDirty As Boolean
Private mEnableEraseAll As Boolean, mEnableEraseOne As Boolean 'KVS - v6.8
Private mNegativeAmountToStop As Currency
Private mStopAtNegativeAmount As Boolean
Private Declare Function sndPlaySound Lib "winmm" Alias "sndPlaySoundA" (lpszSoundName As Any, ByVal uFlags As Long) As Long
Const SND_SYNC = &H0 ' Play synchronously (default).
Const SND_NOSTOP = &H10 ' Do not stop any currently playing sound.
Private Declare Function PlaySoundData Lib "winmm.dll" Alias "PlaySoundA" (lpData As Any, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Const SND_ASYNC = &H1 ' /* play synchronously (default) */
Const SND_NODEFAULT = &H2 '/* silence (!default) if sound not found */
Const SND_MEMORY = &H4 '/* pszSound points to a memory file */
Const SND_LOOP = &H8 '/* loop the sound until next sndPlaySound */
Dim sndData() As Byte
Dim mEndNum As Long
Dim iCnt As Long
Dim mFormIsLoading As Boolean
Dim mCurrentDollarMode As String
Private clsINIFile As cInifile
'Modified by Subramanian KV, India. E-Mail : maney_1984@yahoo.com
'KVS - v2.2
'Declare public variable for the Text and Number for the Card - KVS
'Public sel_text_val As String, clval As Integer, s_fr_astrk
Public sel_text_val As String, clval As Integer, s_fr_astrk
Private totruns As Integer
Private mAutoPlayClicked As Boolean, mAutoPlayTimesToRun As Integer, mStartButtonClicked As Boolean, mStopAutoPlayClicked As Boolean
Private mAutoPlayStarted As Boolean, mAutoPlayStop As Boolean, bAutoPlay As Boolean, mhitjackpot As Boolean
Private mStartedButtonClicked As Boolean, mAutoPlayDisPlayed As Boolean, mAutoPlayButtonClicked As Boolean, mStopAutoPlayButtonClicked
Private mRandDone As Boolean, mranddonebet As Boolean, mranddonenobet As Boolean, mNextRand As Boolean, mFileOpenCanClk As Boolean
Private WinAmount As Double, mMinusCrdt As Boolean, WinCurentRun As Double
Private sCurRunChars As String, nIncreaseStake As Integer
Private TotalCrdtWinThisSession As Double, TotalMinusCrdSession As Double
Private TotalCrdtWinCurrent As Double, TotalMinusCurrent As Double
Private mCreditsAdded As String, mTotCredits As String, mCreditFrmFile As Currency
Const Blue As Long = 65536
Const Green As Long = 256
Const Red As Long = 1
Private Const FormColor As Long = (0 * Red) + (191 * Green) + (197 * Blue)
Private Declare Sub Sleep Lib "Kernel32.dll" (ByVal dwMilliseconds As Long)
Private Type KenoBoard
Index As Integer
Letter As String
Colour As Long
SelectedCount As Integer
Stake As Integer
LastGameWinnings As Long
End Type
Private KenoBoards(1 To 20) As KenoBoard
Private mCurrentBoardIndex As Integer
Private mColCardStat As Collection
Private Type Session
Balance As Long
Plays As Long
End Type
Private Type KenoNumber
Index As Integer
Selected As Boolean
AssignedLetters As String
Hit As Boolean
End Type
Private KenoNumbers(1 To 80) As KenoNumber
Private LettersColors(1 To 20) As Long
Const MAX_SELECTIONS As Integer = 10
Const BOARD_CELL_WIDTH As Long = 700 '900
Const CELL_MOUSE_SENSITIVITY As Long = 300
Const DRAWN_NUMBERS As Integer = 20
Private SoundSelect() As Byte
Private mSession As Session
Private mSelecting As Boolean
Public mBetMode As Integer
Private mSpeed As Integer
Private mBetCount As Integer
Private mCreditMode As Integer
Private mStkcnt As Integer 'KVS - v1.8
ASKER
i have zipped the whole unfinished project ee would not let .dat files and others so i put it on my website here:
http://real20cardkeno.com/test.zip
I think the randomize was in a loop in this old version, before i moved it within Sub Start
http://real20cardkeno.com/test.zip
I think the randomize was in a loop in this old version, before i moved it within Sub Start
OK, but we are very close to exceeding the remit of this site and this zone. Personally I will put in an hour or two's work, but there are limitations.
Ideally, the asker will have some level of experience in the relevant zone and will display a few lines of code and ask why the few lines don't work as expected.
Debugging a whole project for a subtle difference between the expected and the actual result is another order of request. Don't be surprised if no-one is able or willing to give an absolute answer.
Ideally, the asker will have some level of experience in the relevant zone and will display a few lines of code and ask why the few lines don't work as expected.
Debugging a whole project for a subtle difference between the expected and the actual result is another order of request. Don't be surprised if no-one is able or willing to give an absolute answer.
ASKER
I understand in the past 10 years I have posted 619 questions and never this involved,
i wish I could buy a random ocx to include, but I have searched to no avail.
if i trusted vWorker more i would put it out to bid. Thanks for the help
i wish I could buy a random ocx to include, but I have searched to no avail.
if i trusted vWorker more i would put it out to bid. Thanks for the help
Please state your complete requirements and depending on how involved it is I might come up with something.
ASKER
each time the start button is clicked and runs Sub Start
generate 20 random numbers between 1 to 80
the way it works now the first 50 numbers are always hit often than numbers last 30
Numbers 60 to 80 are always at the bottom tested after millions of runs on 3 differenrt computers. just want the randomize to work correctly.
Thanks for your help
generate 20 random numbers between 1 to 80
the way it works now the first 50 numbers are always hit often than numbers last 30
Numbers 60 to 80 are always at the bottom tested after millions of runs on 3 differenrt computers. just want the randomize to work correctly.
Thanks for your help
Hello.
In the past, your requirements have been more limited or you have dealt with experts who does not such a strict view.
Debugging some fly-by-night's project seems to be of another order
In the past, your requirements have been more limited or you have dealt with experts who does not such a strict view.
Debugging some fly-by-night's project seems to be of another order
ASKER
i am open to suggestions the coder i hired fails to respond and I have been unable to fix it with limited knowledge of vb coding
I have tried to find a Randomize ocx or something.
What else can i do ?
I have tried to find a Randomize ocx or something.
What else can i do ?
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
As I suggested, you can enlist the paid help from experts here who are willing to provide that service.
As individuals, we are not allowed to promote our offers, but if you look in each expert's profile, you might find some of us who can offer that service off-line
As individuals, we are not allowed to promote our offers, but if you look in each expert's profile, you might find some of us who can offer that service off-line
ASKER
Thanks MartinLiss i will give that a try
one problem with this problem is testing so many times to determine results
GrahamSkan did not realize coders here could be paid. could have used that many times
one problem with this problem is testing so many times to determine results
GrahamSkan did not realize coders here could be paid. could have used that many times
one problem with this problem is testing so many times to determine resultsEach of my six tests of 10,000,000 numbers each took less than 2 seconds.
ASKER
thanks everone
Martinliss your code and showing how to use it fixed the problem.
Martinliss your code and showing how to use it fixed the problem.
You're welcome and I'm glad I was able to help.
Marty - MVP 2009 to 2013
Marty - MVP 2009 to 2013
ASKER
I had thought this prob was resolved, but after a few thousand runs i noticed all the high
numbers 60-80 were at the top and being selected more than lower numbers
I have finally found a solution here:
http://www.vbforums.com/showthread.php?739943-RESOLVED-Random-Numbers-not-selected-properly-vb6&p=4541169#post4541169
by Logophobic
After 14,000 runs There is a nice mixture (some small numbers, at the bottom and some large numbers at the top
Don't know why this works, but it does
numbers 60-80 were at the top and being selected more than lower numbers
I have finally found a solution here:
http://www.vbforums.com/showthread.php?739943-RESOLVED-Random-Numbers-not-selected-properly-vb6&p=4541169#post4541169
by Logophobic
After 14,000 runs There is a nice mixture (some small numbers, at the bottom and some large numbers at the top
Don't know why this works, but it does
ASKER
comments KVS was the coder
my comments rm and rmx and date
Sub Start()
' Dim LastBall As Integer
' Dim NumberHits As Integer
Static Runs As Long 'this would be compared to the number of runs in frmOptions changed to long from integer 11-13-12
10 mDisableCommandButtons = True 'rmx 08-08-12 disable the command buttons
20 Runs = Runs + 1
30 totruns = totruns + 1
40 gTotalRuns = gTotalRuns + 1 'rm 09-13-12
gAllRuns = gAllRuns + 1 'gTotalRuns
Dim i As Integer, thisIndex As Integer, j As Integer
Dim lCol As Integer, lRow As Integer, PreviousBorderColour As Long
Dim DrawnNumber(1 To DRAWN_NUMBERS) As Integer
Dim CandidateNumber(1 To 80) As Integer
Dim bRevealingNumber As Boolean
Dim bSelectedNumberHit As Boolean, bFlexStatUpd As Boolean
Dim ntot_amtwin As Long
50 On Error GoTo e
60 cmdStart.Visible = False
70 cmdAutoPlay.Visible = True
'cmdStart.Picture = LoadResPicture("Autoplayst
'cmdAutoPlay.Picture = LoadResPicture("Autoplayst
80 If mStartedButtonClicked = True And mAutoPlayClicked = False And mStopAutoPlayClicked = False Then Set cmdAutoPlay.Picture = LoadResPicture("Autoplayst
90 mAutoPlayStarted = True 'KVS - v1.8
100 Set mColCardStat = New Collection
'cmdStart.Enabled = False
110 ShowHitResults True, True
120 mCurrentBoardIndex = 0
130 ShowSelectedNumbersForBoar
140 UpdateBalance False
150 bFlexStatUpd = False
160 Randomize 'moved to above rmth 11-01-12 last
'start with a straight sequence of numbers from 1 to 80
170 For i = 1 To 80
180 CandidateNumber(i) = i
'while we're about it re-set all the Hits for the Board
190 KenoNumbers(i).Hit = False
200 Next i
'shuffle them about so that the last 10 (i.e. Indices 71-80) store the random numbers chosen...
210 For i = 1 To DRAWN_NUMBERS
220 thisIndex = Int(((80 - i) * Rnd) + 1)
230 DrawnNumber(i) = CandidateNumber(thisIndex)
lblLastNumber = DrawnNumber(20)
240 gSelectedNumber = DrawnNumber(i) 'rm09-12-12 counter to see what numbers get hit the most
250 gNumberCount(gSelectedNumb
260 CandidateNumber(DrawnNumbe
270 For j = 1 To 20
280 If i <> j Then
290 If DrawnNumber(i) = DrawnNumber(j) Then
' MsgBox "Samenos hit"
300 i = i - 1
310 Exit For
320 End If
330 End If
' DrawnNumber (20) 'last ball
340 Next j
350 Next i
360 SoundSelect = LoadResData("CLICK", "SOUND") 'v7.4
370 PlaySoundData SoundSelect(0), 0, SND_MEMORY Or SND_ASYNC Or SND_NODEFAULT Or SND_LOOP
'Randomize 'moved to above 11-03-12 last1
380 For i = 1 To DRAWN_NUMBERS * 10
'now we'll randomly flash a few numbers...
'...and every 10th iteration we'll reveal one of the chosen numbers
'v4.0
390 Do
400 bRevealingNumber = i Mod 10 = 0
410 If bRevealingNumber Then
420 thisIndex = DrawnNumber(i / 10)
430 Exit Do
440 Else
'Randomize 'rms 11-03-12 moved to above
450 thisIndex = (Rnd() * 79) + 1
460 End If
'If i Mod 10 = 0 Then Exit Do
'If (i Mod 10 = 0 And KenoNumbers(thisIndex).Hit
470 i = i + 1
480 DoEvents
'Call Sleep(3 - mSpeed)
490 If mSpeed = 2 Then
500 Call Sleep(((1 / 3) * 1) * 10)
510 ElseIf mSpeed = 1 Then
520 Call Sleep(((5 / 3) * 2) * 10)
530 ElseIf mSpeed = 0 Then
540 Call Sleep(((10 / 3) * 3) * 10)
550 End If
560 Loop
570 CellFromIndex thisIndex, lRow, lCol
580 bSelectedNumberHit = bRevealingNumber And KenoNumbers(thisIndex).Sel
590 If bSelectedNumberHit Then KenoNumbers(thisIndex).Hit
600 With flexKenoBoard
610 .Row = lRow
620 .Col = lCol
630 PreviousBorderColour = .CellBackColor
640 .CellBackColor = vbRed
650 If bSelectedNumberHit Then
660 .CellForeColor = vbWhite
'Added for Asteric Image - KVS - V1.x
670 If .CellPicture = imgblastrk Then '
680 Set .CellPicture = imgrdastrk.Picture
690 sndData = LoadResData("1HIT", "SOUND")
700 sndPlaySound sndData(0), SND_LOOP Or SND_ASYNC Or SND_MEMORY 'rmx 08-08-12
'v3.2.3 - To reset sound for Run after a hit
710 Sleep 100
720 PlaySoundData SoundSelect(0), 0, SND_MEMORY Or SND_ASYNC Or SND_NODEFAULT Or SND_LOOP
730 .TextMatrix(.Row, .Col) = ""
740 ElseIf .CellPicture <> imgrdastrk.Picture Then
750 Set .CellPicture = imgRedSpot.Picture
760 sndData = LoadResData("1HIT", "SOUND")
770 sndPlaySound sndData(0), SND_LOOP Or SND_ASYNC Or SND_MEMORY
'v3.2.3 - To reset sound for Run after a hit
780 Sleep 100
790 PlaySoundData SoundSelect(0), 0, SND_MEMORY Or SND_ASYNC Or SND_NODEFAULT Or SND_LOOP
800 End If
'*************************
'Add the different sound to play here for a HIT during Randomization - KVS - v1.8
'*************************
'During Randomization update the Flexgrid to show status - KVS - v1.6
'ShowHitResults False 'Commenetd - v4.2
810 Call HitFlexStausUpd(thisIndex)
820 bFlexStatUpd = True
830 ElseIf bRevealingNumber Or bSelectedNumberHit Then
840 .CellForeColor = vbBlue 'vbRed rmch 07-23-12
'Set .CellPicture = imgRedSpot.Picture
850 Set .CellPicture = imgBlueBorder.Picture ' .CellForeColor = vbRed
'Set .CellPicture = imgRedSpot.Picture
860 End If
870 DoEvents
' Call Sleep(3 - mSpeed)
880 If mSpeed = 2 Then
890 Call Sleep(((1 / 3) * 1) * 10)
900 ElseIf mSpeed = 1 Then
910 Call Sleep(((5 / 3) * 2) * 10)
920 ElseIf mSpeed = 0 Then
930 Call Sleep(((10 / 3) * 3) * 10)
940 End If
950 If Not bSelectedNumberHit Then .CellBackColor = PreviousBorderColour
960 End With
970 Next i
980 PlaySoundData SoundSelect(0), 0, SND_MEMORY Or SND_ASYNC Or SND_NODEFAULT
' cmdStart.Enabled = True
'KVS - v4.3
990 If bFlexStatUpd = False Then
1000 ShowHitResults False
1010 End If
1020 UpdateBalance True
1030 If bAutoPlay = False Then mAutoPlayStarted = False
'KVS - v2.4
1040 ntot_amtwin = get_tot_amt_win
1050 TotalCrdtWinThisSession = TotalCrdtWinThisSession + ntot_amtwin
1060 TotalMinusCrdSession = TotalMinusCrdSession + Val(lblTotalBet.Caption)
'gridCardStats.TextMatrix(
'gridCardStats.TextMatrix(
'gridCardStats.TextMatrix(
1070 If Val(Mid(gridCardStats.Text
1080 gridCardStats.TextMatrix(6
1090 Else
1100 If Val(Mid(gridCardStats.Text
1110 gridCardStats.TextMatrix(6
1120 End If
1130 End If
1140 gridCardStats.TextMatrix(7
1150 gridCardStats.TextMatrix(8
'gridCardStats.TextMatrix(
1160 gridCardStats.TextMatrix(9
1170 gridCardStats.TextMatrix(1
1180 Call upd_gridCurrent(ntot_amtwi
1190 If ntot_amtwin > 0 Then
'KVS - v8.0 - Start
1200 If Val(Mid(CreditMode1String(
1210 mhitjackpot = True
1220 mStopJackPot = False
1230 If Val(Mid(CreditMode1String(
1240 mStopAutoPlayClicked = True 'V8.0 - KVS
'MsgBox "autoplaystopped"
'gcurStopJackPotAmount
1250 End If
1260 lblJackPotAmount.Caption = CreditMode1String(ntot_amt
1270 Timer6.Interval = 30
1280 Timer6.Enabled = True
' GoTo LabelAddupWinning
1290 ElseIf Val(Mid(CreditMode1String(
1300 mStopAutoPlayClicked = True 'V8.0 - KVS
1310 mhitjackpot = True
1320 mStopJackPot = False
1330 lblJackPotAmount.Caption = CreditMode1String(ntot_amt
1340 Timer6.Interval = 30
1350 Timer6.Enabled = True
'GoTo LabelAddupWinning
1360 End If
'LabelAddupWinning:
'KVS - v8.0 - End
1370 WinAmount = ntot_amtwin 'v4.1
1380 mWinInProgress = True 'v4.0
1390 Call AddRunWinning(ntot_amtwin)
1400 Do
1410 DoEvents
1420 If Timer1.Enabled = False Then
1430 Timer6.Enabled = False
1440 Exit Do
1450 End If
1460 Loop
1470 WinCurentRun = 0 'KVS - v2.8
1480 End If
1490 sCurRunChars = chkstakefrselction("ABCDEF
1500 mDisableCommandButtons = False 'rmx 08-08-12 enable command buttons
' Dim losses As Currency
' Dim clblLost As Currency
Dim StopLosses As Currency
'
StopLosses = Val(txtStopLosses)
' StopLosses = -mStopLosses
'
'
' losses = CCur(lblCredit)
' 'If losses <= StopLosses Then
If mStopLosses Then
If CCur(lblCredit) <= -StopLosses Then
'MsgBox "stopped"
sndData = LoadResData("RING", "SOUND")
sndPlaySound sndData(0), SND_LOOP Or SND_ASYNC Or SND_MEMORY
Sleep 300
sndPlaySound ByVal 0, 0
mStopAutoPlayClicked = True
End If
End If
'Me.Caption = losses & " " & -CCur(lblBet)
' If losses >= StopLosses Then
' 'If mWinInProgress = True Then
' 'AddUpWinning
' 'Timer1.Enabled = False
' Me.Caption = "Stopped"
' mStopAutoPlayClicked = True
' 'End If
' End If
1520 Exit Sub
e:
' SendToSupport gWindowsVersion, Me.name, "cmdEmail_Click", Erl, err.Number, err.Description 'send thru jmail 11-10-2012
1530 ShowError err.Number, err.Description, "Sub Start", Erl 'write to file and display error
End Sub