www.pudn.com > gaoScreenSaver.zip > bezier2.frm
VERSION 5.00
Begin VB.Form Form1
AutoRedraw = -1 'True
BackColor = &H00000000&
BorderStyle = 0 'None
Caption = "Form1"
ClientHeight = 5145
ClientLeft = 0
ClientTop = 0
ClientWidth = 5400
FillStyle = 0 'Solid
ForeColor = &H00C0C0FF&
Icon = "bezier2.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 343
ScaleMode = 3 'Pixel
ScaleWidth = 360
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
WindowState = 2 'Maximized
Begin VB.Timer Timer3
Interval = 500
Left = 1320
Top = 1200
End
Begin VB.Timer Timer2
Enabled = 0 'False
Interval = 12000
Left = 360
Top = 3480
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 2
Left = 120
Top = 1560
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'**************************************
' Name: Bezier splines
' Description:A simple Bezier spline imp
' lementation. Allows the user to select c
' ontrol 'points on a picture box and then
' draw a Bezier curve between them.
'NEW!! - User can now move control points!!
' By: Mark Roberts
'***************************************
'made into a screensaver by Chris
Private Declare Function RealizePalette Lib "gdi32" (ByVal hdc As Long) As Long
Dim nc As Integer
Dim Cont(100, 1) As Integer
Dim NewLocPoint As Integer
Const Smooth = 0.02
Dim prevX
Dim prevY
Dim p As Integer
Dim p1 As Integer
Dim q(100) As Integer
Dim R(100) As Integer
Function b(k, n, u)
'Bezier blending function
b = c(n, k) * (u ^ k) * (1 - u) ^ (n - k)
End Function
Function c(n, R)
' Implements c!/r!*(n-r)!
c = fact(n) / (fact(R) * fact(n - R))
End Function
Function fact(n)
If n = 1 Or n = 0 Then
fact = 1
Else
fact = n * fact(n - 1)
End If
End Function
Private Sub AddCont(x, y)
Cont(nc, 0) = x: Cont(nc, 1) = y
nc = nc + 1
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
'you pressed a key while the screensaver was running
If start = True Then exitScreensaver
If nc < 2 Then
MsgBox "You need to plot more than 1 data point."
Form1.SetFocus
Exit Sub
Else
End If
'write the points of the curve you made to a file
Open "beziercurve.ini" For Output As #1
For i = 0 To nc - 1
Write #1, Cont(i, 0), Cont(i, 1)
Next i
Close #1
Plotpoint = False
ShowCursor False
'run the screensaver
Timer3.Enabled = True
End Sub
Private Sub Form_Load()
'set parameters dependent on screen resolution
If Screen.Width = 9600 Then
Maxs = 4 'line seperation
Maxc = 4 'count
Maxw = 636 'screen width
Maxh = 476 'screen height
ElseIf Screen.Width = 12000 Then
Maxs = 5
Maxc = 6
Maxw = 794
Maxh = 594
ElseIf Screen.Width >= 15360 Then
Maxs = 6
Maxc = 8
Maxw = 1016
Maxh = 760
Else
End If
Randomize
For i = 0 To 100
p = Int(Rnd * 2)
If p = 0 Then
q(i) = Maxs
Else
q(i) = -Maxs
End If
Randomize
p = Int(Rnd * 2)
If p = 0 Then
R(i) = Maxs
Else
R(i) = -Maxs
End If
Next i
End Sub
Private Function Clicked(x, y)
For i = 0 To nc
xp = Cont(i, 0): yp = Cont(i, 1)
If Abs(xp - x) < 3 And Abs(yp - y) < 3 Then
Clicked = i
Exit Function
End If
Next i
Clicked = -1
End Function
Sub Redraw()
'Redraws entire display
DoEvents
If start = False Then
Form1.Cls
For i = 1 To nc
xv = Cont(i - 1, 0): yv = Cont(i - 1, 1)
Form1.Circle (xv, yv), 2, 255
Form1.Print i
Next i
End If
Form1.DrawStyle = vbSolid
DrawBezier Smooth
End Sub
Sub DrawBezier(du)
n = nc - 1
Form1.PSet (Cont(0, 0), Cont(0, 1)) 'Plot the first point
For u = 0 To 1 Step du
x = 0: y = 0
For k = 0 To n
bv = b(k, n, u)
x = x + Cont(k, 0) * bv
y = y + Cont(k, 1) * bv
Next k
'this is the color code
Static d, e, f, l, m, q
If start = False Then
l = 0.1
m = 0.1
q = 0.1
Else
End If
If d < 255 Then GoTo 1
2
Randomize
l = Int(Rnd * 2)
m = Int(Rnd * 2)
q = Int(Rnd * 2)
If l = 0 Then
l = 0.1
Else
l = -0.1
End If
If m = 0 Then
m = 0.1
Else
m = -0.1
End If
If q = 0 Then
q = 0.1
Else
q = -0.1
End If
'color graduations
d = Int(Rnd * 256)
e = Int(Rnd * 256)
f = Int(Rnd * 256)
1
d = d + l
e = e + m
f = f + q
If d > 254 Or e > 254 Or f > 254 Or d < 1 Or e < 1 Or f < 1 Then GoTo 2
Form1.Line -(x, y), RGB(d, e, f)
Next u
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If start = True Then exitScreensaver
'change nc to allow more or less points to be drawn
If nc = 10 Then
MsgBox "Sorry, no more than 10 points. Look in the Form_MouseDown sub to change this."
Exit Sub
Else
End If
xv = Int(x): yv = Int(y)
cval = Clicked(xv, yv)
AddCont xv, yv
Form1.Circle (xv, yv), 2, QBColor(11)
Form1.Print nc
If nc = 1 Then
PSet (xv, yv)
Else
Form1.DrawStyle = vbSolid
End If
'draw the curve as you plot the points
If nc > 1 Then Redraw
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
MousePointer = vbCrosshair
'allow for a small mouse movement
If ((prevX = 0) And (prevY = 0)) Or ((Abs(prevX - x) < 5) And (Abs(prevY - y) < 5)) Then
prevX = x
prevY = y
Exit Sub
End If
'if mouse movement is large then end it
If start = True Then exitScreensaver
End Sub
Private Sub Timer1_Timer()
Timer1.Enabled = False
'this loop "moves" the curve about the screen,
'confined by the screen height\screen width
'Maxh\Maxw setting
Do
DoEvents
For i = 0 To nc
If Cont(i, 1) < Maxc Then
q(i) = Maxs
p = Maxs
ElseIf Cont(i, 1) > Maxh Then
q(i) = -Maxs
p = -Maxs
ElseIf Cont(i, 0) > Maxw Then
R(i) = -Maxs
p1 = Maxs
ElseIf Cont(i, 0) < Maxc Then
R(i) = Maxs
p1 = -Maxs
Else
End If
xv = Cont(i, 0) + R(i)
yv = Cont(i, 1) + q(i)
Cont(i, 0) = xv: Cont(i, 1) = yv
Next i
Redraw
Loop
End Sub
Private Sub Timer2_Timer()
Form1.Cls
'line seperation dependent on the screen resolution
If Screen.Width = 9600 Then
Maxs = 4
ElseIf Screen.Width = 12000 Then
Maxs = 5
ElseIf Screen.Width >= 15360 Then
Maxs = 6
Else
End If
Randomize
For i = 0 To 100
p = Int(Rnd * 2)
If p = 0 Then
q(i) = Maxs
Else
q(i) = -Maxs
End If
Randomize
p = Int(Rnd * 2)
If p = 0 Then
R(i) = Maxs
Else
R(i) = -Maxs
End If
Next i
End Sub
Private Sub Timer3_Timer()
Timer3.Enabled = False
If Plotpoint = True Then Exit Sub
On Error GoTo ErrorHandler:
Dim MyNumx, MyNumy
'get your plot points
Open "beziercurve.ini" For Input As #1
Do While Not EOF(1)
Input #1, MyNumx, MyNumy
cval = Clicked(MyNumx, MyNumy)
AddCont MyNumx, MyNumy
Loop
Close #1
Form1.Cls
start = True
Timer1.Enabled = True
Timer2.Enabled = True
Exit Sub
ErrorHandler:
MsgBox "The ""beziercurve.ini"" file cannot be found in your Window's folder. Program terminated.", vbCritical
End
End Sub