VB6 画两段相接的圆弧

VB6 任意三点 给两个半径 画两段相接的圆弧

程序如下

Private Sub Command1_Click()

Dim x1#, x2#, y1#, y2#, a#, b#, x0#, y0#, q#, r#, l#, c#, d#, delta#, x3!, y3!, r1!, x01!, y01!, k3!, k4!, i!, j!, delta1!, g!, h!

x1 = Val(text1.Text)

y1 = Val(Text2.Text)

y2 = Val(Text4.Text)

x2 = Val(Text3.Text)

r = Val(Text5.Text)

k1 = (y2 - y1) / (x2 - x1)

k2 = -1 / k1

a = (x1 + x2) / 2

b = (y1 + y2) / 2

q = r * r - (a - x1) ^ 2 - (b - y1) ^ 2

delta = (-2 * a - 1 * 2 * a / k1 / k1) ^ 2 - 4 * (1 / k1 / k1 + 1) * (a * a + a * a / k1 / k1 - q)

Picture1.Cls

Picture1.Scale (-10, 10)-(10, -10)

Picture1.Line (-10, 0)-(10, 0)

Picture1.Line (0, 10)-(0, -10)

Picture1.CurrentX = 0: Picture1.CurrentY = 0: Picture1.Print 0

For l = -9 To 9 Step 1

Picture1.CurrentX = l: Picture1.CurrentY = 0: Picture1.Print l

Picture1.CurrentX = 0: Picture1.CurrentY = l: Picture1.Print l

Next l

If delta < 0 Then

Picture1.CurrentX = 5: Picture1.CurrentY = 5: Picture1.Print \"R1半径过小，无法

画圆\"

Stop

End If

x0 = (2 * a * (1 + 1 / k1 / k1) - Sqr((-2 * a - 1 * 2 * a / k1 / k1) ^ 2 - 4 * (1 / k1 / k1 + 1) * (a * a + a * a / k1 / k1 - q))) / (2 * (1 / k1 / k1 + 1))

y0 = k2 * (x0 - a) + b

If (y1 <= y0 And y2 >= y0) Or (y2 <= y0 And y1 > y0) Then

If y1 > y2 Then

c = -1

Else

c = 1

End If

If (x0 < x1 Or x0 < x2) Then

d = 1

End If

If x0 > x1 Or x0 > x2 Then

d = -1

End If

For y = y1 To y2 Step c * 0.0001

x = d * Sqr(r * r - (y - y0) ^ 2) + x0

Picture1.PSet (x, y)

Next y

Else

If x1 > x2 Then

c = -1

Else

c = 1

End If

If (y0 < y1 Or y0 < y2) Then

d = 1

End If

If y0 > y1 Or y0 > y2 Then

d = -1

End If

For x = x1 To x2 Step c * 0.0001

y = d * Sqr(r * r - (x - x0) ^ 2) + y0

Picture1.PSet (x, y)

Next x

End If

Picture1.Line (x0, y0)-(x1, y1), QBColor(1)

Picture1.Line (x0, y0)-(x2, y2), QBColor(1)

x3 = Val(Text11.Text)

y3 = Val(Text12.Text)

r1 = Val(Text8.Text)

k3 = (y2 - y3) / (x2 - x3)

k4 = -1 / k3

i = (x3 + x2) / 2

j = (y3 + y2) / 2

p = r1 * r1 - (i - x3) ^ 2 - (j - y3) ^ 2

delta1 = (-2 * i - 1 * 2 * i / k3 / k3) ^ 2 - 4 * (1 / k3 / k3 + 1) * (i * i + i * i / k3 / k3 - p)

If delta1 < 0 Then

Picture1.CurrentX = 5: Picture1.CurrentY = 5: Picture1.Print \"R2半径过小，无法画圆\"

Stop

End If

x01 = (2 * i * (1 + 1 / k3 / k3) - Sqr((-2 * i - 1 * 2 * i / k3 / k3) ^ 2 - 4 * (1 / k3 / k3 + 1) * (i * i + i * i / k3 / k3 - p))) / (2 * (1 / k3 / k3 + 1))

y01 = k4 * (x01 - i) + j

If (y2 <= y01 And y3 >= y01) Or (y3 <= y01 And y2 > y01) Then

If y2 > y3 Then

g = -1

Else

g = 1

End If

If (x01 < x2 Or x01 < x3) Then

h = 1

End If

If x01 > x2 Or x01 > x3 Then

h = -1

End If

For y = y2 To y3 Step g * 0.0001

x = h * Sqr(r1 * r1 - (y - y01) ^ 2) + x01

Picture1.PSet (x, y)

Next y

Else

If x2 > x3 Then

g = -1

Else

g = 1

End If

If (y01 < y2 Or y01 < y3) Then

h = 1

End If

If y01 > y2 Or y01 > y3 Then

h = -1

End If

For x = x2 To x3 Step g * 0.0001

y = h * Sqr(r1 * r1 - (x - x01) ^ 2) + y01

Picture1.PSet (x, y)

Next x

End If

Picture1.Line (x01, y01)-(x3, y3), QBColor(1)

Picture1.Line (x01, y01)-(x2, y2), QBColor(1)

End Sub

注：该程序无法画出大于半圆的圆弧。

Xiao小小拼图