## 主题：已知三角形A、B两点坐标、BC边长、∠BAC角度，求C点坐标

[code=vb]
Option Explicit
Private Type POINT
x As Single
y As Single
End Type

Private Function CalcAC(ByRef pA As POINT, ByRef pB As POINT, ByVal bc As Single, ByVal bac As Single) As Single
'//! 已知一个三角形的A、B两点坐标、BC边长、∠BAC，求另一边AC的长度
Dim ab As Single
Dim ac As Single
Const PI As Single = 3.1415926
ab = CalcDistance(pA, pB)

ac = Sqr(ab ^ 2 + bc ^ 2 - 2 * ab * bc * Cos(bac / 180 * PI))

CalcAC = ac
End Function
Private Sub DrawAxes()
pic1.Cls

pic1.Height = pic1.Width
pic1.BackColor = vbBlack
pic1.AutoRedraw = True
pic1.Scale (-200, 200)-(200, -200)
pic1.ForeColor = vbGreen
pic1.DrawWidth = 1
pic1.Line (-200, 0)-(200, 0)
pic1.Line (190, 10)-(200, 0)
pic1.Line (190, -10)-(200, 0)

pic1.Line (0, -200)-(0, 200)
pic1.Line (10, 190)-(0, 200)
pic1.Line (-10, 190)-(0, 200)
End Sub

Private Sub Command1_Click()

Dim pA As POINT
Dim pB As POINT
Dim bc As Single
Dim bac As Single
Dim pt() As POINT

Dim r As Single
Dim n As Integer
Dim i As Integer

Dim result() As Single

Call DrawAxes

'//：测试
pA.x = 0
pA.y = 0
pB.x = 2
pB.y = 0
Debug.Print GetPoint(pA, 2, pB, 2, pt())
Debug.Print pt(0).x, pt(0).y
Debug.Print pt(1).x, pt(1).y
'Exit Sub

pA.x = txtAx.Text
pA.y = txtAy.Text

pB.x = txtBx.Text
pB.y = txtBy.Text

bc = txtBC.Text
bac = txtBAC.Text

pic1.ForeColor = vbRed
pic1.DrawWidth = 1
pic1.POINT pA.x, pA.y
pic1.POINT pB.x, pB.y
pic1.Line (pA.x, pA.y)-(pB.x, pB.y)

r = CalcAC(pA, pB, bc, bac)

'Label5.Caption = r
pic1.ForeColor = vbYellow
pic1.Circle (pA.x, pA.y), r

pic1.Circle (pB.x, pB.y), bc
n = GetPoint(pA, r, pB, bc, pt())
'Label5.Caption = Label5.Caption & "," & n

pic1.ForeColor = vbMagenta
For i = 0 To n - 1
pic1.POINT pt(i).x, pt(i).y
Debug.Print pt(i).x, pt(i).y
If (CalcDistance(pt(i), pB) - bc) < 0.0000001 Then
pic1.Line (pt(i).x, pt(i).y)-(pB.x, pB.y)
pic1.Line (pt(i).x, pt(i).y)-(pA.x, pA.y)
Label5.Caption = pt(i).x & "," & pt(i).y
'Exit For
Else
Debug.Print "--------", bc, CalcDistance(pt(i), pB)
End If

Next

pic1.ForeColor = vbGreen
If n = 2 Then
pic1.Line (pt(0).x, pt(0).y)-(pt(1).x, pt(1).y)
End If

End Sub

Call DrawAxes
End Sub

Private Function GetPoint(ByRef pA As POINT, ByVal ra As Single, ByRef pB As POINT, ByVal rb As Single, ByRef pt() As POINT) As Long
'//! 获取两个圆的交点
'//! 返回值：交点的个数；交点的坐标通过pt()数组引用返回
'//! 参数：pa,pb两个圆的圆心坐标，ra,rb两个圆的半径
Dim ab As Single
Dim n As Integer
Dim r As Integer
Dim result() As Single
Dim a As Single
Dim b As Single
Dim c As Single
Dim i As Integer

ab = CalcDistance(pA, pB)
If ab > (ra + rb) Or ab < Abs(ra - rb) Then
n = 0
ElseIf (ab < (ra + rb) And ab > Abs(ra - rb)) Then
n = 2
ElseIf (ab = Abs(ra - rb) Or ab = (ra + rb)) Then
n = 1
End If

Dim t As Single
t = ra ^ 2 - rb ^ 2 + pB.x ^ 2 - pA.x ^ 2 + pB.y ^ 2 - pA.y ^ 2
a = 1 + ((pB.y - pA.y) / (pB.x - pA.x)) ^ 2
b = -1 * (2 * ((pB.y - pA.y) / (pB.x - pA.x)) * ((t - (2 * pB.x - 2 * pA.x) * pA.x) / (2 * pB.x - 2 * pA.x)) + 2 * pA.y)
c = ((t - (2 * pB.x - 2 * pA.x) * pA.x) / (2 * pB.x - 2 * pA.x)) ^ 2 + pA.y ^ 2 - ra ^ 2

r = CalcFangCheng(a, b, c, result())
Debug.Assert r = n
If r > 0 Then
ReDim pt(r - 1) As POINT
For i = 0 To r - 1
pt(i).y = result(i)
pt(i).x = ((ra ^ 2 - rb ^ 2 + pB.x ^ 2 - pA.x ^ 2 + pB.y ^ 2 - pA.x ^ 2) - (2 * pB.y - 2 * pA.y) * pt(i).y) / (2 * pB.x - 2 * pA.x)
Next
End If

GetPoint = n
End Function

Private Function CalcDistance(ByRef pA As POINT, ByRef pB As POINT) As Single
'//! 计算平面内两点的距离
CalcDistance = Sqr((pB.x - pA.x) ^ 2 + (pB.y - pA.y) ^ 2)
End Function

Private Function CalcFangCheng(ByVal a As Single, ByVal b As Single, ByVal c As Single, ByRef result() As Single) As Long
'//! 解方程ax^2 + bx + c = 0
Dim n As Integer
Dim delta As Single

delta = b ^ 2 - 4 * a * c
If delta < 0 Then
n = 0
ElseIf delta > 0 Then
n = 2
ReDim result(1) As Single
result(0) = (b * (-1) + Sqr(delta)) / (2 * a)
result(1) = (b * (-1) - Sqr(delta)) / (2 * a)
Else
n = 1
ReDim result(0) As Single
result(0) = b * (-1) / (2 * a)
End If

CalcFangCheng = n
End Function
[/code]
[em1][em1][em1][em1]

## 回复列表 （共11个回复）

1、图案自动占据图片框的大部分（即自动缩放）；
2、在图案中加注A、B、C三个角点和长度；
3、图片框的高度与窗体高度的配合要注意适应不同的标题栏高度。

3 楼

[url=http://www.cheapreplicawatche.co.uk/best-replica-uboat-watches-99.html]U-Boat Watches[/url]
[url=http://www.chanelhandbagsale.net/]Chanel Handbags[/url]
[url=http://www.chanelhandbagsale.net/]Replica Chanel[/url]
[url=http://www.chanelhandbagsale.net/]Chanel Replicas[/url]
[url=http://www.chanelhandbagsale.net/]Chanel on Sales[/url]
[url=http://www.cheapreplicawatche.co.uk/]replica watches[/url]
[url=http://www.cheapreplicawatche.co.uk/]replica watches UK[/url]
[url=http://www.cheapreplicawatche.co.uk/]Fake watches[/url]
[url=http://www.cheapreplicawatche.co.uk/]Rolex Replica[/url]
[url=http://www.cheapreplicawatche.co.uk/best-replica-bell-ross-watches-349.html]Bell & Ross Watches[/url]
[url=http://www.cheapreplicawatche.co.uk/best-replica-breitling-watches-312.html]Breitling Watches[/url]
[url=http://www.replicahause.org.uk]Replica Watches[/url]
[url=http://www.cheapreplicawatche.co.uk/best-replica-omega-watches-170.html]Omega Watches[/url]
[url=http://www.cheapreplicawatche.co.uk/best-replica-panerai-watches-292.html]Panerai Watches[/url]
[url=http://www.cheapreplicawatche.co.uk/best-replica-patek-philippe-watches-415.html]Patek Philippe Watches[/url]
[url=http://www.cheapreplicawatche.co.uk/best-replica-rolex-watches-143.html]Rolex watches[/url]
[url=http://www.cheapreplicawatche.co.uk/best-replica-tag-heuer-watches-166.html]Tag Heuer Watches[/url]

4 楼

[url=http://www.timberlandforyou.com/]timberland 14 inch boots[/url]
[url=http://www.timberlandforyou.com/]timberland working boots[/url]
[url=http://www.timberlandforyou.com/]mens timberland boots[/url] zxj

5 楼

6 楼

7 楼

[url=http://www.sincen.cn]南京到北京旅游[/url] [url=http://www.naliniu.com]南京康辉旅行社[/url]

8 楼

9 楼

Where you can order new 2012 style [url=http://www.timberlandbootshiking.com/timberland-roll-top-boots-c-9.html]Timberland Roll Top Boots[/url] for men & women size.Why not come to our website.You can find more
[url=http://www.timberlandbootshiking.com/timberland-chukka-boots-c-6.html]Timberland Chukka Boots[/url] high quality,factory price.
If you are looking cheapest [url=http://www.timberlandbootshiking.com/timberland-6-inch-boots-c-2.html]Timberland 6 Inch Boots[/url], the style of 6 inch timberland boots more durable,waterproof,comfortable.

10 楼