Visual Basic Tutorials

Welcome to Dream.In.Code
	Become an Expert! Join 300,455 Programmers for FREE! Get instant access to thousands of experts, tutorials, code snippets, and more! There are 1,599 people online right now. Registration is fast and FREE... Join Now! Chat LIVE With a Expert

My method of Building the Better Dice Roller

My method of Building the Better Dice Roller, Code Included!

Options

Jaalenn

14 Dec, 2008 - 02:06 AM

Post #1

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)

DiceRoller_Code.zip ( 10.87k ) Number of downloads: 117

Register to Make This Ad Go Away!

Bass1721

15 Dec, 2008 - 08:45 PM

Post #2

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.

CODE

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.

CODE

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:

Jaalenn

16 Dec, 2008 - 02:25 AM

Post #3

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

rdsrds2120

18 Dec, 2008 - 08:34 PM

Post #4

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!