Sviluppatori Basic (e non) per Mobile e Desktop

Forum dedicato agli sviluppatori di B4X, Delphi, Xamarin


Non sei connesso Connettiti o registrati

Curve: Bezier e Spline Cubiche

Andare in basso  Messaggio [Pagina 1 di 1]

1 Curve: Bezier e Spline Cubiche il Mer Apr 25, 2018 10:55 pm

Dust

avatar
Admin
Admin
Un applicazione che traccia una firma, raccoglie i punti principali della firma e disegna le curve di Bezier o C-Spline.

Codice:

Sub Process_Globals
   'These global variables will be declared once when the application starts.
   'These variables can be accessed from all modules.
   Type Type_Point(X As Float,Y As Float, p As Float, u As Float)
   
   Dim Point() As Type_Point
   Dim xi,yi As Int
   Dim Fase As Int = 0
End Sub

Sub Globals
   'These global variables will be redeclared each time the activity is created.
   'These variables can only be accessed from this module.

   Private PanelMain As Panel
End Sub

Sub Activity_Create(FirstTime As Boolean)
   'Do not forget to load the layout file created with the visual designer. For example:
   Activity.LoadLayout("Layout1")
   
End Sub

Sub Activity_Resume

End Sub

Sub Activity_Pause (UserClosed As Boolean)

End Sub

Sub ButtonClear_Click
   Dim Point() As Type_Point
   
   PanelMain.Color=Colors.White
   PanelMain.RemoveAllViews
   Fase=0
End Sub

Sub ButtonSpline_Click
   DrawCspline
   Fase=1
End Sub

Sub ButtonBezier_Click
   DrawBezier
   Fase=2
End Sub


#Region Sign

Sub PanelMain_Touch (Action As Int, X As Float, Y As Float)
   Dim Range As Int = 25dip
   If Fase=0 Then
      Select Action
         Case 0 ' Down
            xi=X
            yi=y
            
            Dim Canv As Canvas
            Canv.Initialize(PanelMain)
            Canv.DrawCircle(X,Y,5dip,Colors.Black,True,1dip)
            AddPoint(X,Y)
         Case 1 ' Up
         Case 2 ' Move
            Dim L As Int = Sqrt(Power(X-xi,2)+Power(Y-yi,2))
            Dim Canv As Canvas
            Canv.Initialize(PanelMain)
            Canv.DrawCircle(X,Y,5dip,Colors.Black,True,1dip)
            If L>=Range Then
               AddPoint(X,Y)
               xi=X
               yi=Y
            End If
      End Select
   End If
End Sub

Sub AddPoint(X As Int, Y As Int)
   Dim PointNew(Point.Length+1) As Type_Point
   
   For i=0 To Point.Length-1
      PointNew(i)=Point(i)
   Next

   Dim P As Type_Point
   P.Initialize
   P.X=x
   P.Y=y
   PointNew(Point.Length)=p
   
   Point=PointNew
End Sub

#end region

#Region C-Spline

Sub DrawCspline
   PanelMain.RemoveAllViews
   
   For i=0 To Point.Length-1
      Dim V As Panel
      V.Initialize("ViewMove")
      V.Tag=I
      V.Color=Colors.Gray
      PanelMain.AddView(V,Point(i).X-5dip,Point(i).Y-5dip,10dip,10dip)
      
      Dim obj As Reflector
      obj.Target=V
      obj.SetOnTouchListener("ViewMove_Touch")
   Next
   DrawPointCSpline
End Sub

Private Sub DrawPointCSpline
   Dim piece As Int
   Dim xPos As Int
   Dim yPos As Int
 
   Dim Can As Canvas
   Can.Initialize(PanelMain)
   Can.DrawColor(Colors.White)
 
   SetPandU
   
   For piece = 0 To Point.Length - 2
      For xPos = Point(piece).x To Point(piece + 1).x
         yPos = getCurvePoint(piece, xPos)
         Can.DrawCircle(xPos, yPos,1dip,Colors.Red,True,1dip)
      Next
   Next
End Sub

Sub getCurvePoint(i As Int, v As Float) As Float
    Dim t As Float
    'derived curve equation (which uses p's and u's for coefficients)
    t = (v - Point(i).x) / Point(i).u
    Return t * Point(i + 1).y + (1 - t) * Point(i).y + Point(i).u * Point(i).u * (f(t) * Point(i + 1).p + f(1 - t) * Point(i).p) / Point.Length
End Sub

Sub F(x As Float) As Float
        Return x * x * x - x
End Sub

Private Sub SetPandU()
   Dim i As Int
   Dim d(Point.Length) As Float
   Dim w(Point.Length) As Float
   'Routine to compute the parameters of our cubic spline.  Based on equations derived from some basic facts...
   'Each segment must be a cubic polynomial.  Curve segments must have equal first and second derivatives
   'at knots they share.  General algorithm taken from a book which has long since been lost.

   'The math that derived this stuff is pretty messy...  expressions are isolated and put into
   'arrays.  we're essentially trying to find the values of the second derivative of each polynomial
   'at each knot within the curve.  That's why theres only N-2 p's (where N is # points).
   'later, we use the p's and u's to calculate curve points...

   For i = 1 To Point.Length - 2
      d(i) = 2 * (Point(i + 1).x - Point(i - 1).x)
   Next
   For i = 0 To Point.Length - 2
      Point(i).u = Point(i + 1).x - Point(i).x
   Next
   For i = 1 To Point.Length - 2
      w(i) = 6 * ((Point(i + 1).y - Point(i).y) / Point(i).u - (Point(i).y - Point(i - 1).y) / Point(i - 1).u)
   Next
   For i = 1 To Point.Length - 3
      w(i + 1) = w(i + 1) - w(i) * Point(i).u / d(i)
      d(i + 1) = d(i + 1) - Point(i).u * Point(i).u / d(i)
   Next
   Point(1).p = 0
   For i = Point.Length - 2 To 1 Step -1
      Point(i).p = (w(i) - Point(i).u * Point(i + 1).p) / d(i)
   Next
   Point(Point.Length-1).p = 0
End Sub

Sub ViewMove_Touch (viewtag As Object, action As Int, X As Float, Y As Float, motionevent As Object) As Boolean
   Dim V As Panel = Sender
   
   Dim Index As Int = V.Tag
   
   Select action
      Case 0
         ' Down
         xi=X
         yi=y
      Case 1
         ' Up
         Point(Index).X=V.Left
         Point(Index).Y=V.Top
         If Fase=1 Then
            DrawCspline
         else if Fase=2 Then
            DrawBezier
         End If
      Case 2
         ' Move
         X=Max(10,X)
         Y=Max(10,Y)
      
         V.Left=V.Left+X-xi
         V.Top=v.Top+Y-yi
         'Log($"Pto:${Index}=$1.0{x}-$1.0{y}  ${Point(Index).x}-${Point(Index).y}"$)
   End Select
      
   Return True
End Sub

#end Region

#Region Bezier

Sub DrawBezier
   PanelMain.RemoveAllViews
   
   For i=0 To Point.Length-1
      Dim V As Panel
      V.Initialize("ViewMove")
      V.Tag=I
      V.Color=Colors.Gray
      PanelMain.AddView(V,Point(i).X-5dip,Point(i).Y-5dip,10dip,10dip)
      
      Dim obj As Reflector
      obj.Target=V
      obj.SetOnTouchListener("ViewMove_Touch")
   Next
   DrawPointBezier(Point)
End Sub

Private Sub DrawPointBezier(iPoint() As Type_Point)
   Dim ax, bx, cx, ay, by, cy, xt, yt As Float 'ignore
   Dim axN, bxN(), cxN(), ayN, byN(), cyN(), xtN, ytN As Float
   
   Dim t As Float, I As Int 'ignore
   Dim iTotPoints As Int
   Dim X As Int
   
   Dim Can As Canvas
   Can.Initialize(PanelMain)
   Can.DrawColor(Colors.White)
   
   iTotPoints = iPoint.Length-1
   
   Dim bxN(iTotPoints) As Float 'ignore
   Dim cxN(iTotPoints) As Float
   Dim byN(iTotPoints) As Float 'ignore
   Dim cyN(iTotPoints) As Float
   
   'Form2.Cls
   'Form2.DrawWidth = 1
   'Draws control lines
   'Form2.ForeColor = vbBlue
   
   For X = 0 To iTotPoints - 1
      'Form2.Line (iPoint(X).X, iPoint(X).Y)-(iPoint(X + 1).X, iPoint(X + 1).Y)
      Can.DrawLine(iPoint(X).X ,iPoint(X).Y,iPoint(X + 1).X, iPoint(X + 1).Y, Colors.Blue,1dip)
   Next
   
   'The following is the core of the program.
   ' All others are just for dragging.
   cxN(0) = 0
   For X = 1 To iTotPoints - 1
      cxN(X) = iTotPoints * (iPoint(X).X - iPoint(X - 1).X) - cxN(X - 1)
   Next
       
   'Calcolo di ax
   axN = iPoint(iTotPoints).X - iPoint(0).X
   For X = 1 To iTotPoints - 1
      axN = axN - cxN(X)
   Next
   
   cyN(0) = 0
   For X = 1 To iTotPoints - 1
      cyN(X) = iTotPoints * (iPoint(X).Y - iPoint(X - 1).Y) - cyN(X - 1)
   Next
       
   'Calcolo di ay
   ayN = iPoint(iTotPoints).Y - iPoint(0).Y
   For X = 1 To iTotPoints - 1
      ayN = ayN - cyN(X)
   Next
         
   For t = 0 To 1 Step 0.0001
      xtN = axN * Power(t , iTotPoints)
      ytN = ayN * Power(t , iTotPoints)
   
      For X = iTotPoints - 1 To 1 Step -1
         xtN = xtN + cxN(X) * Power(t , X)
         ytN = ytN + cyN(X) * Power(t , X)
      Next
       
      xtN = xtN + iPoint(0).X
      ytN = ytN + iPoint(0).Y
   
      Can.DrawCircle(xtN,ytN,1dip,Colors.Red,True,1dip)
   Next

   
'   For I = 0 To 3
'      Can.DrawCircle(iPoint(I).X, iPoint(I).Y,3dip,Colors.Gray,True,1dip)
'   Next
End Sub


#end region

Visualizza il profilo http://basic4x.forumattivo.com

2 Re: Curve: Bezier e Spline Cubiche il Mer Apr 25, 2018 10:57 pm

Dust

avatar
Admin
Admin

Visualizza il profilo http://basic4x.forumattivo.com

Torna in alto  Messaggio [Pagina 1 di 1]

Permessi di questa sezione del forum:
Non puoi rispondere agli argomenti in questo forum