Page 1 of 1

## My method of Building the Better Dice Roller Code Included! Rate Topic: //<![CDATA[ rating = new ipb.rating( 'topic_rate_', { url: 'http://www.dreamincode.net/forums/index.php?app=forums&module=ajax&section=topics&do=rateTopic&t=76639&amp;s=2ff61f917bbab957ffbdfa3df4dbda5e&md5check=' + ipb.vars['secure_hash'], cur_rating: 0, rated: 0, allow_rate: 0, multi_rate: 1, show_rate_text: true } ); //]]>

### #1 Jaalenn

Reputation: 1
• Posts: 105
• Joined: 17-November 08

Posted 14 December 2008 - 03:06 AM

I have been looking around here in DIC and I have not been able to find a tutorial for building a decent dice roller in VB6. Considering the success I have had with a recent build I shall rectify this.

The first thing I learned about generating a random number was to use a simple format. Preferably something like ((100 – 1 + 1) * Rnd + 1). This will return a random number between 1 and 101. In order to set this to return a maximum value you will have to add the following code to your program.

```Dim A As Integer

Randomize
If A  > 100 Then
A = 100
End If
A = Cint((100 – 1 + 1) * Rnd + 1)

```

Now, if you’re looking to insert a specific value as a multiplier you will need to add it to the beginning of your code.

```Dim A As Integer

Randomize
If A  > 100 Then
A = 100
End If
A = 4 * Cint((100 – 1 + 1) * Rnd + 1)

```

If you would like for the person using your app to be able to do their own configuration then you will need to create two textboxes in order for them to input the numbers they want to use. If there is the possibility for a third modifier then use a third textbox in conjunction with a checkbox. Keep in mind that if the user inputs a value that is too high then the program will crash. You will have to set limits on how high the number is that they can use. I personally chose to limit them to 20 and 100. This is going by the basic rules of maximum rolls in both the Player’s Handbook and the Dungeon Master’s Guide for 3rd Edition D&D. You might want to change these values to suit your own needs according to the game you are using them for.
I used the following code to create the User Input for my app.

```Private Sub cmdRandomRoll_Click()
Dim A As Integer
Dim B As Integer
Dim C As Integer
Dim D As Integer
Dim V As String
Dim Result As String
Randomize

Result = txtResults.Text
V = vbNewLine
Dim Error As ErrObject
If txtFirst.Text = "" Then
MsgBox "You must Enter a number between 1 - 20!!! " & Err.Description, vbOKOnly + vbCritical, "Error"
Exit Sub
ElseIf txtFirst.Text > 20 Then
MsgBox "Number Exceeds Maximum Length!!! " & Err.Description, vbOKOnly + vbCritical, "Error"
Exit Sub
ElseIf txtSecond.Text = "" Then
MsgBox "You must Enter a number between 1 - 100!!! " & Err.Description, vbOKOnly + vbCritical, "Error"
Exit Sub
ElseIf txtSecond.Text > 100 Then
MsgBox "Number Exceeds Maximum Length!!! " & Err.Description, vbOKOnly + vbCritical, "Error"
Exit Sub
ElseIf chkXfor.Value = vbUnchecked Then
A = txtFirst.Text
B = txtSecond.Text
D = A * CInt((B - 1 + 1) * Rnd * 1)
If D = 0 Then
D = A
End If
ElseIf txtThird.Text > 10 Then
MsgBox "Number Exceeds Maximum Length!!! " & Err.Description, vbOKOnly + vbCritical, "Error"
Exit Sub
End If
A = txtFirst.Text
B = txtSecond.Text
Randomize
If chkXfor.Value = vbUnchecked Then
D = A * CInt((B - 1 + 1) * Rnd * 1)
If D = 0 Then
D = A
End If
ElseIf chkXfor.Value = vbChecked Then
C = txtThird.Text
D = A * CInt((B - 1 + 1) * Rnd * 1) * C
If D = 0 Then
D = A * C
End If
End If
lblResults.Caption = D
txtResults.Text = D & V & "--------" & V & txtResults.Text
Result = txtResults.Text
txtResults.SetFocus
End Sub

```

I realize some of this seems redundant, but the program works exactly as I intended it to. Feel free to play around with the code as much as you like.

I will include a full copy of the code for my version in a zip file to allow you to build it as is.

My only hope with this is that it will help all of you who wish to find a way to build the better Dice Roller!

```Private Sub chkXfor_Click()
If chkXfor.Value = vbChecked Then
txtThird.Enabled = True
txtThird.BackColor = &H80000005
ElseIf chkXfor.Value = vbUnchecked Then
txtThird.Enabled = False
txtThird.BackColor = &H8000000F
End If
End Sub

Private Sub cmaClear_Click()
txtResults.Text = ""
txtFirst.Text = ""
txtSecond.Text = ""
txtThird.Text = ""
lblResults.Caption = ""
chkXfor.Value = False

End Sub

Private Sub cmaCopy_Click()
txtResults.SelStart = 0
txtResults.SelLength = Len(txtResults.Text)
Clipboard.Clear
Clipboard.SetText txtResults.SelText
End Sub

Private Sub mnuCopy_Click()
Clipboard.Clear
Clipboard.SetText txtResults.SelText
End Sub

Private Sub mnuCut_Click()
Clipboard.Clear
Clipboard.SetText txtResults.SelText
txtResults.SelText = ""
End Sub

Private Sub mnuPaste_Click()
txtResults.SelText = Clipboard.GetText()
End Sub

Private Sub mnuSelectAll_Click()
txtResults.SelStart = 0
txtResults.SelLength = Len(txtResults.Text)
End Sub

Randomize
D = CInt((10 - 1 + 1) * Rnd + 1)
If D >= 10 Then
D = 10
End If
V = vbNewLine
lblResults.Caption = D
txtResults.Text = D & V & "------------" & V & txtResults.Text
End Sub

Randomize
D = CInt((100 - 1 + 1) * Rnd + 1)
If D >= 100 Then
D = 100
End If
V = vbNewLine
lblResults.Caption = D
txtResults.Text = D & V & "------------" & V & txtResults.Text
End Sub

Randomize
D = CInt((12 - 1 + 1) * Rnd + 1)
If D >= 12 Then
D = 12
End If
V = vbNewLine
lblResults.Caption = D
txtResults.Text = D & V & "------------" & V & txtResults.Text
End Sub

Randomize
D = CInt((20 - 1 + 1) * Rnd + 1)
If D >= 21 Then
D = 20
End If
V = vbNewLine
lblResults.Caption = D
txtResults.Text = D & V & "------------" & V & txtResults.Text
End Sub

Randomize
D = CInt((30 - 1 + 1) * Rnd + 1)
If D >= 31 Then
D = 30
End If
V = vbNewLine
lblResults.Caption = D
txtResults.Text = D & V & "------------" & V & txtResults.Text
End Sub

Randomize
D = CInt((4 - 1 + 1) * Rnd + 1)
V = vbNewLine
If D >= 4 Then
D = 4
End If
lblResults.Caption = D
txtResults.Text = D & V & "------------" & V & txtResults.Text
End Sub

Randomize
D = CInt((6 - 1 + 1) * Rnd + 1)
If D >= 6 Then
D = 6
End If
V = vbNewLine
lblResults.Caption = D
txtResults.Text = D & V & "------------" & V & txtResults.Text
End Sub

Randomize
D = CInt((8 - 1 + 1) * Rnd + 1)
If D >= 8 Then
D = 8
End If
V = vbNewLine
lblResults.Caption = D
txtResults.Text = D & V & "------------" & V & txtResults.Text
End Sub

Private Sub cmdClose_Click()
End Sub

Private Sub cmaRandomRoll_Click()
Dim A As Integer
Dim B As Integer
Dim C As Integer
Dim D As Integer
Dim V As String
Dim Result As String
Randomize

Result = txtResults.Text
V = vbNewLine
Dim Error As ErrObject
If txtFirst.Text = "" Then
MsgBox "You must Enter a number between 1 - 20!!! " & Err.Description, vbOKOnly + vbCritical, "Error"
Exit Sub
ElseIf txtFirst.Text > 20 Then
MsgBox "Number Exceeds Maximum Length!!! " & Err.Description, vbOKOnly + vbCritical, "Error"
Exit Sub
ElseIf txtSecond.Text = "" Then
MsgBox "You must Enter a number between 1 - 100!!! " & Err.Description, vbOKOnly + vbCritical, "Error"
Exit Sub
ElseIf txtSecond.Text > 100 Then
MsgBox "Number Exceeds Maximum Length!!! " & Err.Description, vbOKOnly + vbCritical, "Error"
Exit Sub
ElseIf chkXfor.Value = vbUnchecked Then
A = txtFirst.Text
B = txtSecond.Text
D = A * CInt((B - 1 + 1) * Rnd * 1)
If D = 0 Then
D = A
End If
ElseIf txtThird.Text > 10 Then
MsgBox "Number Exceeds Maximum Length!!! " & Err.Description, vbOKOnly + vbCritical, "Error"
Exit Sub
End If
A = txtFirst.Text
B = txtSecond.Text
Randomize
If chkXfor.Value = vbUnchecked Then
D = A * CInt((B - 1 + 1) * Rnd * 1)
If D = 0 Then
D = A
End If
ElseIf chkXfor.Value = vbChecked Then
C = txtThird.Text
D = A * CInt((B - 1 + 1) * Rnd * 1) * C
If D = 0 Then
D = A * C
End If
End If
lblResults.Caption = D
txtResults.Text = D & V & "--------" & V & txtResults.Text
Result = txtResults.Text
txtResults.SetFocus
End Sub

Me.Visible = True
chkXfor.Value = vbUnchecked
End Sub

```

#### Attached File(s)

Is This A Good Question/Topic? 0

## Replies To: My method of Building the Better Dice Roller

### #2 Bass1721

Reputation: 0
• Posts: 1
• Joined: 14-December 08

Posted 15 December 2008 - 09:45 PM

Sorry that I am missing so much, but if I were rolling dice, I would do it like this,
This came from an Excel VBA workbook that I used to just look at how the dice fall.

```Dim dice1, dice2
dice1 = Int((6 * Rnd) + 1)	' Generate random value between 1 and 6.
Range("c1").Select
ActiveCell.Value = dice1
dice2 = Int((6 * Rnd) + 1)	' Generate random value between 1 and 6.
Range("c2").Select
ActiveCell.Value = dice2

```

Seems to me the dice have 6 sides and you want the results to be 1 to 6.

I tried to run your code from the zip file, but it was in VB6 and VS2005 crashed trying to convert it.
I did grab your code, without the form, and made it work in VS2005 with the following changes,
but i do not understand what your code is trying to do.

```Public Class Form1

Me.Visible = True
chkXfor.Checked = False
End Sub

'Private Sub cmaRandomRoll_Click()
'End Sub
Private Sub cmaRandomRoll_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmaRandomRoll.Click
Dim A As Integer
Dim B As Integer
Dim C As Integer
Dim D As Integer
Dim V As String
Dim Result As String
Randomize()

Result = txtResults.Text
V = vbNewLine
'Dim Error As ErrObject
If txtFirst.Text = "" Then
MsgBox("You must Enter a number between 1 - 10!!! " & Err.Description, vbOKOnly + vbCritical, "Error")
Exit Sub
ElseIf txtFirst.Text > 10 Then
MsgBox("Number Exceeds Maximum Length!!! " & Err.Description, vbOKOnly + vbCritical, "Error")
Exit Sub
ElseIf txtSecond.Text = "" Then
MsgBox("You must Enter a number between 1 - 100!!! " & Err.Description, vbOKOnly + vbCritical, "Error")
Exit Sub
ElseIf txtSecond.Text > 100 Then
MsgBox("Number Exceeds Maximum Length!!! " & Err.Description, vbOKOnly + vbCritical, "Error")
Exit Sub
ElseIf chkXfor.Checked = False Then
A = txtFirst.Text
B = txtSecond.Text
D = A * CInt((B - 1 + 1) * Rnd() * 1)
If D = 0 Then
D = A
End If
ElseIf txtThird.Text > 10 Then
MsgBox("Number Exceeds Maximum Length!!! " & Err.Description, vbOKOnly + vbCritical, "Error")
Exit Sub
End If
A = txtFirst.Text
B = txtSecond.Text
Randomize()
If chkXfor.Checked = False Then
D = A * CInt((B - 1 + 1) * Rnd() * 1)
If D = 0 Then
D = A
End If
ElseIf chkXfor.Checked = True Then
C = txtThird.Text
D = A * CInt((B - 1 + 1) * Rnd() * 1) * C
If D = 0 Then
D = A * C
End If
End If
lblResults.Text = D.ToString
txtResults.Text = D.ToString & V.ToString & "--------" & V.ToString & txtResults.Text
Result = txtResults.Text
txtResults.Focus()
End Sub

Private Sub cmdClose_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdClose.Click
Me.Close()
End Sub
End Class

```

W_W EDIT:

### #3 Jaalenn

Reputation: 1
• Posts: 105
• Joined: 17-November 08

Posted 16 December 2008 - 03:25 AM

I did state that it was for VB6! BTW, I claim no responsibility for any issues you might have with code conversion!!

### #4 rdsrds2120

• D.I.C Regular

Reputation: 0
• Posts: 393
• Joined: 18-December 08

Posted 18 December 2008 - 09:34 PM

Thank you so much! I used this for a school project for a sudoku board game and it turned out great! I was able to shorten the code out a little bit, but unfortunately its saved at my school so I an't post it right now, thank you though!