bz

' Gambas class file

'fuente: http://it.wikipedia.org/wiki/Curve_Bezi%C3%A8r#Applicazione_in_Visual_Basic_6

Public modo As String

Public Struct PuntoBezier
  x As Float
  y As Float
End Struct

Public pcerca As Integer

Private punti As New PuntoBezier[]

Public Sub _new()
  'un esempio con 5 punti di controllo

  Dim punto As PuntoBezier

  punto = New PuntoBezier
  punto.x = 20
  punto.y = 600
  punti.Add(punto)
  punto = New PuntoBezier
  punto.x = 200
  punto.y = 110
  punti.Add(punto)
  punto = New PuntoBezier
  punto.x = 500
  punto.y = 450
  punti.Add(punto)
  punto = New PuntoBezier
  punto.x = 800
  punto.y = 600
  punti.Add(punto)
  punto = New PuntoBezier
  punto.x = 950
  punto.y = 200
  punti.Add(punto)
  punto = New PuntoBezier
  punto.x = 650
  punto.y = 50
  punti.Add(punto)
  punto = New PuntoBezier

End

Public Sub Form_Open()

  Me.w = 1000
  Me.h = 700
  Area.Refresh()

End

Public Function factorial(n As Integer) As Single

  If n = 0 Then
    Return 1
  Else
    Return n * factorial(n - 1)
  Endif

End

Public Function NumeroCombinarorio(n As Integer, r As Integer) As Single
  'http://www.hiru.com/matematicas/numeros-combinatorios

  Return factorial(n) / (factorial(r) * (factorial(n - r)))

End

Public Sub Form_Resize()

  Area.w = Me.w - 10
  Area.h = Me.h - 10 - Area.x
  Area.Refresh()

End

Public Sub Area_Draw()

  bezierVB

End

Public Sub bezierVB()

  Dim t As Single
  Dim n As Integer
  Dim i As Integer
  Dim x As Integer

  Dim xtnAntigua As Single
  Dim ytnAntigua As Single

  Dim xtn As Single
  Dim ytn As Single

  'Poligonal original
  Select Case modo
    Case "desplazar"
      Paint.Brush = Paint.Color(Color.blue)
      For x = 0 To punti.Count - 1

        Paint.Rectangle(punti[x].x - 5, punti[x].y - 5, 10, 10)

      Next
      Paint.stroke

      Paint.Brush = Paint.Color(Color.black)
      For x = 1 To punti.Count - 1
        Paint.MoveTo(punti[x - 1].x, punti[x - 1].y)
        Paint.LineTo(punti[x].x, punti[x].y)
      Next
      Paint.stroke

    Case "desplaza2"
      For x = 0 To punti.Count - 1
        If x = pcerca Then
          Paint.Brush = Paint.Color(Color.red)
          Paint.Ellipse(punti[x].x - 10, punti[x].y - 10, 20, 20)
          Paint.Stroke
        Else
          Paint.Brush = Paint.Color(Color.blue)
          Paint.Rectangle(punti[x].x - 5, punti[x].y - 5, 10, 10)
        Endif
      Next

      Paint.Brush = Paint.Color(Color.Black)
      For x = 1 To punti.Count - 1
        Paint.MoveTo(punti[x - 1].x, punti[x - 1].y)
        Paint.LineTo(punti[x].x, punti[x].y)
      Next
      Paint.stroke
    Case ""
      Paint.Brush = Paint.Color(Color.black)
      For x = 1 To punti.Count - 1
        Paint.MoveTo(punti[x - 1].x, punti[x - 1].y)
        Paint.LineTo(punti[x].x, punti[x].y)
      Next
      Paint.stroke

  End Select

  Paint.Brush = Paint.Color(Color.blue)
  '-----------------------------------
  'curva definida por ecuacion...
  '-----------------------------------
  xtnAntigua = 0
  ytnAntigua = 0

  n = punti.Count - 1
  For t = 0 To 1 Step 0.001
    xtn = 0
    ytn = 0
    For i = 0 To n
      xtn = xtn + NumeroCombinarorio(n, i) * punti[i].x * (1 - t) ^ (n - i) * t ^ i
      ytn = ytn + NumeroCombinarorio(n, i) * punti[i].y * (1 - t) ^ (n - i) * t ^ i
    Next

    If xtnAntigua = 0 And ytnAntigua = 0 Then
      'primer puntono dibuja nada
    Else
      Paint.MoveTo(xtnAntigua, ytnAntigua)
      Paint.LineTo(xtn, ytn)
      Paint.Stroke
    Endif
    xtnAntigua = xtn
    ytnAntigua = ytn

  Next

End

Public Sub ButtonDibuja_Click()

End

Public Sub ButtonPoligono_Click()

  modo = ""
  punti.Clear
  Area.Refresh
  ButtonDesplazar.text = "Desplazar"

End

Public Sub AREA_MouseDown()

  Dim punto As PuntoBezier
  Dim ptmp As PuntoBezier

  Select Case modo
    Case "desplaza2"
      ptmp = New PuntoBezier
      ptmp.x = Mouse.X
      ptmp.y = Mouse.Y
      punti.Add(ptmp, pcerca)
      punti.Delete(pcerca + 1)
      ' ButtonDesplazar.text = "Desplazar"
    Case "desplazar"
      pcerca = puntoCercano(Mouse.x, Mouse.y)
      modo = "desplaza2"
      LabelMensaje.text = "Modo: haga click donde desee transladarlo"
      ButtonDesplazar.text = "Dejar de Desplazar"
    Case ""
      punto = New PuntoBezier
      punto.x = mouse.x
      punto.y = Mouse.y
      punti.Add(punto)

  End Select
  Area.Refresh

End

Public Sub ButtonDesplazar_Click()

  If ButtonDesplazar.text = "dejar de desplazar" Then
    modo = ""
    ButtonDesplazar.text = "Desplazar"
    LabelMensaje.text = "Modo: Añadiendo puntos"
  Else
    modo = "desplazar"
    ButtonDesplazar.text = "Desplazar"
    LabelMensaje.text = "Modo: Elija un punto"
  Endif

  Area.Refresh()

End

Public Sub puntoCercano(x As Integer, y As Integer) As Integer

  Dim a As Integer
  Dim dist As Integer
  Dim distminima As Integer = 100000000
  Dim C As Integer

  For a = 0 To punti.count - 1
    dist = (x - punti[a].x) ^ 2 + (y - punti[a].y) ^ 2
    If dist < distminima Then
      distminima = dist
      C = a
    Endif

  Next

  Return C

End