vbsimsth.txt

用VB写的simth园图程序

Const pi = 3.1415926
Public Function smith()
Dim R As Single
Dim i As Integer
R = 0
Picture1.Cls
Picture1.Scale (-1.1, 1.1)-(1.1, -1.1)  '坐标
Picture1.Line (-1.1, 0)-(1.1, 0)
Picture1.Line (1.05, 0.03)-(1.1, 0)
Picture1.Line (1.05, -0.03)-(1.1, 0)     'X轴
Picture1.Line (0, -1.1)-(0, 1.1)
Picture1.Line (0.03, 1.05)-(0, 1.1)
Picture1.Line (-0.03, 1.05)-(0, 1.1)     'Y轴
For i = 1 To 12
Picture1.Circle (R / (1 + R), 0), 1 / (1 + R), QBColor(5)
R = 1.6 * R + 0.1
Next
R = 0.2
For i = 1 To 16
Picture1.Circle (1, -1 / R), 1 / R, QBColor(8), pi / 2, pi / 2 + 2 * Atn(R)
Picture1.Circle (1, 1 / R), 1 / R, QBColor(8), 1.5 * pi - 2 * Atn(R), 1.5 * pi
R = 1.2 * R + 0.18
Next
End Function

Private Sub Command1_Click()
Call smith
Dim a, b, z
a = Val(Text1): b = Val(Text2): z = Val(Text6)
a = Abs(a) / z
b = b / z
X1 = a / (1 + a)
Y1 = 0
r1 = 1 / (1 + a)
If (b = 0) Then
b = 0.00001
End If
X2 = 1
Y2 = 1 / b
r2 = 1 / Abs(b)
Picture1.Circle (X1, Y1), r1, QBColor(12)
If (b < 0) Then
Picture1.Circle (X2, Y2), r2, 0, pi / 2, pi / 2 + 2 * Atn(-b)
Else
Picture1.Circle (X2, Y2), r2, 0, 1.5 * pi - 2 * Atn(b), 1.5 * pi
End If

a11 = 2 * (X2 - X1)
b11 = 2 * (Y2 - Y1)
c11 = r2 * r2 - X2 * X2 - Y2 * Y2 - r1 * r1 + X1 * X1 + Y1 * Y1
If (Abs(b11) > 0.00001) Then
aa = a11 / b11
cc = c11 / b11
e = 1 + aa * aa
f = 2 * (-X1 + aa * cc + aa * Y1)
g = X1 * X1 + (cc + Y1) * (cc + Y1) - r1 * r1
dlt = f * f - 4 * e * g
If (Abs(dlt) < 0.00001) Then
x11 = -f / 2 / e
y11 = -(aa * x11 + cc)
ElseIf (dlt > 0) Then
dlt = Sqr(dlt)
x11 = (-f + dlt) / 2 / e
y11 = -(aa * X1 + cc)
x22 = (-f - dlt) / 2 / e
y22 = -(aa * x22 + cc)
End If
Else
xx = -c11 / a11
dlt = r1 * r1 - (xx - X1) * (xx - X1)
If (Abs(dlt) < 0.00001) Then
x11 = xx
y11 = Y1
ElseIf (dlt > 0) Then
dlt = Sqr(dlt)
x11 = xx
y11 = Y1 + dlt
x22 = xx
y22 = Y1 - dlt
End If
End If
d22 = Sqr((x22 * x22) + (y22 * y22))
Text3.Text = Format(d22, ".000")
Picture1.Line (0, 0)-(x22, y22)
If (d22 <> 1) Then
Text4.Text = Format((1 + d22) / (1 - d22), ".000")
Else
Text4.Text = "∞"
End If
If (Abs(x22) < 0.0001) Then
alpha = 1.570796
If (y22 < 0) Then alpha = alpha + pi
Else
alpha = Atn(y22 / x22)
If (x22 < 0) Then alpha = alpha + pi
End If
If (alpha <> 0) Then alpha = 0.25 - ((alpha / pi) * 0.25)

Picture1.Circle (0, 0), d22, QBColor(13)

End Sub

Private Sub Command2_Click()
End
End Sub

Public Function smith1()
Call RandZ
Dim a As Single
Dim b As Single
Dim z As Single
Dim l As Single
Dim lmada As Single

a = Val(Text1): b = Val(Text2): z = Val(Text6): l = Val(Text7): lmada = Val(Text8)
Dim l1, l2, l3
l1 = 1.4 - l
l2 = l1 - 0.1
l3 = l1 + 0.1
Picture2.DrawWidth = 1
Picture2.Line (l1, -0.5)-(l1, -0.8), QBColor(10)
Picture2.Line (l1, 0.5)-(l1, 0.8), QBColor(10)
Picture2.Line (l2, -0.5)-(l3, 0.5), QBColor(10), B

belta = 2 * pi / lmada

ll = l * lmada
If (b <> 0) Then
pp = Sqr(((a - z) ^ 2 + b ^ 2) / ((a + z) ^ 2 + b ^ 2))
p = (1 + pp) / (1 - pp)
deltaz = lmada * (Atn(Abs(b) / (a + z)) + Tan(Abs(b) / (a - z + 0.00001))) / (4 * pi)
Text9.Text = Format((p + p * Tan(belta * (ll + deltaz)) * Tan(belta * (ll + deltaz))) / (p ^ 2 + Tan(belta * (ll + deltaz)) * Tan(belta * (ll + deltaz))), ".000")
Text10.Text = Format((p ^ 2 * Tan(belta * (ll + deltaz)) - Tan(belta * (ll + deltaz))) / (p ^ 2 + Tan(belta * (ll + deltaz)) ^ 2), ".000")
End If
If (a > z And b = 0) Then
p = a / z
Text9.Text = Format((p + p * Tan(belta * ll) ^ 2) / (1 + p ^ 2 * Tan(belta * ll) ^ 2), ".000")
Text10.Text = Format((Tan(belta * ll) - p ^ 2 * Tan(belta * ll) ^ 2) / (1 + p ^ 2 * Tan(belta * ll) ^ 2))
End If
If (a = z And b = 0) Then
Text9.Text = Format(z, ".000")
Text10.Text = Format(0)
End If
If (a < z And b = 0) Then
p = z / a
Text9.Text = Format((p + p * Tan(belta * ll) ^ 2) / (p ^ 2 + Tan(belta * ll) ^ 2), ".000")
Text10.Text = Format((p ^ 2 * Tan(belta * ll) - Tan(belta * ll)) / (p ^ 2 + Tan(belta * ll) ^ 2))
End If


End Function

Private Sub Command3_Click()
Call smith1
End Sub

Private Sub Picture1_Paint()
Call smith
End Sub

Public Function RandZ()
Picture2.Cls
Picture2.Scale (-2, 1)-(2, -1)  '坐标
Picture2.DrawWidth = 5
Picture2.Line (-1.7, -0.8)-(1.4, -0.8), QBColor(10)
Picture2.Line (-1.7, 0.8)-(1.4, 0.8), QBColor(10)
Picture2.DrawWidth = 1
Picture2.Line (-1.9, -0.8)-(-1.7, -0.8), QBColor(10)
Picture2.Line (-1.9, 0.8)-(-1.7, 0.8), QBColor(10)
Picture2.Line (1.4, -0.8)-(1.7, -0.8), QBColor(10)
Picture2.Line (1.4, 0.8)-(1.7, 0.8), QBColor(10)
Picture2.Line (1.6, -0.5)-(1.8, 0.5), QBColor(10), B
Picture2.Line (1.7, -0.5)-(1.7, -0.8), QBColor(10)
Picture2.Line (1.7, 0.5)-(1.7, 0.8), QBColor(10)
Picture2.Line (0.9, 0.7)-(0.9, 0.8), QBColor(8)
Picture2.Line (0.9, -0.7)-(0.9, -0.8), QBColor(8)
Picture2.Line (0.4, 0.7)-(0.4, 0.8), QBColor(8)
Picture2.Line (0.4, -0.7)-(0.4, -0.8), QBColor(8)
Picture2.Line (-0.1, 0.7)-(-0.1, 0.8), QBColor(8)
Picture2.Line (-0.1, -0.7)-(-0.1, -0.8), QBColor(8)
Picture2.Line (-0.6, 0.7)-(-0.6, 0.8), QBColor(8)
Picture2.Line (-0.6, -0.7)-(-0.6, -0.8), QBColor(8)
Picture2.Line (-1.1, 0.7)-(-1.1, 0.8), QBColor(8)
Picture2.Line (-1.1, -0.7)-(-1.1, -0.8), QBColor(8)
Picture2.Line (-1.6, 0.7)-(-1.6, 0.8), QBColor(8)
Picture2.Line (-1.6, -0.7)-(-1.6, -0.8), QBColor(8)
End Function

Private Sub Picture2_Paint()
Call RandZ
End Sub

Private Sub Text5_Change()

End Sub