VB6画双曲线

来源:互联网 发布:贝斯谱软件 编辑:程序博客网 时间:2024/04/30 16:24

Private Function 画双曲线函数()
Dim jd, a, b, c, xh, x4, y4, x5, y5, x0, y0, d
Me.Picture1.Circle (Aarray(k - 5), Aarray(k - 4)), 1, myclo '焦点F1
Me.Picture1.Circle (Aarray(k - 3), Aarray(k - 2)), 1, myclo '焦点F2
x0 = (Aarray(k - 5) + Aarray(k - 3)) / 2
y0 = (Aarray(k - 4) + Aarray(k - 2)) / 2
Me.Picture1.Circle (x0, y0), 1, myclo '画中心
If Aarray(k - 5) = Aarray(k - 3) Then '如果F1,F2的横坐标相等,则jd为pi/2
jd = pi / 2
Else
jd = -Atn((Aarray(k - 4) - Aarray(k - 2)) / (Aarray(k - 5) - Aarray(k - 3)))
End If
'A为实半轴长,C为焦点到中心的距离,B为虚半轴长
a = Abs((Sqr((Aarray(k - 5) - Aarray(k - 1)) ^ 2 + (Aarray(k - 4) - Aarray(k)) ^ 2) - Sqr((Aarray(k - 3) - Aarray(k - 1)) ^ 2 + (Aarray(k - 2) - Aarray(k)) ^ 2))) / 2
c = (Sqr((Aarray(k - 5) - Aarray(k - 3)) ^ 2 + (Aarray(k - 4) - Aarray(k - 2)) ^ 2)) / 2
b = Sqr(c ^ 2 - a ^ 2)
For xh = 0 To 2 * pi Step pi / 360 '设置循环,从0到2PI,步长为pi/18
If Cos(xh) = 0 Or Cos(xh + pi / 360) = 0 Then GoTo linenext   '转到标签处
x4 = a / Cos(xh)
y4 = b * Tan(xh)
x5 = a / Cos(xh + pi / 360)
y5 = b * Tan(xh + pi / 360)
d = Sqr((x4 * Cos(jd) + y4 * Sin(jd)) ^ 2 + (y4 * Cos(jd) - x4 * Sin(jd)) ^ 2) '曲线上的点到中心的距离
If d > 200 Then GoTo linenext
Me.Picture1.Line (x0 + x4 * Cos(jd) + y4 * Sin(jd), y0 + y4 * Cos(jd) - x4 * Sin(jd))-(x0 + x5 * Cos(jd) + y5 * Sin(jd), y0 + y5 * Cos(jd) - x5 * Sin(jd)), myclo
linenext: '标签
Next
Erase Aarray
End Function

原创粉丝点击