当前位置:编程学习 > VB >>

50分 谁能帮我把方刷 圆刷加入到程序中 谢谢啊 实在不懂这方面


Dim x(10) As Single, y(10) As Single, u1(4000) As Single, v1(4000) As Single
Dim num As Integer


Function hypot(ByVal x As Single, ByVal y As Single)
 hypot = Sqr(x ^ 2 + y ^ 2)
End Function


Private Sub Command1_Click()
 Picture1.Scale (0, 0)-(640, 480)
 x(0) = Text1: y(0) = Text2
 x(1) = Text3: y(1) = Text4
 x(2) = Text5: y(2) = Text6
 x(3) = Text7: y(3) = Text8
 DrawWidth = 3
 For i = 0 To 3
  Picture1.PSet (x(i), y(i))
 Next i
 DrawWidth = 1
 tspLine 3, 2, 0, 0, 0, 0
 Picture1.PSet (u1(0), v1(0))
  For i = 1 To num - 1
   Picture1.Line -(u1(i), v1(i))
  Next i
End Sub


Private Sub Command2_Click()
 End
End Sub



Sub tspLine(ByVal n As Integer, ByVal ch As Integer, ByVal tx1 As Single, ByVal tx2 As Single, ByVal ty1 As Single, ByVal ty2 As Single)
Dim a(10) As Single, b(10) As Single, c(10) As Single, dx(10) As Single, dy(10) As Single
Dim qx(10) As Single, qy(10) As Single
Dim tt As Single, bx3 As Single, bx4 As Single, by3 As Single, by4 As Single
Dim cx As Single, cy As Single, t(10) As Single, px(10) As Single, py(10) As Single
Dim u(3) As Single, v(3) As Single, i As Integer
num = 0
For i = 1 To n
 t(i) = hypot(x(i) - x(i - 1), y(i) - y(i - 1))
Next i
Select Case ch
 Case 0 '抛物条件
   u(0) = (x(1) - x(0)) / t(1): u(1) = (x(2) - x(1)) / t(2)
   u(2) = (u(1) - u(0)) / (t(2) + t(1))
   tx1 = u(0) - u(2) * t(1)
   u(0) = (y(1) - y(0)) / t(1): u(1) = (y(2) - y(1)) / t(2)
   u(2) = (u(1) - u(0)) / (t(2) + t(1))
   ty1 = u(0) - u(2) * t(1)
   u(0) = (x(n) - x(n - 1)) / t(n): u(1) = (x(n - 1) - x(n - 2)) / t(n - 1)
   u(2) = (u(0) - u(1)) / (t(n) + t(n - 1))
   tx2 = u(0) + u(2) * t(n)
   u(0) = (y(n) - y(n - 1)) / t(n): u(1) = (y(n - 1) - y(n - 2)) / t(n - 1)
   u(2) = (u(0) - u(1)) / (t(n) + t(n - 1))
   ty2 = u(0) + u(2) * t(n)
 Case 1 '夹持条件
  a(0) = 1: c(0) = 0: dx(0) = tx1: dy(0) = ty1
  a(n) = 1: b(n) = 0: dx(n) = tx2: dy(n) = ty2
 Case 2 '自由条件
  a(0) = 2: c(0) = 1
  dx(0) = 3 * (x(1) - x(0)) / t(1): dy(0) = 3 * (y(1) - y(0)) / t(1)
  a(n) = 2: b(n) = 1
  dx(n) = 3 * (x(n) - x(n - 1)) / t(n): dy(n) = 3 * (y(n) - y(n - 1)) / t(n)
 Case 3 '循环条件
  a(0) = 2: c(0) = 1
  dx(0) = 3 * (x(1) - x(0)) / t(1) - (t(1) * (x(2) - x(1)) / t(2) - x(1) + x(0)) / (t(1) + t(2))
  dy(0) = 3 * (y(1) - y(0)) / t(1) - (t(1) * (y(2) - y(1)) / t(2) - y(1) + y(0)) / (t(1) + t(2))
  a(n) = 2: b(n) = 1
  dx(n) = 3 * (x(n) - x(n - 1)) / t(n)
  dx(n) = dx(n) + (x(n) - x(n - 1) - t(n) * (x(n - 1) - x(n - 2)) / t(n - 1)) / (t(n) + t(n - 1))
  dy(n) = 3 * (y(n) - y(n - 1)) / t(n)
  dy(n) = dy(n) + (y(n) - y(n - 1) - t(n) * (y(n - 1) - y(n - 2)) / t(n - 1)) / (t(n) + t(n - 1))
End Select

'计算方程组系数阵和常数阵
For i = 1 To n - 1
 a(i) = 2 * (t(i) + t(i + 1)): b(i) = t(i + 1): c(i) = t(i)
 dx(i) = 3 * (t(i) * (x(i + 1) - x(i)) / t(i + 1) + t(i + 1) * (x(i) - x(i - 1)) / t(i))
 dy(i) = 3 * (t(i) * (y(i + 1) - y(i)) / t(i + 1) + t(i + 1) * (y(i) - y(i - 1)) / t(i))
Next i

'采用追赶法解方程组
c(0) = c(0) / a(0)
For i = 1 To n - 1
 a(i) = a(i) - b(i) * c(i - 1): c(i) = c(i) / a(i)
Next i
a(n) = a(n) - b(n) * c(i - 1)
qx(0) = dx(0) / a(0): qy(0) = dy(0) / a(0)
For i = 1 To n
  qx(i) = (dx(i) - b(i) * qx(i - 1)) / a(i)
  qy(i) = (dy(i) - b(i) * qy(i - 1)) / a(i)
Next i
px(n) = qx(n): py(n) = qy(n)
For i = n - 1 To 0 Step -1
 px(i) = qx(i) - c(i) * px(i + 1)
 py(i) = qy(i) - c(i) * py(i + 1)
Next i
'计算曲线上点的坐标
For i = 0 To n - 1
 bx3 = (3 * (x(i + 1) - x(i)) / t(i + 1) - 2 * px(i) - px(i + 1)) / t(i + 1)
 bx4 = ((2 * (x(i) - x(i + 1)) / t(i + 1) + px(i) + px(i + 1)) / t(i + 1)) / t(i + 1)
 by3 = (3 * (y(i + 1) - y(i)) / t(i + 1) - 2 * py(i) - py(i + 1)) / t(i + 1)
 by4 = ((2 * (y(i) - y(i + 1)) / t(i + 1) + py(i) + py(i + 1)) / t(i + 1)) / t(i + 1)
 tt = 0
 While (tt <= t(i + 1))
  cx = x(i) + (px(i) + (bx3 + bx4 * tt) * tt) * tt
  cy = y(i) + (py(i) + (by3 + by4 * tt) * tt) * tt
  u1(num) = cx: v1(num) = cy: num = num + 1: tt = tt + 0.5
 Wend
 u1(num) = x(i + 1): v1(num) = y(i + 1): num = num + 1
Next i
End Sub --------------------编程问答-------------------- 我也不懂. --------------------编程问答-------------------- JF --------------------编程问答-------------------- 友情UP --------------------编程问答-------------------- 帮顶 --------------------编程问答-------------------- 帮顶 --------------------编程问答-------------------- 楼主,这种要求别人帮你直接改工程的事情一般不会有人那么有闲给你折腾的.

最好是你自己调试与修改过程中遇到的具体问题. --------------------编程问答-------------------- UP --------------------编程问答-------------------- UP --------------------编程问答-------------------- 关注 --------------------编程问答-------------------- 关注
补充:VB ,  API
CopyRight © 2012 站长网 编程知识问答 www.zzzyk.com All Rights Reserved
部份技术文章来自网络,