Imitate "Curves And Colors"
Screen Saver
'Add a module to your project (In the menu choose
Project -> Add Module, Then click Open)
'Set the form AutoRedraw property to True.
'Add 1 Timer. Set Timer interval property to 1.
'Insert the following code to your module:
Public Type POINTAPI
X As Long
Y As Long
End Type
Declare Function PolyBezier Lib "gdi32" (ByVal hdc As Long, lppt As POINTAPI, _
ByVal cPoints As Long) As Long
Public Type PlusDirType
X As Boolean
Y As Boolean
End Type
'Insert the following code to your form:
'Replace the '13' below with the number of your polygon sides
Const NumPoints = 13
Dim Points(1 To NumPoints) As POINTAPI
Dim PlusDir(1 To NumPoints - 1) As PlusDirType
Dim Dummy As Integer, Colour As Integer
Private Sub Form_Load()
Randomize
Colour = Int(Rnd * 16)
'The line below - to avoid the situation that the line and the
background at the same color
If Colour = 7 Then Colour = 8
'Replace the '4' below with your line width.
DrawWidth = 4
For Dummy = 1 To (NumPoints - 1)
Points(Dummy).X = Rnd * ScaleWidth * 3
Points(Dummy).Y = Rnd * ScaleHeight * 3
PlusDir(Dummy).X = Int(Rnd * 2)
Next Dummy
Points(NumPoints).X =
Points(1).X
Points(NumPoints).Y = Points(1).Y
End Sub
Private Sub Timer1_Timer()
'Increase the '3' below to decrease the rate of color changing.
If Int(Rnd * 3) = 2 Then
Colour = Int(Rnd * 16)
If Colour =
7 Then Colour = 8
End If
'Uncomment the 2 lines below to animate only 1 polygon
'Me.ForeColor = Me.BackColor
'Call PolyBezier(Me.hdc, Points(1), NumPoints)
Me.ForeColor = QBColor(Colour)
For Dummy = 1 To (NumPoints - 1)
If Int(Rnd * 102) = 100 Then PlusDir(Dummy).X = Not PlusDir(Dummy).X
If Int(Rnd * 102) = 100 Then PlusDir(Dummy).Y = Not PlusDir(Dummy).Y
If PlusDir(Dummy).X Then
If Points(Dummy).X + 10 < ScaleWidth Then Points(Dummy).X = Points(Dummy).X + 10
Else
If Points(Dummy).X - 10 > 0 Then Points(Dummy).X = Points(Dummy).X - 10
End If
If PlusDir(Dummy).Y Then
If Points(Dummy).Y + 10 < ScaleHeight Then Points(Dummy).Y = Points(Dummy).Y + 10
Else
If Points(Dummy).Y - 10 > 0 Then Points(Dummy).Y = Points(Dummy).Y - 10
End If
Points(NumPoints).X = Points(1).X
Points(NumPoints).Y = Points(1).Y
Next Dummy
Call PolyBezier(Me.hdc, Points(1), NumPoints)
Me.Refresh
End Sub