Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement