VB.NET - Rolling Dice

Note

When adding this control to your form, you should either use the name CtlDice or rename the class to match the name you selected.

Integer Textbox

Picture of this control

This control draws a square gameplay dice which offers a dice roll effect which stops on a random number. The default control settings will always roll an integet bewteen 1 and 6 (simulating a standard 6 sided dice,) however, the minumium and maximum throw can be adjusted for specialist roll-play dice. (e.g. 4-sided, 8 sided, 10 sided, 20 sided.)

The size of the control is automatically governed by choice of font/font size
The range of possible throws can be adjusted for any value between -99 and +100
The maximum possible throw must be greater than the minimum possible throw

Here is the full code for the CtlDice control. The key properties available to your project are explained at the end of this page.


Option Strict On
Option Explicit On
Imports System.Security.Cryptography
Imports System.ComponentModel
Imports System.Reflection.Metadata.Ecma335
Public Class CtlDice
 Private _min As Integer = 1
 Private _max As Integer = 6
 Private _value As Integer = 6
 Private _forceThrow As Integer = Integer.MinValue
 Private _font As New Font(Me.Font.Name, 20, Me.Font.Style)
 Private _rollTime As Integer = 3
 Private _rollIfClicked As Boolean = True
 Private ControlSize As New Size(30, 30)
 Private startTime As Date = Now
 Private LblDice As Label
 Event A_RollComplete()
 Private Sub CtlDice_Load(sender As Object, e As EventArgs) Handles MyBase.Load
  Me.Enabled = False
  LblDice = New Label With {
   .AutoSize = False,
   .BackColor = Color.White,
   .BorderStyle = BorderStyle.None,
   .Font = _font,
   .Location = New Point(0, 0),
   .Name = "LblDice1",
   .TextAlign = ContentAlignment.MiddleCenter
  }
  Me.AutoSize = False
  InitLblDice()
  Me.Enabled = True
 End Sub
 Private Sub InitLblDice()
  LblDice.Location = New Point(0, 0)
  Dim s1 As Size = TextRenderer.MeasureText("-99", _font)
  Dim s2 As Size = TextRenderer.MeasureText("100", _font)
  Dim w As Integer = GetMax(s1.Width, s1.Height, s2.Width, s2.Height)
  LblDice.Size = New Size(w, w)
  LblDice.Font = _font
  AddHandler LblDice.Click, AddressOf LblDice_Click
  Me.Controls.Add(LblDice)
  Me.Size = New Size(LblDice.Width, LblDice.Height)
  Me.BorderStyle = BorderStyle.FixedSingle
  Me.MinimumSize = Me.Size
  Me.MaximumSize = Me.Size
 End Sub
 Private Sub Tim_Tick(sender As Object, e As EventArgs) Handles Tim.Tick
  Dim rn As Integer = _value
  If Now < startTime.AddSeconds(_rollTime) Then
   While rn = _value
    rn = NextRandom(_min, _max + 1)
   End While
   _value = rn
   LblDice.Text = _value.ToString
   LblDice.Refresh()
  Else
   If _forceThrow >= _min AndAlso _forceThrow <= _max Then
    _value = _forceThrow
   Else
    _value = NextRandom(_min, _max + 1)
   End If
   LblDice.Text = _value.ToString
   LblDice.Refresh()
   Tim.Stop()
   _forceThrow = Integer.MinValue
   RaiseEvent A_RollComplete()
  End If
 End Sub
 Private Function NextRandom(min1 As Integer, max1 As Integer) As Integer
  ' note - will never return max - result will be between min1 and (max1 - 1) inclusive
  ' using RandomNumberGenerator instead of random because it is more random
  ' using range 0 to Integer.MaxValue because it improves randomness when range small
  '
  Dim ra As Integer = RandomNumberGenerator.GetInt32(Integer.MaxValue)
  ' If an old compiler will not accept  RandomNumberGenerator.GetInt32(Integer.MaxValue)  then
  ' Replace the line ... Dim ra As Integer = RandomNumberGenerator.GetInt32(Integer.MaxValue)
  ' with ... Dim ra As Integer = random1.Next(Integer.MaxValue)
  ' and add this new line ...  Private random1 As New Random
  ' immediately after ... Public Class CtlDice

  Dim range As Integer = max1 - min1
  Return min1 + (ra Mod range)
 End Function
 Private Sub LblDice_Click(sender As Object, e As EventArgs)
  If A_RollIfClicked Then
   startTime = Now
   Tim.Start()
  End If
 End Sub
 Private Function GetMax(v1 As Integer, v2 As Integer, v3 As Integer, v4 As Integer) As Integer
  If v2 > v1 Then v1 = v2
  If v3 > v1 Then v1 = v3
  If v4 > v1 Then v1 = v4
  Return v1
 End Function
 Public Sub A_RollWeightedDice(forceThrow As Integer)
  If forceThrow < _min OrElse forceThrow > _max Then
   _forceThrow = Integer.MinValue
  Else
   _forceThrow = forceThrow
  End If
  startTime = Now
  Tim.Start()
 End Sub
 Public Sub A_RollDice()
  _forceThrow = Integer.MinValue
  startTime = Now
  Tim.Start()
 End Sub
 <DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)>
 Public Property A_Value As Integer
  Get
   Return _value
  End Get
  Set(value As Integer)
   Select Case value
    Case < _min : _value = _min
    Case > _max : _value = _max
    Case Else : _value = value
   End Select
   LblDice.Text = _value.ToString
   LblDice.Refresh()
  End Set
 End Property
 <DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)>
 Public Property A_MinValue As Integer
  Get
   Return _min
  End Get
  Set(value As Integer)
   If value < -99 Then value = -99
   If value > 99 Then value = 99
   If value >= _max Then _max = value + 1
   _min = value
   If _value < _min Then
    _value = _min
    LblDice.Text = value.ToString
    LblDice.Refresh()
   End If
   If _value > _max Then
    _value = _max
    LblDice.Text = value.ToString
    LblDice.Refresh()
   End If
  End Set
 End Property
 <DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)>
 Public Property A_MaxValue As Integer
  Get
   Return _max
  End Get
  Set(value As Integer)
   If value < -98 Then value = -98
   If value > 100 Then value = 100
   If value <= _min Then _min = value - 1
   _max = value
   If _value < _min Then
    _value = _min
    LblDice.Text = value.ToString
    LblDice.Refresh()
   End If
   If _value > _max Then
    _value = _max
    LblDice.Text = value.ToString
    LblDice.Refresh()
   End If
  End Set
 End Property
 <DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)>
 Public Property A_ForceThrow As Integer
  Get
   Return _forceThrow
  End Get
  Set(value As Integer)
   If value < _min OrElse value > _max Then value = Integer.MinValue
   _forceThrow = value
  End Set
 End Property
 <DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)>
 Public Property A_RollTime As Integer
  Get
   Return _rollTime
  End Get
  Set(value As Integer)
   Select Case value
    Case < 0 : _rollTime = value
    Case > 10 : _rollTime = 10
    Case Else : _rollTime = value
   End Select
  End Set
 End Property
 <DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)>
 Public Property A_Font As Font
  Get
   Return _font
  End Get
  Set(value As Font)
   Select Case value.Size
    Case < 12 : _font = New Font(value.Name, 12.0, value.Style)
    Case > 400 : _font = New Font(value.Name, 400.0, value.Style)
    Case Else : _font = value
   End Select
   InitLblDice()
  End Set
 End Property
 <DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)>
 Public Property A_FontSize As Single
  Get
   Return CInt(_font.Size)
  End Get
  Set(value As Single)
   Select Case value
    Case < 12.0 : _font = New Font(_font.Name, 12.0, _font.Style)
    Case > 400.0 : _font = New Font(_font.Name, 400.0, _font.Style)
    Case Else : _font = New Font(_font.Name, value, _font.Style)
   End Select
   InitLblDice()
  End Set
 End Property
 <DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)>
 Public Property A_ForeColor As Color
  Get
   Return LblDice.ForeColor
  End Get
  Set(value As Color)
   LblDice.ForeColor = Color.FromArgb(255, value.R, value.G, value.B)
   LblDice.Refresh()
  End Set
 End Property
 <DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)>
 Public Property A_BackColor As Color
  Get
   Return LblDice.BackColor
  End Get
  Set(value As Color)
   LblDice.BackColor = Color.FromArgb(255, value.R, value.G, value.B)
   LblDice.Refresh()
  End Set
 End Property
 <DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)>
 Public Property A_RollIfClicked As Boolean
  Get
   Return _rollIfClicked
  End Get
  Set(value As Boolean)
   _rollIfClicked = value
  End Set
 End Property
End Class

Public Functions

CtlDice.A_RollWeightedDice(forcethrow as integer)
... Roll the dice but "force" it to land on the forcethrow value
... If forcethrow value is outside the A_MinValue to A_MaxValue range then "random" dice roll will occur

CtlDice.A_RollDice()
... Roll the dice. Result will be a random number between A_MinValue and A_MaxValue (inclusive)

Properties

Property	Type	Description
A_Value	Integer	Get/Set the number rolled/displayed on dice
A_MinValue	Integer	Get/Set lowest possible dice-roll value Could be any value between -99 and (A_MaxValue - 1)
A_MaxValue	Integer	Get/Set largest possible dice-roll value Could be any value between (A_MinValue + 1) and +100
A_ForceThrow	Integer	Get/Set a value that dice MUST land on setting any value outside or range A_MinValue to A_MaxValue will allow a normal "random" dice roll.
A_RollTime	Integer	Get/Set duration of dice roll effect must be between 0 and 10 (seconds)
A_Font	Font	Font used to display the dice value
A_FontSize	Single	A very old compiler may expect Integer font sizes
A_BackColor	Color	Get/Set colour of the dice Transparent colours will be made opaque. (Avoids VB.Net limitation)
A_ForeColor	Color	Get/Set colour of the digits on the dice Transparent colours will be made opaque. (Avoids VB.Net limitation)
A_RollIfClicked	Boolean	Get/Set flag to enable/disable click-on-dice event If "True" then dice will automatically roll when clicked If "False" then clicking on dice will have no effect.

DigitalDan.co.uk