Pages

Monday, September 13, 2010

Rating UserControl in VB.Net

Create a UserControl with five pictureboxes named - PictureBox1,PictureBox2...PictureBox5.
Add following two images as resources. [or whichever you like]
  • Star = highlighted star
  • Star_Favorites = blank star





Here is the code for the UserControl


Public Class Rating
  Public Event Rated(ByVal favRating As Integer)

  Private _FavRating As Integer = 0
  Public ReadOnly Property FavouriteRating() As Integer
    Get
      Return _FavRating
    End Get
  End Property

  Private Sub Star_MouseClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseClick, PictureBox2.MouseClick, PictureBox3.MouseClick, PictureBox4.MouseClick, PictureBox5.MouseClick
    Dim favrating As Integer = Val(DirectCast(sender, PictureBox).Name.Replace("PictureBox", ""))
    _FavRating = favrating
    ShowRating(favrating)
    If e.Button = Windows.Forms.MouseButtons.Left Then
      RaiseEvent Rated(favrating)
    End If
  End Sub

  Private Sub Star_MouseHover(ByVal sender As Object, ByVal e As System.EventArgs) Handles PictureBox1.MouseHover, PictureBox2.MouseHover, PictureBox3.MouseHover, PictureBox4.MouseHover, PictureBox5.MouseHover
    Dim favrating As Integer = Val(DirectCast(sender, PictureBox).Name.Replace("PictureBox", ""))
    ShowRating(favrating)
  End Sub

  Private Sub Star_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Handles PictureBox1.MouseLeave, PictureBox2.MouseLeave, PictureBox3.MouseLeave, PictureBox4.MouseLeave, PictureBox5.MouseLeave
    If Not ClientRectangle.Contains(PointToClient(Cursor.Position)) Then
      ShowRating(FavouriteRating)
    End If
  End Sub

  Private Sub ShowRating(ByVal favrating As Integer)
    For i As Integer = 1 To 5
      If i <= favrating Then
        DirectCast(Controls.Find("PictureBox" & i.ToString, True)(0), PictureBox).Image = My.Resources.star
      Else
        DirectCast(Controls.Find("PictureBox" & i.ToString, True)(0), PictureBox).Image = My.Resources.Star_Favorites
      End If
    Next
  End Sub

End Class

No comments: