path$ = ""
Global NumberPoints_% , mouseClick = False ,showNumber=False ,showInfo = True ,closed=False ,findbezie = True
Global mouseSelect = False, x_s,y_s,x_e,y_e,w,h ,trust = False
Global grx,gry
Global mx#,my#,mz%
Graphics 800,600,32,2
SetBuffer BackBuffer()
grx = GraphicsWidth()/2 : gry = GraphicsHeight()/2
ClsColor 128,128,128
While Not KeyHit(1)
Cls
mx = MouseX() : my = MouseY() : mz = MouseZ()
KeyBoard( )
MouseCreatePoint( )
PointDraw( )
info( )
RelizMouseR()
Update( )
Flip
Wend
PointClear()
End
Type Point
Field x#,y#,vx#,vy#;,z#,vz#
Field number,selected = False
Field RLx#[2],RLy#[2]
Field PrevP.Point , NextP.Point
End Type
Global CurentPoint.Point ,PrevP.Point ,NextP.Point ,this.Point
Function PointNew.Point (PointX_# = 1.0,PointY_# = 1.0);,PointZ_# = 1.0 )
this.Point = New Point
this\x =PointX_
this\y =PointY_
;this\z =PointZ_
this\RLx#[0] = this\x
this\RLy#[0] = this\x
this\RLx#[1] = this\y
this\RLy#[1] = this\y
NumberPoints_ = NumberPoints_ +1
this\number =NumberPoints_
Return this
End Function
Function PointDelete(this.Point )
If this <> Null Delete this
NumberPoints_ = NumberPoints_ -1
End Function
Function PointClear()
Delete Each Point
NumberPoints_ = 0
End Function
Function MouseCreatePoint( )
If MouseDown(1) And mouseClick = False
mouseClick = True
CurentPoint = PointNew(mx ,my ) ;MouseX(),MouseY()
EndIf
If MouseDown(1) And mouseClick = True
CurentPoint\x = MouseX(): CurentPoint\y = MouseY()
EndIf
If MouseDown(1) = False And mouseClick = True
mouseClick = False
EndIf
End Function
Function PointDraw(p#=0.01,colore = $ffffff )
For this.Point = Each point
If this <> Null
Color 255,255,255
Rect this\x - 2,this\y-2,4,4,1
If this\selected Rect this\x - 4,this\y-4,8,8,0
If findbezie = False DrawBezie(this)
TextPoint(this)
EndIf
Next
End Function
Function TextPoint(this.Point )
If showNumber = True Then
Text this\x - 2,this\y - 16 , this\Number
Color 0,255,0
Oval this\RLx[0] - 2,this\RLy[0]-2,4,4,1
Oval this\RLx[1] - 2,this\RLy[1]-2,4,4,1
Line this\RLx[0] ,this\RLy[0] ,this\x , this\y
Line this\RLx[1] ,this\RLy[1] ,this\x , this\y
Color 255,255,255
EndIf
End Function
Function KeyBoard( )
Select True
Case KeyHit(16) Or KeyHit(59) ; [ Q ] [ F1 ]
showInfo = Not showInfo
Case KeyHit(57) ; [ SPACE]
showNumber = Not showNumber
Case KeyHit(15) ; [ TAB ]
PointClear()
Case KeyHit(46) ; [ C ]
closed= Not closed
Case KeyHit(32) ; [ D ]
findbezie= Not findbezie
End Select
End Function
Function info( )
If showInfo = True Then
on$ = "ON" : off$ = "OFF"
If findbezie findbezie_$ = on Else findbezie_$ =off
If closed closed_$ = on Else closed_$ =off
Rect 5,0,320, 140,0
Text 20,3,"press [ Q ] or [ F1 ] to OFF [ INFO : ]"
Text 20,20,"Press [ C ] to close bezie or [ SPACE ] to show othet control points"
Text 20,40,"Press [ TAB ] to delete all points"
Text 20,60,"[ STATUS : ]"
Text 20,80,"POINTS = [ "+NumberPoints_+" ]"
Text 20,100,"CALC BEZIE = [ "+findbezie_ +" ]"+" CLOSET = [ "+closed_+" ]"
EndIf
End Function
Function SelectPoint(this.Point )
If this\x>x_s And this\x <x_e And this\y>y_s And this\y<x_e
trust = True
If mouseSelect And this\selected = False
this\selected = True
Else ;mouseSelect = False And this\selected = True
EndIf
Else ; mouseSelect = False
If trust = False this\selected = False
EndIf
If mouseSelect = False Then trust =False
End Function
Function RelizMouseR()
If mouseSelect =False Then
If MouseDown(2)=True
mouseSelect =True
x_s=MouseX()
y_s=MouseY()
x_e=MouseX()
y_e=MouseY()
End If
Else
x_e=MouseX()
y_e=MouseY()
If MouseDown(2)=False
mouseSelect =False
; x_e = 0 : x_s =0 : y_e = 0 : y_s = 0
End If
End If
If x_e<x_s Then
x=x_e
w=-(x_s-x_e)
Else
x=x_s
w=x_e-x_s
End If
If y_e<y_s Then
y=y_e
h=-(y_s-y_e)
Else
y=y_s
h=y_e-y_s
End If
If mouseSelect =True Then
Color 0,200,0
Line x_s,y_s,x_e,y_s
Line x_s,y_s,x_s,y_e
Line x_e,y_s,x_e,y_e
Line x_e,y_e,x_s,y_e
End If
Color 255,255,255
End Function
Function Update( )
;If mouseSelect =False x_e = 0 : x_s =0 : y_e = 0 : y_s = 0
For this.Point = Each point
If this <> Null
If findbezie FindDrawBeziepoint(this )
SelectPoint(this )
EndIf
Next
End Function
Function FindDrawBeziepoint.Point(this.Point , asClosed=False)
Local p#=0.01,colore = $ffffff
If NumberPoints_ =2
PrevP = First Point
Line this\x,this\y,PrevP \x,PrevP \y
EndIf
; Получаем предыдущую и следующую точки
If NumberPoints_ > 2
NextP= After this
If this = Last Point
If closed Or asClosed And NextP = Null Then NextP = First Point Else NextP= this ;
EndIf
PrevP = Before this
If this = First Point
If closed Or asClosed And PrevP = Null Then PrevP = Last Point Else PrevP = this ;
EndIf
this\vx = (NextP\x - PrevP\x)/2
this\vy = (NextP\y - PrevP\y)/2
this\RLx[0] = this\x - this\vx/3
this\RLy[0] = this\y - this\vy/3
this\RLx[1] = this\x + this\vx/3
this\RLy[1] = this\y + this\vy/3
Local cof#=p
;LockBuffer BackBuffer() ;NextP ,PrevP
While cof< 1.0
pxx# =Bezie3Q(this\x,this\RLx[1] ,NextP \RLx[0] ,NextP \x ,cof)
pyy# =Bezie3Q(this\y ,this\RLy[1] ,NextP \RLy[0] ,NextP \y ,cof)
If cof#=p oldpxx# =pxx:oldpyy# =pyy
Line oldpxx# ,oldpyy# , pxx ,pyy
;WritePixel pxx,pyy,colore ,BackBuffer()
oldpxx# =pxx
oldpyy# =pyy
cof=cof+p
Wend
;UnlockBuffer BackBuffer()
EndIf
Return this
End Function
Function DrawBezie(this.Point,p#=0.01,colore = $ffffff )
Local cof#=p
PrevP = Before this
If this = First Point
If closed Or asClosed And PrevP = Null Then PrevP = Last Point Else PrevP = this ;
EndIf
NextP= After this
If this = Last Point
If closed Or asClosed And NextP = Null Then NextP = First Point Else NextP= this ;
EndIf
;LockBuffer BackBuffer() ;NextP ,PrevP
While cof< 1.0
pxx# =Bezie3Q(this\x,this\RLx[1] ,NextP \RLx[0] ,NextP \x ,cof)
pyy# =Bezie3Q(this\y ,this\RLy[1] ,NextP \RLy[0] ,NextP \y ,cof)
If cof#=p oldpxx# =pxx:oldpyy# =pyy
Line oldpxx# ,oldpyy# , pxx ,pyy
;WritePixel pxx,pyy,colore ,BackBuffer()
oldpxx# =pxx
oldpyy# =pyy
cof=cof+p
Wend
;UnlockBuffer BackBuffer()
End Function
Function Bezie3Q#(P0#,P1#,P2#,P3#,Tt# )
Local tt2# = (1.0-Tt)*(1.0-Tt) , tt3# = (1.0-Tt)*(1.0-Tt)*(1.0-Tt)
Return (tt3*P0 + 3*tt2*Tt*P1 +3*(1.0-Tt)*(Tt*Tt)*P2 + (Tt*Tt*Tt)*P3 )
End Function