📄 xu2.frm
字号:
VERSION 5.00
Begin VB.Form Form3
Caption = "Form3"
ClientHeight = 11010
ClientLeft = 60
ClientTop = 450
ClientWidth = 15240
LinkTopic = "Form3"
ScaleHeight = 11010
ScaleWidth = 15240
StartUpPosition = 3 '窗口缺省
Begin VB.Frame Frame1
Caption = "Frame1"
Height = 3615
Left = 120
TabIndex = 1
Top = 0
Width = 9615
Begin VB.CommandButton Command7
Caption = "协因数阵"
Height = 495
Left = 4920
TabIndex = 17
Top = 1320
Width = 1215
End
Begin VB.CommandButton Command2
Caption = "计算待定边的近似边长，坐标方位角及改正数"
Height = 1095
Left = 600
TabIndex = 16
Top = 1080
Width = 855
End
Begin VB.CommandButton Command3
Caption = "计算定向角近似值及误差方程常数项"
Height = 975
Left = 1680
TabIndex = 15
Top = 1080
Width = 975
End
Begin VB.CommandButton Command4
Caption = "解算法方程"
Height = 735
Left = 3120
TabIndex = 14
Top = 1200
Width = 1095
End
Begin VB.CommandButton Command6
Caption = "单位权中误差"
Height = 615
Left = 6480
TabIndex = 13
Top = 2280
Width = 735
End
Begin VB.TextBox Text8
Height = 495
Left = 7560
TabIndex = 12
Text = "Text8"
Top = 2280
Width = 1215
End
Begin VB.TextBox Text7
Height = 495
Index = 0
Left = 1680
TabIndex = 11
Text = "Text7"
Top = 3000
Width = 1815
End
Begin VB.TextBox Text7
Height = 495
Index = 1
Left = 3600
TabIndex = 10
Text = "Text7"
Top = 3000
Width = 1815
End
Begin VB.TextBox Text7
Height = 495
Index = 2
Left = 5640
TabIndex = 9
Text = "Text7"
Top = 3000
Width = 1815
End
Begin VB.TextBox Text7
Height = 495
Index = 3
Left = 7560
TabIndex = 8
Text = "Text7"
Top = 3000
Width = 1815
End
Begin VB.CommandButton Command1
Caption = "近似值"
Height = 615
Left = 360
TabIndex = 7
Top = 240
Width = 1215
End
Begin VB.TextBox Text1
Height = 495
Index = 0
Left = 1680
TabIndex = 6
Text = "Text1"
Top = 360
Width = 1695
End
Begin VB.TextBox Text1
Height = 495
Index = 1
Left = 3480
TabIndex = 5
Text = "Text1"
Top = 360
Width = 1815
End
Begin VB.TextBox Text1
Height = 495
Index = 2
Left = 5520
TabIndex = 4
Text = "Text1"
Top = 360
Width = 1695
End
Begin VB.TextBox Text1
Height = 495
Index = 3
Left = 7320
TabIndex = 3
Text = "Text1"
Top = 360
Width = 1815
End
Begin VB.CommandButton Command5
Caption = "未知数平差值"
Height = 495
Left = 240
TabIndex = 2
Top = 3000
Width = 1215
End
End
Begin VB.PictureBox Picture1
Height = 3135
Left = 720
ScaleHeight = 3075
ScaleWidth = 3195
TabIndex = 0
Top = 3840
Width = 3255
End
End
Attribute VB_Name = "Form3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim x(0 To 4) As Double
Dim y(0 To 4) As Double
Dim L(0 To 8) As Double
Dim i As Integer
Const pai# = 3.141592654
Const p# = 180
Const w# = 3600
Const z# = 206265
Dim xp10, xp20, yp10, yp20 As Double
Dim dx(0 To 8) As Double
Dim dy(0 To 8) As Double
Dim A(0 To 8) As Double
Dim b(0 To 8) As Double
Dim s(0 To 8) As Double
Dim t(0 To 8) As Double
Dim d(0 To 8) As Double
Dim dl(0 To 8) As Double
Dim bz(0 To 8, 0 To 5) As Double
Dim bl(0 To 5, 0 To 5) As Double
Dim bzt(0 To 5, 0 To 8) As Double
Dim btb(0 To 5, 0 To 5), btb1(1 To 6, 1 To 6) As Double
Dim btl(0 To 5) As Double
Dim dd(0 To 5) As Double
Dim dwq As Double
Private Sub Command1_Click()
Dim af, bt, A, b, c, d, k As Double
For i = 0 To 4
x(i) = Form2.Text1(i).Text
y(i) = Form2.Text2(i).Text
Next i
For i = 0 To 8
L(i) = Form2.Text3(i).Text
Next i
af = L(4) - L(3)
bt = 2 * p * w / z - L(4)
A = x(1) - x(0) + (y(1) - y(0)) / Tan(af)
b = y(1) - y(0) - (x(1) - x(0)) / Tan(af)
c = x(1) - x(2) - (y(1) - y(2)) / Tan(bt)
d = y(1) - y(2) + (x(1) - x(2)) / Tan(bt)
k = (A - c) / (b - d)
xp10 = x(1) + (-A + k * b) / (1 + k * k)
yp10 = y(1) - k * (-A + k * b) / (1 + k * k)
Text1(0).Text = xp10
Text1(1).Text = yp10
af = L(6) - L(5)
bt = L(7) - L(6)
A = xp10 - x(0) + (yp10 - y(0)) / Tan(af)
b = yp10 - y(0) - (xp10 - x(0)) / (Tan(af))
c = xp10 - x(3) - (yp10 - y(3)) / Tan(bt)
d = yp10 - y(3) + (xp10 - x(3)) / Tan(bt)
k = (A - c) / (b - d)
xp20 = xp10 + (-A + k * b) / (1 + k * k)
yp20 = yp10 - k * (-A + k * b) / (1 + k * k)
Text1(2).Text = xp20
Text1(3).Text = yp20
End Sub
Private Sub Command2_Click()
Dim a1, b1 As String
dx(0) = x(2) - xp10
dx(1) = x(3) - xp10
dx(2) = xp20 - xp10
dx(3) = x(0) - xp10
dx(4) = x(1) - xp10
dx(5) = x(0) - xp20
dx(6) = xp10 - xp20
dx(7) = x(3) - xp20
dx(8) = x(4) - xp20
dy(0) = y(2) - yp10
dy(1) = y(3) - yp10
dy(2) = yp20 - yp10
dy(3) = y(0) - yp10
dy(4) = y(1) - yp10
dy(5) = y(0) - yp20
dy(6) = yp10 - yp20
dy(7) = y(3) - yp20
dy(8) = y(4) - yp20
For i = 0 To 8
s(i) = Sqr(dx(i) * dx(i) + dy(i) * dy(i))
Text2(i).Text = s(i)
If (dx(i) > 0 And dy(i) > 0) Then t(i) = Atn(dy(i) / dx(i))
If (dx(i) < 0 And dy(i) > 0) Then t(i) = p * w / z - Atn(-dy(i) / dx(i))
If (dx(i) < 0 And dy(i) < 0) Then t(i) = p * w / z + Atn(dy(i) / dx(i))
If (dx(i) > 0 And dy(i) < 0) Then t(i) = 2 * p * w / z - Atn(-dy(i) / dx(i))
b1 = Val(t(i))
a1 = hdzh(b1)
A(i) = 2062.65 * dy(i) / (s(i) * s(i))
b(i) = -2062.65 * dx(i) / (s(i) * s(i))
Next i
End Sub
Private Function hdzh(hd$) As String
Dim d, f, s0, h, x As Double
Dim x1$, x2#
x2 = Val(hd)
x = x2 * 206265
d = Int(x / 3600)
f = Int((x / 3600 - d) * 60)
s0 = ((x / 3600 - d) * 60 - f) * 60
x1 = str$(d) & "," & str$(f) & "," & str$(s0)
hdzh = x1
End Function
Private Sub Command3_Click()
Dim zp10, zp20 As Double
zp10 = 0
zp20 = 0
For i = 0 To 8
d(i) = t(i) - L(i)
If d(i) < 0 Then d(i) = d(i) + 2 * p * w / z
If i < 5 Then zp10 = zp10 + d(i)
If i >= 5 Then zp20 = zp20 + d(i)
Next i
zp10 = zp10 / 5
zp20 = zp20 / 4
For i = 0 To 8
If i < 5 Then dl(i) = 206265 * (d(i) - zp10)
If i >= 5 Then dl(i) = 206265 * (d(i) - zp20)
Next i
End Sub
Private Sub Command4_Click()
Dim i, j, t, k As Integer
Dim d As Double
Dim str As String
For i = 0 To 4
bz(i, 0) = -1
bz(i, 1) = 0
bz(i, 2) = A(i)
bz(i, 3) = b(i)
bz(i, 4) = 0
bz(i, 5) = 0
If i = 2 Then
bz(i, 4) = -A(i)
bz(i, 5) = -b(i)
End If
Next i
For i = 5 To 8
bz(i, 0) = 0
bz(i, 1) = -1
bz(i, 2) = 0
bz(i, 3) = 0
bz(i, 4) = A(i)
bz(i, 5) = b(i)
If i = 6 Then
bz(i, 2) = -A(i)
bz(i, 3) = -b(i)
End If
Next i
For i = 0 To 8
For j = 0 To 5
bzt(j, i) = bz(i, j)
Next j
Next i
For i = 0 To 5
For j = 0 To 5
btb(i, j) = 0
Next j
Next i
For i = 0 To 5
For t = 0 To 5
For j = 0 To 8
btb(i, t) = btb(i, t) + bzt(i, j) * bz(j, t)
Next j
Next t
Next i
For i = 0 To 5
For j = 0 To 5
btb1(i + 1, j + 1) = btb(i, j)
Next j
Next i
For i = 0 To 5
btl(i) = 0
For j = 0 To 8
btl(i) = btl(i) + bzt(i, j) * dl(j)
Next j
Next i
btl(0) = 0
For i = 0 To 5
For j = 0 To 5
bl(i, j) = btb(i, j)
Next j
Next i
Picture1.Print
For k = 0 To 4
For j = k + 1 To 5
bl(k, j) = bl(k, j) / bl(k, k)
Next j
btl(k) = btl(k) / bl(k, k)
For i = k + 1 To 5
For j = k + 1 To 5
bl(i, j) = bl(i, j) - bl(i, k) * bl(k, j)
Next j
btl(i) = btl(i) - bl(i, k) * btl(k)
Next i
Next k
d = 0
dd(5) = btl(5) / bl(5, 5)
For i = 4 To 0 Step -1
For j = i + 1 To 5
d = d + bl(i, j) * dd(j)
Next j
dd(i) = btl(i) - d
d = 0
Next i
For i = 0 To 5
Picture1.Print Tab(22 * i); dd(i);
Next i
End Sub
Private Sub Command5_Click()
Dim xp1, xp2, yp1, yp2 As Double
xp1 = xp10 + dd(2)
yp1 = yp10 + dd(3)
xp2 = xp20 + dd(4)
yp2 = yp20 + dd(5)
Text7(0) = xp1
Text7(1) = yp1
Text7(2) = xp2
Text7(3) = yp2
End Sub
Private Sub Command6_Click()
Dim v(0 To 8) As Double
Dim i, j, t As Double
Dim d As Double
For j = 0 To 8
d = 0
For t = 0 To 5
d = d + bz(j, t) * dd(t)
Next t
v(j) = d + dl(j)
Next j
d = 0
For i = 0 To 8
d = d + v(i) * v(i)
Next i
dwq = Sqr(d / 3)
Text8.Text = dwq
End Sub
Private Sub Command7_Click()
'协因数阵bb()'
Dim E(12, 12), z, zz As Double
Dim p As Integer
Dim bb(1 To 6, 1 To 6) As Double
Dim mx(1 To 2), my(1 To 2), m(1 To 2) As Double
For i = 1 To 6
For j = 1 To 6
E(i, j) = btb1(i, j)
Next j
Next i
For i = 1 To 6
For j = 7 To 12
If i = j - 6 Then
E(i, j) = 1
Else
E(i, j) = 0
End If
Next j
Next i
For j = 1 To 6
If E(j, j) = 0 Then
For i = 1 To 6
If E(i, j) <> 0 Then Exit For
Next i
For p = 1 To 12
ch = E(i, p)
E(i, p) = E(j, p)
E(j, p) = ch
Next p
End If
z = E(j, j)
For p = 1 To 12
E(j, p) = E(j, p) / z
Next p
For i = 1 To 6
If i <> j And E(i, j) <> 0 Then
zz = E(i, j)
For p = 1 To 12
E(i, p) = E(i, p) - E(j, p) * zz
Next p
End If
Next i
Next j
For i = 1 To 6
For j = 1 To 6
bb(i, j) = E(i, j + 6)
Next j
Next i
For i = 1 To 6
For j = i To 6
Picture1.Print Tab(22 * (j - 1)); bb(i, j);
Next j
Picture1.Print
Next i
mx(1) = dwq * bb(3, 3)
my(1) = dwq * bb(4, 4)
mx(2) = dwq * bb(5, 5)
my(2) = dwq * bb(6, 6)
m(1) = Sqr(mx(1) * mx(1) + my(1) * my(1))
m(2) = Sqr(mx(2) * mx(2) + my(2) * my(2))
Picture1.Print mx(1); my(1)
Picture1.Print mx(2); my(2)
Picture1.Print m(1); m(2)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -