Page 1 of 1

My method of Building the Better Dice Roller Code Included! Rate Topic: -----

#1 Jaalenn  Icon User is offline

  • D.I.C Head
  • member icon

Reputation: 1
  • View blog
  • 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

Private Sub cmaD10_Click()
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

Private Sub cmaD100_Click()
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

Private Sub cmaD12_Click()
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

Private Sub cmaD20_Click()
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

Private Sub cmaD30_Click()
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

Private Sub cmaD4_Click()
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

Private Sub cmaD6_Click()
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

Private Sub cmaD8_Click()
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()
    Unload Me
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

Private Sub Form_Load()
    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  Icon User is offline

  • New D.I.C Head

Reputation: 0
  • View blog
  • 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

	Private Sub Form_Load()
		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
		'Unload(Me)
		Me.Close()
	End Sub
End Class


W_W EDIT: :code:
Was This Post Helpful? 0
  • +
  • -

#3 Jaalenn  Icon User is offline

  • D.I.C Head
  • member icon

Reputation: 1
  • View blog
  • 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!!
Was This Post Helpful? 0
  • +
  • -

#4 rdsrds2120  Icon User is offline

  • D.I.C Regular

Reputation: 0
  • View blog
  • 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!
Was This Post Helpful? 0
  • +
  • -
Page 1 of 1