Imports System.Drawing.Drawing2D
Public Class Form1
Public balls As New List(Of Ball)
Private WithEvents tmr As Windows.Forms.Timer
Private WithEvents tmr2 As Windows.Forms.Timer
Private m_IsActive As Boolean = False
Private m_MouseLocation As Point
Private shortMode As Boolean
Public Shared Function Toggle(ByRef toggleThis As Boolean) _
As Boolean
toggleThis = Not toggleThis
Return toggleThis
End Function
Private Sub Form1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove
If Not m_IsActive Then
Me.m_MouseLocation = New Point(e.X, e.Y)
m_IsActive = True
Else
If Math.Abs(e.X - Me.m_MouseLocation.X) > 10 Or _
Math.Abs(e.Y - Me.m_MouseLocation.Y) > 10 Then
' The user has moved the mouse so leave this program
Application.Exit()
End If
End If
End Sub
Private Sub Tmr_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tmr.Tick
For Each b As Ball In balls
'{
b.Move()
If b.Location.X <= 0 OrElse (b.Location.X + b.Size.Width) >= Me.ClientSize.Width Then
b.ReflectX()
End If
If b.Location.Y <= 0 OrElse (b.Location.Y + b.Size.Height) >= Me.ClientSize.Height Then
b.ReflectY()
End If
'}
Next
Me.Refresh()
End Sub
Private Sub Tmr2_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tmr2.Tick
Toggle(shortMode)
End Sub
'Draw
Protected Overrides Sub OnPaint(ByVal e As System.Windows.Forms.PaintEventArgs)
'MyBase.OnPaint(e)
Dim g As Graphics = e.Graphics
g.SmoothingMode = Drawing.Drawing2D.SmoothingMode.HighQuality
For Each b As Ball In balls
Dim rect As RectangleF
Dim sz As New SizeF(b.Size)
If b.Elastic Then
Dim pt As New PointF(b.Location.X, b.Location.Y)
If pt.X < 0 Then
sz.Width += pt.X
pt.X = 0
ElseIf (pt.X + sz.Width) > Me.ClientSize.Width Then
sz.Width = Me.ClientSize.Width - pt.X
End If
If pt.Y < 0 Then
sz.Height += pt.Y
pt.Y = 0
ElseIf (pt.Y + sz.Height) > Me.ClientSize.Height Then
sz.Height = Me.ClientSize.Height - pt.Y
End If
rect = New RectangleF(pt, sz)
Else
rect = New RectangleF(b.Location, b.Size)
End If
Dim ss As Pen = New Pen(Color.FromArgb(75, b.Brush), 1)
Dim rect2 As Rectangle = New Rectangle(b.Location.X, b.Location.Y, b.width, b.width)
'g.FillEllipse(b.Brush2, Rectangle.Inflate(rect2, -2, -2))
'g.DrawEllipse(ss, rect)
If balls.Count > 12 Then
Dim pts(2) As Point
Dim cpen As New Pen(Color.FromArgb(44, 66, 66, 66), 2)
'cpen.DashStyle = DashStyle.DashDotDot
pts(0) = New Point(balls(4).Location.X + (balls(4).width / 2), balls(4).Location.Y + (balls(4).width / 2))
pts(1) = New Point(balls(6).Location.X + (balls(6).width / 2), balls(6).Location.Y + (balls(6).width / 2))
pts(2) = New Point(balls(8).Location.X + balls(8).width / 2, balls(8).Location.Y + (balls(8).width / 2))
g.DrawCurve(cpen, pts)
End If
Next
Dim Roland As GraphicsPath
For Each b As Ball In balls
Dim rect2 As Rectangle = New Rectangle(b.Location.X, b.Location.Y, b.width, b.width)
Dim newrect As Rectangle = (Rectangle.Inflate(rect2, -1, -1))
Roland = CreateBottomRadialPath(newrect)
Dim clip As GraphicsPath = CreateRoundRectangle(newrect, b.width / 2)
g.SetClip(clip, CombineMode.Intersect)
Dim pgr As New PathGradientBrush(Roland)
Dim opacity As Integer = Convert.ToInt32(&HB2 * 1 + 0.5F)
Dim bounds As RectangleF = Roland.GetBounds()
Dim pgr2 As Pen
If shortMode = False Then pgr2 = New Pen(Color.FromArgb(45, b.Brush), 3) Else pgr2 = New Pen(Color.FromArgb(225, b.Brush), 3)
pgr.CenterPoint = New PointF((bounds.Left + bounds.Right) / 2.0F, (bounds.Top + bounds.Bottom) / 2.0F)
If shortMode = False Then pgr.CenterColor = b.Brush Else pgr.CenterColor = Color.FromArgb(47, b.Brush)
pgr.SurroundColors = New Color() {Color.FromArgb(175, Color.Black)}
'
g.FillPath(pgr, Roland)
g.DrawPath(pgr2, clip)
g.ResetClip()
CType(Roland, IDisposable).Dispose()
pgr2.Dispose()
Next
End Sub
Private Function CreateBottomRadialPath(ByVal rectangle As Rectangle) As GraphicsPath
Dim path As New GraphicsPath()
Dim rect As RectangleF = rectangle
rect.X -= rect.Width * 0.35F
rect.Y -= rect.Height * 0.15F
rect.Width *= 1.7F
rect.Height *= 2.2F
path.AddEllipse(rect)
path.CloseFigure()
Return path
End Function
Public Function CreateRoundRectangle(ByVal rectangle As Rectangle, ByVal radius As Integer) As GraphicsPath
Dim path As New GraphicsPath()
Dim l As Integer = rectangle.Left
Dim t As Integer = rectangle.Top
Dim w As Integer = rectangle.Width
Dim h As Integer = rectangle.Height
Dim d As Integer
If shortMode = True Then d = rectangle.Width / 2 Else d = rectangle.Width
path.AddArc(l, t, d, d, 180, 90) ' topleft
path.AddLine(l + radius, t, l + w - radius, t) ' top
path.AddArc(l + w - d, t, d, d, 270, 90) ' topright
path.AddLine(l + w, t + radius, l + w, t + h - radius) ' right
path.AddArc(l + w - d, t + h - d, d, d, 0, 90) ' bottomright
path.AddLine(l + w - radius, t + h, l + radius, t + h) ' bottom
path.AddArc(l, t + h - d, d, d, 90, 90) ' bottomleft
path.AddLine(l, t + h - radius, l, t + radius) ' left
path.CloseFigure()
Return path
End Function
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
SetStyle(ControlStyles.OptimizedDoubleBuffer Or ControlStyles.AllPaintingInWmPaint, True)
tmr = New Windows.Forms.Timer
tmr.Interval = 35
tmr.Start()
tmr2 = New Windows.Forms.Timer
tmr2.Interval = 8000
tmr2.Start()
Dim rnd As New Random
For i As Integer = 0 To 21
Dim b As New Ball(New Point(Me.Width / 2, Me.Height / 2))
balls.Insert(i, b)
Next
Me.BackColor = Color.Black
Me.Width = 1000
Me.Height = 800
End Sub
Private Sub Form1_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize
Invalidate()
End Sub
End Class
Public Class Ball
Public Location As PointF
Public Size As SizeF
Public Speed As Single = 100
Public Brush2 As Brush
Public Elastic As Boolean
Public Brush As Color
Private _dir As Single
Private r As New Random
Public Property Direction() As Single
Get
Return (_dir / Math.PI) * 180
End Get
Set(ByVal value As Single)
Do While value >= 360
value -= 360
Loop
Do While value < 0
value += 360
Loop
_dir = (value / 180) * Math.PI
End Set
End Property
Dim bwidth As Integer
Public Property width() As Integer
Get
Return Me.Size.Width
End Get
Set(ByVal value As Integer)
bwidth = value
End Set
End Property
Public WriteOnly Property Color() As Color
Set(ByVal value As Color)
Me.Brush2 = New SolidBrush(value)
End Set
End Property
Public Property Color2() As Color
Get
Return Color2
End Get
Set(ByVal value As Color)
Me.Brush = value
End Set
End Property
Public Sub New(ByVal Location As PointF)
Me.Location = Location
Dim c_size As Integer = Math.Floor(Rnd() * 45) + 40
Me.Size = New Size(c_size, c_size)
Me.Speed = Math.Ceiling(Rnd() * 10) + 6
' Me.Color2 = System.Drawing.Color.FromArgb(155, Math.Floor(r.Next(150, 255)), Math.Floor(r.Next(150, 255)), Math.Floor(r.Next(150, 255)))
Me.Color2 = System.Drawing.Color.FromArgb(255, Math.Floor(Rnd() * 256), Math.Floor(Rnd() * 256), Math.Floor(Rnd() * 256))
Me.Color = System.Drawing.Color.FromArgb(66, 1, Math.Floor(Rnd() * 256), Math.Floor(Rnd() * 256))
Me.Direction = Rnd() * 360
Me.Elastic = True
End Sub
Public Sub Move()
Location.X += Math.Sin(_dir) * Speed
Location.Y -= Math.Cos(_dir) * Speed
End Sub
Public Sub ReflectX()
Direction = 360.0! - Direction
End Sub
Public Sub ReflectY()
Direction = 540.0! - Direction
End Sub
End Class
Comments