document.write('
Data hosted with ♥ by Pastebin.com - Download Raw - See Original
  1. \' Gambas class file
  2.  
  3. \'fuente: http://it.wikipedia.org/wiki/Curve_Bezi%C3%A8r#Applicazione_in_Visual_Basic_6
  4.  
  5. Public modo As String
  6.  
  7. Public Struct PuntoBezier
  8.   x As Float
  9.   y As Float
  10. End Struct
  11.  
  12. Public pcerca As Integer
  13.  
  14. Private punti As New PuntoBezier[]
  15.  
  16. Public Sub _new()
  17.   \'un esempio con 5 punti di controllo
  18.  
  19.   Dim punto As PuntoBezier
  20.  
  21.   punto = New PuntoBezier
  22.   punto.x = 20
  23.   punto.y = 600
  24.   punti.Add(punto)
  25.   punto = New PuntoBezier
  26.   punto.x = 200
  27.   punto.y = 110
  28.   punti.Add(punto)
  29.   punto = New PuntoBezier
  30.   punto.x = 500
  31.   punto.y = 450
  32.   punti.Add(punto)
  33.   punto = New PuntoBezier
  34.   punto.x = 800
  35.   punto.y = 600
  36.   punti.Add(punto)
  37.   punto = New PuntoBezier
  38.   punto.x = 950
  39.   punto.y = 200
  40.   punti.Add(punto)
  41.   punto = New PuntoBezier
  42.   punto.x = 650
  43.   punto.y = 50
  44.   punti.Add(punto)
  45.   punto = New PuntoBezier
  46.  
  47. End
  48.  
  49. Public Sub Form_Open()
  50.  
  51.   Me.w = 1000
  52.   Me.h = 700
  53.   Area.Refresh()
  54.  
  55. End
  56.  
  57. Public Function factorial(n As Integer) As Single
  58.  
  59.   If n = 0 Then
  60.     Return 1
  61.   Else
  62.     Return n * factorial(n - 1)
  63.   Endif
  64.  
  65. End
  66.  
  67. Public Function NumeroCombinarorio(n As Integer, r As Integer) As Single
  68.   \'http://www.hiru.com/matematicas/numeros-combinatorios
  69.  
  70.   Return factorial(n) / (factorial(r) * (factorial(n - r)))
  71.  
  72. End
  73.  
  74. Public Sub Form_Resize()
  75.  
  76.   Area.w = Me.w - 10
  77.   Area.h = Me.h - 10 - Area.x
  78.   Area.Refresh()
  79.  
  80. End
  81.  
  82. Public Sub Area_Draw()
  83.  
  84.   bezierVB
  85.  
  86. End
  87.  
  88. Public Sub bezierVB()
  89.  
  90.   Dim t As Single
  91.   Dim n As Integer
  92.   Dim i As Integer
  93.   Dim x As Integer
  94.  
  95.   Dim xtnAntigua As Single
  96.   Dim ytnAntigua As Single
  97.  
  98.   Dim xtn As Single
  99.   Dim ytn As Single
  100.  
  101.   \'Poligonal original
  102.   Select Case modo
  103.     Case "desplazar"
  104.       Paint.Brush = Paint.Color(Color.blue)
  105.       For x = 0 To punti.Count - 1
  106.        
  107.         Paint.Rectangle(punti[x].x - 5, punti[x].y - 5, 10, 10)
  108.        
  109.       Next
  110.       Paint.stroke
  111.      
  112.       Paint.Brush = Paint.Color(Color.black)
  113.       For x = 1 To punti.Count - 1
  114.         Paint.MoveTo(punti[x - 1].x, punti[x - 1].y)
  115.         Paint.LineTo(punti[x].x, punti[x].y)
  116.       Next
  117.       Paint.stroke
  118.      
  119.     Case "desplaza2"
  120.       For x = 0 To punti.Count - 1
  121.         If x = pcerca Then
  122.           Paint.Brush = Paint.Color(Color.red)
  123.           Paint.Ellipse(punti[x].x - 10, punti[x].y - 10, 20, 20)
  124.           Paint.Stroke
  125.         Else
  126.           Paint.Brush = Paint.Color(Color.blue)
  127.           Paint.Rectangle(punti[x].x - 5, punti[x].y - 5, 10, 10)
  128.         Endif
  129.       Next
  130.      
  131.       Paint.Brush = Paint.Color(Color.Black)
  132.       For x = 1 To punti.Count - 1
  133.         Paint.MoveTo(punti[x - 1].x, punti[x - 1].y)
  134.         Paint.LineTo(punti[x].x, punti[x].y)
  135.       Next
  136.       Paint.stroke
  137.     Case ""
  138.       Paint.Brush = Paint.Color(Color.black)
  139.       For x = 1 To punti.Count - 1
  140.         Paint.MoveTo(punti[x - 1].x, punti[x - 1].y)
  141.         Paint.LineTo(punti[x].x, punti[x].y)
  142.       Next
  143.       Paint.stroke
  144.      
  145.   End Select
  146.  
  147.   Paint.Brush = Paint.Color(Color.blue)
  148.   \'-----------------------------------
  149.   \'curva definida por ecuacion...
  150.   \'-----------------------------------  
  151.   xtnAntigua = 0
  152.   ytnAntigua = 0
  153.  
  154.   n = punti.Count - 1
  155.   For t = 0 To 1 Step 0.001
  156.     xtn = 0
  157.     ytn = 0
  158.     For i = 0 To n
  159.       xtn = xtn + NumeroCombinarorio(n, i) * punti[i].x * (1 - t) ^ (n - i) * t ^ i
  160.       ytn = ytn + NumeroCombinarorio(n, i) * punti[i].y * (1 - t) ^ (n - i) * t ^ i
  161.     Next
  162.    
  163.     If xtnAntigua = 0 And ytnAntigua = 0 Then
  164.       \'primer puntono dibuja nada
  165.     Else
  166.       Paint.MoveTo(xtnAntigua, ytnAntigua)
  167.       Paint.LineTo(xtn, ytn)
  168.       Paint.Stroke    
  169.     Endif
  170.     xtnAntigua = xtn
  171.     ytnAntigua = ytn
  172.    
  173.   Next
  174.  
  175. End
  176.  
  177. Public Sub ButtonDibuja_Click()
  178.  
  179. End
  180.  
  181. Public Sub ButtonPoligono_Click()
  182.  
  183.   modo = ""
  184.   punti.Clear
  185.   Area.Refresh
  186.   ButtonDesplazar.text = "Desplazar"
  187.  
  188. End
  189.  
  190. Public Sub AREA_MouseDown()
  191.  
  192.   Dim punto As PuntoBezier
  193.   Dim ptmp As PuntoBezier
  194.  
  195.   Select Case modo
  196.     Case "desplaza2"
  197.       ptmp = New PuntoBezier
  198.       ptmp.x = Mouse.X
  199.       ptmp.y = Mouse.Y
  200.       punti.Add(ptmp, pcerca)
  201.       punti.Delete(pcerca + 1)
  202.       \' ButtonDesplazar.text = "Desplazar"
  203.     Case "desplazar"
  204.       pcerca = puntoCercano(Mouse.x, Mouse.y)
  205.       modo = "desplaza2"
  206.       LabelMensaje.text = "Modo: haga click donde desee transladarlo"
  207.       ButtonDesplazar.text = "Dejar de Desplazar"
  208.     Case ""
  209.       punto = New PuntoBezier
  210.       punto.x = mouse.x
  211.       punto.y = Mouse.y
  212.       punti.Add(punto)
  213.      
  214.   End Select
  215.   Area.Refresh
  216.  
  217. End
  218.  
  219. Public Sub ButtonDesplazar_Click()
  220.  
  221.   If ButtonDesplazar.text = "dejar de desplazar" Then
  222.     modo = ""
  223.     ButtonDesplazar.text = "Desplazar"
  224.     LabelMensaje.text = "Modo: Añadiendo puntos"
  225.   Else
  226.     modo = "desplazar"
  227.     ButtonDesplazar.text = "Desplazar"
  228.     LabelMensaje.text = "Modo: Elija un punto"
  229.   Endif
  230.  
  231.   Area.Refresh()
  232.  
  233. End
  234.  
  235. Public Sub puntoCercano(x As Integer, y As Integer) As Integer
  236.  
  237.   Dim a As Integer
  238.   Dim dist As Integer
  239.   Dim distminima As Integer = 100000000
  240.   Dim C As Integer
  241.  
  242.   For a = 0 To punti.count - 1
  243.     dist = (x - punti[a].x) ^ 2 + (y - punti[a].y) ^ 2
  244.     If dist < distminima Then
  245.       distminima = dist
  246.       C = a
  247.     Endif
  248.    
  249.   Next
  250.  
  251.   Return C
  252.  
  253. End
');