doc/skins/curve_maker/Bezier.bas

   1 Attribute VB_Name = "Bezier"
   2 Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
   3 Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
   4 Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
   5
   6 Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
   7 Public Const SRCCOPY = &HCC0020
   8
   9 Global imgDC As Long
  10
  11 Type pts
  12     x As Single
  13     y As Single
  14 End Type
  15 Global ft(30) As Single
  16 Global Pt(30) As pts
  17 Global MaxPt As Long
  18
  19 Sub bezier_draw(nb As Long, OffX As Long, OffY As Long)
  20 Dim i As Long, pas As Single, t As Single, oldx As Single, oldy As Single, x As Single, y As Single
  21
  22 pas = 1 / nb
  23 Call ini_factorielles
  24 oldx = Pt(0).x
  25 oldy = Pt(0).y
  26
  27 For t = pas To 1 Step pas
  28     x = bezier_ptx(t)
  29     y = bezier_pty(t)
  30     ppal.Line (OffX + oldx, OffY + oldy)-(OffX + x, OffY + y), QBColor(ppal.Color.Value)
  31     oldx = x
  32     oldy = y
  33 Next t
  34 For i = 0 To MaxPt
  35     ppal.PSet (OffX + Pt(i).x, OffY + Pt(i).y), QBColor(ppal.Color.Value)
  36 Next i
  37
  38 End Sub
  39
  40 Function bezier_pty(t As Single) As Single
  41 Dim k As Long, i As Long
  42 k = 0
  43 For i = 0 To MaxPt
  44     bezier_pty = bezier_pty + Pt(i).y * melange(k, MaxPt, t)
  45     k = k + 1
  46 Next i
  47
  48 End Function
  49 Function bezier_ptx(t As Single) As Single
  50 Dim k As Long, i As Long
  51 k = 0
  52 For i = 0 To MaxPt
  53     bezier_ptx = bezier_ptx + Pt(i).x * melange(k, MaxPt, t)
  54     k = k + 1
  55 Next i
  56
  57 End Function
  58
  59 Sub ini_factorielles()
  60 ft(0) = 1
  61 For i& = 1 To 30
  62     ft(i&) = ft(i& - 1) * i&
  63 Next i&
  64
  65 End Sub
  66
  67 Sub make_pt(i As Long, x As Long, y As Long)
  68 Pt(i).x = x
  69 Pt(i).y = y
  70
  71 End Sub
  72
  73 Function melange(i As Long, n As Long, t As Single) As Single
  74 melange = CSng(ft(n) / ft(i) / ft(n - i)) * t ^ i * (1 - t) ^ (n - i)
  75
  76 End Function
  77