Solved

Random Numbers not selected properly vb6

Posted on 2013-10-24
33
340 Views
Last Modified: 2013-10-31
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
0
Comment
Question by:isnoend2001
  • 15
  • 8
  • 8
  • +1
33 Comments
 
LVL 76

Assisted Solution

by:GrahamSkan
GrahamSkan earned 100 total points
ID: 39599906
Without seeing the code it is difficult to debug.

Here is a some code to test the effectiveness of the Rnd function:

Sub RandomTest()
    Dim i As Integer
    Dim r As Integer
    Dim c1to60 As Integer
    Dim c61to80 As Integer
    Dim ratio As Single
    
    Do While True
        Randomize 'let the system time be the randomising seed
        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

Open in new window

0
 

Author Comment

by:isnoend2001
ID: 39600670
Here is the code that does the randomize:
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("Autoplaystart", vbResBitmap)
      'cmdAutoPlay.Picture = LoadResPicture("Autoplaystart", vbResBitmap)

80    If mStartedButtonClicked = True And mAutoPlayClicked = False And mStopAutoPlayClicked = False Then Set cmdAutoPlay.Picture = LoadResPicture("Autoplaystart", vbResBitmap)

90    mAutoPlayStarted = True 'KVS - v1.8
         
100       Set mColCardStat = New Collection
          'cmdStart.Enabled = False
110       ShowHitResults True, True
120       mCurrentBoardIndex = 0
130       ShowSelectedNumbersForBoard -1
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(gSelectedNumber) = gNumberCount(gSelectedNumber) + 1 'rm09-12-12
             
260           CandidateNumber(DrawnNumber(i)) = 81 - i
             
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 = False) Or i = 200 Then Exit Do
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).Selected
590           If bSelectedNumberHit Then KenoNumbers(thisIndex).Hit = True
             
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(6, 1) = TotalCrdtWinThisSession
              'gridCardStats.TextMatrix(6, 1) = CreditMode1String(TotalCrdtWinThisSession, mBetMode)
              'gridCardStats.TextMatrix(7, 1) = CreditMode1String(TotalCrdtWinThisSession - TotalMinusCrdSession, mBetMode)
             
1070          If Val(Mid(gridCardStats.TextMatrix(6, 1), 2)) = 0 Then
1080              gridCardStats.TextMatrix(6, 1) = CreditMode1String(ntot_amtwin, mBetMode)
1090          Else
                     
1100              If Val(Mid(gridCardStats.TextMatrix(6, 1), 2)) < Val(Mid(CreditMode1String(ntot_amtwin, mBetMode), 2)) Then
1110                  gridCardStats.TextMatrix(6, 1) = CreditMode1String(ntot_amtwin, mBetMode)
1120              End If
1130          End If
             
1140          gridCardStats.TextMatrix(7, 1) = CreditMode1String(TotalCrdtWinThisSession, mBetMode)
1150          gridCardStats.TextMatrix(8, 1) = CreditMode1String(TotalMinusCrdSession, mBetMode)
              'gridCardStats.TextMatrix(9, 1) = CreditMode1String(TotalCrdtWinThisSession - TotalMinusCrdSession, mBetMode)
1160          gridCardStats.TextMatrix(9, 1) = CreditMode1String(TotalCrdtWinThisSession - TotalMinusCrdSession, mBetMode)
1170          gridCardStats.TextMatrix(10, 1) = "$" & Format(Val(Mid(gridCardStats.TextMatrix(9, 1), 2)) / gridCardStats.TextMatrix(5, 1), "#0.00")
         
1180          Call upd_gridCurrent(ntot_amtwin) 'KVS - v6.1
         
1190      If ntot_amtwin > 0 Then
             
              'KVS - v8.0 - Start
1200          If Val(Mid(CreditMode1String(ntot_amtwin, mBetMode), 2)) >= gcurJackpotAmount And gcurJackpotAmount > 0 Then
1210               mhitjackpot = True
1220               mStopJackPot = False
1230              If Val(Mid(CreditMode1String(ntot_amtwin, mBetMode), 2)) >= gcurStopJackPotAmount And gcurStopJackPotAmount > 0 Then
1240                  mStopAutoPlayClicked = True 'V8.0 - KVS
'MsgBox "autoplaystopped"
'gcurStopJackPotAmount
1250              End If
               
1260               lblJackPotAmount.Caption = CreditMode1String(ntot_amtwin, mBetMode)
1270               Timer6.Interval = 30
1280               Timer6.Enabled = True
                   
                  ' GoTo LabelAddupWinning
                       
1290          ElseIf Val(Mid(CreditMode1String(ntot_amtwin, mBetMode), 2)) >= gcurStopJackPotAmount And gcurStopJackPotAmount > 0 Then
1300              mStopAutoPlayClicked = True 'V8.0 - KVS
                 
1310              mhitjackpot = True
1320              mStopJackPot = False
1330              lblJackPotAmount.Caption = CreditMode1String(ntot_amtwin, mBetMode)
                 
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("ABCDEFGHIJKLMNOPQRST")
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
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39600777
You should not have "randomize" in the loop. Just do it once outside of the loop.
0
 

Author Comment

by:isnoend2001
ID: 39600876
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 ?
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39600892
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

Open in new window

0
 
LVL 85

Expert Comment

by:Mike Tomlinson
ID: 39601005
Basically you should call Randomize just ONCE in the application when it starts.
0
 

Author Comment

by:isnoend2001
ID: 39601040
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 .
.
0
 
LVL 85

Assisted Solution

by:Mike Tomlinson
Mike Tomlinson earned 100 total points
ID: 39601052
No, no.  I'm not talking about the action of selecting numbers for your game.

The actual keyword `Randomize` generally only needs to be called ONCE for your entire application.  So like in the Load() event of the Form you'd call Randomize and then you don't call it again from anywhere else.
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 39601059
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.
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39601087
@Graham, My code isn't the same as yours in that I moved Randomize out of the loop.
0
 

Author Comment

by:isnoend2001
ID: 39601113
Thanks everyone for the comments, but i am at a loss as to what needs to be done to fix my problem
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39601138
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.
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 39601154
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.
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 39601168
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.
0
 

Author Comment

by:isnoend2001
ID: 39601178
the coder I hired was thru Freelancer and he has apparently dropped out and has not responded to my requests
0
 

Author Comment

by:isnoend2001
ID: 39601209
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
0
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 
LVL 76

Expert Comment

by:GrahamSkan
ID: 39601210
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.
0
 

Author Comment

by:isnoend2001
ID: 39601224
I will try to find variables that are not declared
0
 

Author Comment

by:isnoend2001
ID: 39601229
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 As Boolean 'for yes no cancel form
Private mDoNotDisplaySaveMessage As Boolean 'rmxx 09-29-12 to not show file saved message
Private mStopRuns As Integer
Private mPicNumberCounterIsExpanded As Boolean
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 As Boolean
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
0
 

Author Comment

by:isnoend2001
ID: 39601361
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
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 39601556
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.
0
 

Author Comment

by:isnoend2001
ID: 39601626
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
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39601739
Please state your complete requirements and depending on how involved it is I might come up with something.
0
 

Author Comment

by:isnoend2001
ID: 39601770
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
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 39601777
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
0
 

Author Comment

by:isnoend2001
ID: 39601823
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 ?
0
 
LVL 45

Accepted Solution

by:
Martin Liss earned 300 total points
ID: 39601830
I modified Graham's code a bit to generate 10,000,000 random numbers every time it runs.

The code looks like this

Private Sub Form_Load()
Randomize
RandomTest
End Sub

Sub RandomTest()
    Dim i As Long
    Dim r As Long
    Dim c1to60 As Long
    Dim c61to80 As Long
    Dim ratio As Single
    
    For i = 1 To 10000000
        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
    Debug.Print "Ratio is " & ratio & ". (expected ratio is 3)"
End Sub

Open in new window


The result of six runs gave this
Ratio is 2.999552. (expected ratio is 3)
Ratio is 2.998057. (expected ratio is 3)
Ratio is 2.998896. (expected ratio is 3)
Ratio is 3.001663. (expected ratio is 3)
Ratio is 3.001285. (expected ratio is 3)
Ratio is 2.998349. (expected ratio is 3)

so my conclusion is that if you simply put the randomize in FormLoad and then use r = Int(Rnd * 80) + 1 to generate your numbers then the numbers 61 to 80 are not always at the bottom.
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 39601842
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
0
 

Author Comment

by:isnoend2001
ID: 39601859
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
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39601865
one problem with this problem is testing so many times to determine results
Each of my six tests of 10,000,000 numbers each took less than 2 seconds.
0
 

Author Closing Comment

by:isnoend2001
ID: 39602096
thanks everone
Martinliss your code and showing how to use it fixed the problem.
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39602102
You're welcome and I'm glad I was able to help.

Marty - MVP 2009 to 2013
0
 

Author Comment

by:isnoend2001
ID: 39615236
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
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now