❗ [Leeched] Rating System
I DID NOT MAKE THIS I JUST FOUND IT!
Okay I know blubb was gonna make some thing like this; I'm not sure if he made it yet.. so here it is
NEEDED
Remove the spaces it was censoring it.
[highlight=vb.net]
Public Class Form1
<DllImport("shell32.dll", CharSet:=CharSet.Auto)> _
Public Shared Function ExtractIconEx(ByVal stExeFileName As String, ByVal nIconIndex As Integer, ByVal phiconLarge As IntPtr(), ByVal phiconSmall As IntPtr(), ByVal nIcons As Integer) As Integer
End Function
Function LoadStandardIcon(ByVal PE As String, ByVal index As Integer, Optional ByVal Big As Boolean = True) As Bitmap
Dim bitm As New Bitmap(1, 1)
Dim hIcon() As IntPtr = New IntPtr(0) {}
If (ExtractIconEx(PE, index, If(Big, hIcon, Nothing), If(Big, Nothing, hIcon), 1) = 1) AndAlso hIcon(0) <> IntPtr.Zero Then
Dim TheIcon As Icon = Icon.FromHandle(hIcon(0))
bitm = TheIcon.ToBitmap
TheIcon.Dispose()
End If
Return bitm
End Function
Function ShadowBitmap(ByVal source As Bitmap, Optional ByVal Transparency As Integer = 90) As Bitmap
Dim btw As Bitmap = source.Clone()
For y = 0 To btw.Height - 1
For x = 0 To btw.Width - 1
Dim col As Color = source.GetPixel(x, y)
Dim alpha As Integer = CInt(col.R * 0.3 + col.G * 0.59 + col.B * 0.11)
If alpha > Transparency Then
btw.SetPixel(x, y, Color.FromArgb(alpha, alpha, alpha))
End If
Next
Next
Return btw
End Function
Dim Stars(5) As Bitmap
Function DrawRateBlock(ByVal Rating As Integer) As Image
Dim Shinystart As Bitmap = LoadStandardIcon("shell32.dll", 86)
Dim ShadowStar As Bitmap = ShadowBitmap(Shinystart)
Dim bitm As New Bitmap(Shinystart.Width * 5, Shinystart.Height)
Dim G As Graphics = Graphics.FromImage(bitm)
For i = 0 To Rating - 1
G.DrawImage(Shinystart, Shinystart.Width * i, 0)
G.Flush()
Next
For i = Rating To 4
G.DrawImage(ShadowStar, Shinystart.Width * i, 0)
G.Flush()
Next
G.Dispose()
Return bitm
End Function
Dim Current_Rating As Integer = 0
Dim Display_Rating As Integer = 0
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
For i = 0 To 5
Stars(i) = DrawRateBlock(i)
Next
PictureBox1.Size = New Size(160, 32)
PictureBox1.SizeMode = PictureBoxSizeMode.StretchImage
PictureBox1.Cursor = Cursors.Hand
PictureBox1.BorderStyle = BorderStyle.None
PictureBox1.Image = Stars(0)
End Sub
Private Sub PictureBox1_MouseClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseClick
Current_Rating = (e.Location.X \ CInt(PictureBox1.Width / 5)) + 1
End Sub
Private Sub PictureBox1_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Handles PictureBox1.MouseLeave
PictureBox1.Image = Stars(Current_Rating)
Display_Rating = Current_Rating
End Sub
Private Sub PictureBox1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove
Dim position As Integer = (e.Location.X \ CInt(PictureBox1.Width / 5)) + 1
If Display_Rating <> position Then
Display_Rating = position
PictureBox1.Image = Stars(position)
End If
End Sub
End Class
[/highlight]
Credits:
@cosconub - for master googling skills
[Leeched from] 007Hackerboy
Okay I know blubb was gonna make some thing like this; I'm not sure if he made it yet.. so here it is
NEEDED
- A brain
- A PictureBox
Code:
Imports System. Run time. Interop Services
[highlight=vb.net]
Public Class Form1
<DllImport("shell32.dll", CharSet:=CharSet.Auto)> _
Public Shared Function ExtractIconEx(ByVal stExeFileName As String, ByVal nIconIndex As Integer, ByVal phiconLarge As IntPtr(), ByVal phiconSmall As IntPtr(), ByVal nIcons As Integer) As Integer
End Function
Function LoadStandardIcon(ByVal PE As String, ByVal index As Integer, Optional ByVal Big As Boolean = True) As Bitmap
Dim bitm As New Bitmap(1, 1)
Dim hIcon() As IntPtr = New IntPtr(0) {}
If (ExtractIconEx(PE, index, If(Big, hIcon, Nothing), If(Big, Nothing, hIcon), 1) = 1) AndAlso hIcon(0) <> IntPtr.Zero Then
Dim TheIcon As Icon = Icon.FromHandle(hIcon(0))
bitm = TheIcon.ToBitmap
TheIcon.Dispose()
End If
Return bitm
End Function
Function ShadowBitmap(ByVal source As Bitmap, Optional ByVal Transparency As Integer = 90) As Bitmap
Dim btw As Bitmap = source.Clone()
For y = 0 To btw.Height - 1
For x = 0 To btw.Width - 1
Dim col As Color = source.GetPixel(x, y)
Dim alpha As Integer = CInt(col.R * 0.3 + col.G * 0.59 + col.B * 0.11)
If alpha > Transparency Then
btw.SetPixel(x, y, Color.FromArgb(alpha, alpha, alpha))
End If
Next
Next
Return btw
End Function
Dim Stars(5) As Bitmap
Function DrawRateBlock(ByVal Rating As Integer) As Image
Dim Shinystart As Bitmap = LoadStandardIcon("shell32.dll", 86)
Dim ShadowStar As Bitmap = ShadowBitmap(Shinystart)
Dim bitm As New Bitmap(Shinystart.Width * 5, Shinystart.Height)
Dim G As Graphics = Graphics.FromImage(bitm)
For i = 0 To Rating - 1
G.DrawImage(Shinystart, Shinystart.Width * i, 0)
G.Flush()
Next
For i = Rating To 4
G.DrawImage(ShadowStar, Shinystart.Width * i, 0)
G.Flush()
Next
G.Dispose()
Return bitm
End Function
Dim Current_Rating As Integer = 0
Dim Display_Rating As Integer = 0
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
For i = 0 To 5
Stars(i) = DrawRateBlock(i)
Next
PictureBox1.Size = New Size(160, 32)
PictureBox1.SizeMode = PictureBoxSizeMode.StretchImage
PictureBox1.Cursor = Cursors.Hand
PictureBox1.BorderStyle = BorderStyle.None
PictureBox1.Image = Stars(0)
End Sub
Private Sub PictureBox1_MouseClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseClick
Current_Rating = (e.Location.X \ CInt(PictureBox1.Width / 5)) + 1
End Sub
Private Sub PictureBox1_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Handles PictureBox1.MouseLeave
PictureBox1.Image = Stars(Current_Rating)
Display_Rating = Current_Rating
End Sub
Private Sub PictureBox1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove
Dim position As Integer = (e.Location.X \ CInt(PictureBox1.Width / 5)) + 1
If Display_Rating <> position Then
Display_Rating = position
PictureBox1.Image = Stars(position)
End If
End Sub
End Class
[/highlight]
Credits:
@cosconub - for master googling skills
[Leeched from] 007Hackerboy
Originally Posted by Physcadelic
