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