a cool pattern, screensaver thing (ya just gotta see it)
Uses Line, Circle and Print functions on form to make a really whacky, cool, colourfull screensaver. Shows how to position printed text on forms, change colours, draw lines, draw circles, you just gotta see it. Just copy and paste into a form (add a timer, interval = 10, forms windowstate = vbmaximized and backcolor = vbblack)
Original Author: Coding Genius
Inputs
Add A timer: Name = Timer1, Interval = 10; form: Name = Form1, Backcolor = VBblack, Windowstate = VbMaximized.
Returns
Very colourfull moving patterns
Code
Dim i1 As Integer, i2 As Integer, c As ColorConstants, x As Single, y As Single, n As Integer, m As Integer
Private Sub Form_KeyPress(KeyAscii As Integer)
End
End Sub
Private Sub Form_Load()
Randomize
x = Screen.Width / 2: y = Screen.Height / 2
i1 = 1: i2 = 1
c = vbRed
m = 1: n = 6
End Sub
Private Sub Timer1_Timer()
i1 = i1 + 1: i2 = i2 + 1
'***For slower circles, remove the 's in the comment lines
'If Int(Rnd * 20) + 1 > 5 Then
x = x - m
y = y - m
n = n + m
Me.Circle (x, y), n * 30, SetForeColor
If n * 60 >= Screen.Width Or n < 5 Then
m = -m
End If
'End If
'***For shooting commets remove the 's (each 6 lines is one commet)
'Me.CurrentX = x
'Me.CurrentY = y - n * 30
'Print Chr(Int(Rnd * 255) + 1)
'Me.CurrentX = x
'Me.CurrentY = y + n * 30
'Print Chr(Int(Rnd * 255) + 1)
'Me.CurrentX = x - n * 30
'Me.CurrentY = y
'Print Chr(Int(Rnd * 255) + 1)
'Me.CurrentX = x + n * 30
'Me.CurrentY = y
'Print Chr(Int(Rnd * 255) + 1)
'Me.CurrentX = x - n * 30
'Me.CurrentY = y - n * 30
'Print Chr(Int(Rnd * 255) + 1)
'Me.CurrentX = x - n * 30
'Me.CurrentY = y + n * 30
'Print Chr(Int(Rnd * 255) + 1)
'Me.CurrentX = x + n * 30
'Me.CurrentY = y + n * 30
'Print Chr(Int(Rnd * 255) + 1)
'Me.CurrentX = x + n * 30
'Me.CurrentY = y - n * 30
'Print Chr(Int(Rnd * 255) + 1)
If i1 * 10 > Screen.Width Then i1 = 0
'***And in these
'Me.CurrentX = i1 * 10
'Me.CurrentY = i1 * 10
'Print Chr(Int(Rnd * 255) + 1)
'Me.CurrentX = Me.Width - i1 * 10
'Me.CurrentY = i1 * 10
'Print Chr(Int(Rnd * 255) + 1)
'Me.CurrentX = i1 * 10
'Me.CurrentY = Me.Height - i1 * 10
'Print Chr(Int(Rnd * 255) + 1)
'Me.CurrentX = Me.Width - i1 * 10
'Me.CurrentY = Me.Height - i1 * 10
'Print Chr(Int(Rnd * 255) + 1)
'***For some lines in the corners remove the 's
'If Int(Rnd * 20) + 1 < 2 Then
' SetForeColor
' Me.Line (0, 0)-(Int(Rnd * i1 * 10) + 1, Int(Rnd * i1 * 10) + 1)
' SetForeColor
' Me.Line (Me.Width, 0)-(Me.Width - Int(Rnd * i1 * 10) + 1, Int(Rnd * i1 * 10) + 1)
' SetForeColor
' Me.Line (0, Me.Height)-(Int(Rnd * i1 * 10) + 1, Me.Height - Int(Rnd * i1 * 10) + 1)
' SetForeColor
' Me.Line (Me.Width, Me.Height)-(Me.Width - Int(Rnd * i1 * 10) + 1, Me.Height - Int(Rnd * i1 * 10) + 1)
'End If
If i2 >= 255 Then
i2 = 1
If c = vbRed Then
c = vbGreen
ElseIf c = vbGreen Then
c = vbBlue
ElseIf c = vbBlue Then
c = vbRed
End If
End If
'***For the screen to be cleared every so often, remove the 's
'If Int(Rnd * 400) + 1 = 29 Then
' Me.Cls
'End If
End Sub
Private Function SetForeColor() As ColorConstants
If c = vbRed Then
Me.ForeColor = RGB(i2, 0, 0)
ElseIf c = vbGreen Then
Me.ForeColor = RGB(0, i2, 0)
Else
Me.ForeColor = RGB(0, 0, i2)
End If
If c = vbRed Then
SetForeColor = RGB(0, 0, i2)
ElseIf c = vbGreen Then
SetForeColor = RGB(0, i2, 0)
Else
SetForeColor = RGB(i2, 0, 0)
End If
End Function
Loading Comments ...
Comments
No comments have been added for this post.
You must be logged in to make a comment.