大家看看能不能帮我弄一下这个程序的数据输入的txt文件,跪求!!!!!!
Option ExplicitDim strFileName As String
Dim lujing As String
Dim nn%, un%, tn%, hn% '已知点个数,未知点个数,总点数,观测值个数
Dim Pname() As String '点名数组
Dim Hknown() As Double '已知高程数组,存放已知点高程和高程近似值
Dim be%(), en%() '观测值的起点和终点编号数组,存储的是点序号
Dim h#(), s#() '高差观测值数组和距离观测值数组
Dim A#(), X#(), P#(), L#(), V#(), V0#(), X0#(), L0#() '间接平差的系数阵、解向量、权阵和常数向量
Private Sub Command1_Click()
txtshow.Text = ""
Text1.Text = ""
Dim i As Integer '循环变量
Dim strT1 As String, strT2 As String
lujing = App.Path
CDg1.InitDir = lujing
CDg1.Filter = "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"
CDg1.ShowOpen '打开对话框
strFileName = CDg1.FileName '获得选中的文件名和路径
If strFileName = "" Then
Exit Sub
End If
Open strFileName For Input As #1 '打开文件
Input #1, nn, un, hn '读入已知点个数,未知点个数,观测值个数
tn = nn + un
ReDim Pname(1 To tn), Hknown(1 To tn)
ReDim h(1 To hn), s(1 To hn), be(1 To hn), en(1 To hn)
For i = 1 To tn '读入点名
Input #1, Pname(i)
Next i
For i = 1 To nn '读入已知高程
Input #1, Hknown(i)
Next i
For i = 1 To hn '读入各观测值
Input #1, strT1, strT2, h(i), s(i)
be(i) = Order(strT1): en(i) = Order(strT2) '给起终点数组排序
Next i
'显示读入的数据
txtshow.Text = txtshow.Text & "//==读入的水准网数据==\\" & vbCrLf
txtshow.Text = txtshow.Text & "已知点" & nn & "个,未知点" & un & "个,观测值" & hn & "个。" & vbCrLf
txtshow.Text = txtshow.Text & "网中涉及的点名有:"
For i = 1 To tn
txtshow.Text = txtshow.Text & Pname(i) & ","
Next i
txtshow.Text = txtshow.Text & vbCrLf
txtshow.Text = txtshow.Text & "已知点点号、高程" & vbCrLf
For i = 1 To nn
txtshow.Text = txtshow.Text & Pname(i) & "的高程为:" & Hknown(i) & vbCrLf
Next i
txtshow.Text = txtshow.Text & "//==各观测值分别为==\\" & vbCrLf
txtshow.Text = txtshow.Text & "起点" & " " & "终点" & " " & "高差观测值(m) " & " 距离观测值(km)" & vbCrLf
For i = 1 To hn
txtshow.Text = txtshow.Text & Left(Pname(be(i)) & " ", 8) & Left(Pname(en(i)) & " ", 8) & Left(Format(h(i), "0.000") & " ", 16) & Format(s(i), "0.000") & vbCrLf
Next i
Close #1 '关闭文件
Command2.Enabled = True
End Sub
Private Sub Command2_Click()
command3.Enabled = True
Text1.Text = ""
'计算近似高程
Dim i%, j%
For i = 1 To un
For j = 1 To hn
If be(j) = nn + i And en(j) < nn + i Then '找到一个起点相同且终点已知的观测值
Hknown(nn + i) = Hknown(en(j)) - h(j)
Exit For
End If
If en(j) = nn + i And be(j) < nn + i Then '找到一个终点相同且起点已知的观测值
Hknown(nn + i) = Hknown(be(j)) + h(j)
Exit For
End If
Next j
Next i
'显示近似高程计算结果
Text1.Text = Text1.Text & "//==近似高程计算结果==\\ " & vbCrLf
For i = 1 To un
Text1.Text = Text1.Text & Pname(i + nn) & ":" & Format(Hknown(i + nn), "0.000") & vbCrLf
Next i
'列立误差方程:给A、P、L赋值
ReDim A(1 To hn, 1 To un), L(1 To hn), P(1 To hn, 1 To hn)
'对每个观测值列误差方程
For i = 1 To hn
If en(i) > nn Then A(i, en(i) - nn) = 1 '若终点未知,则给终点对应的系数矩阵元素赋值
If be(i) > nn Then A(i, be(i) - nn) = -1 '若起点未知,则给起点对应的系数矩阵元素赋值
L(i) = -(Hknown(en(i)) - Hknown(be(i)) - h(i)) '根据起终点计算常数项
P(i, i) = 1 / s(i) '以距离的倒数为权
Next i
'显示误差方程
Text1.Text = Text1.Text & "//==得到的A矩阵与L矩阵(V=Ax-L)==\\:" & vbCrLf
For i = 1 To hn
For j = 1 To un
Text1.Text = Text1.Text & Left(A(i, j) & " ", 5)
Next j
Text1.Text = Text1.Text & " " & Format(L(i), "0.0000") & vbCrLf
Next i
'显示权矩阵
Text1.Text = Text1.Text & "//==权矩阵(取1km的观测高差为单位权观测)==\\:" & vbCrLf
For i = 1 To hn
For j = 1 To hn
Text1.Text = Text1.Text & Format(P(i, j), "0.0000") & " "
Next j
Text1.Text = Text1.Text & vbCrLf
Next i
'-----------------------------------平差计算
ReDim X(1 To un)
InAdjust A, P, L, X '调用间接平差的通用过程求解
'-----------------------------------平差计算结束
'----------------------------------------------开始计算中误差
ReDim X0(1 To un, 1 To 1)
ReDim L0(1 To hn, 1 To 1)
ReDim V(1 To hn, 1 To 1)
ReDim m(1 To hn)
Dim mm#, mmm#
'将一维数组转化为二维矩阵数组
For i = 1 To un
X0(i, 1) = X(i)
Next i
For i = 1 To hn
L0(i, 1) = L(i)
Next i
MatrixMulti A, X0, V0 '矩阵 A*X
Debug.Print "The At matrix is:"
ShowMatrix V0
For i = 1 To hn 'V=A*X-L
V(i, 1) = V0(i, 1) - L(i)
Next i
mm = 0 '开始计算PV*V
For i = 1 To hn
m(i) = P(i, i) * V(i, 1) * V(i, 1)
mm = mm + m(i)
Next i
mmm = 1000 * Sqr(mm / (hn - un)) '计算中误差
'-----------------------------------中误差计算结束
'-------------------------------------------------------------------计算并显示高程平差结果
Text1.Text = Text1.Text & "//==平差计算结果==\\:" & vbCrLf
Text1.Text = Text1.Text & "每公里水准测量中误差= +/-" & Format(mmm, "0.0") & " mm" & vbCrLf
Text1.Text = Text1.Text & "点号 初始高程(m) 高程改正数(m) 平差后高程(m)" & vbCrLf
For i = 1 To un
Text1.Text = Text1.Text & Pname(nn + i) & " " & Format(Hknown(nn + i), "0.0000")
Hknown(nn + i) = Hknown(nn + i) + X(i)
Text1.Text = Text1.Text & " " & Format(X(i), "0.0000") & " " & Format(Hknown(nn + i), "0.0000") & vbCrLf
Next i
Text1.Text = Text1.Text & vbCrLf
End Sub
Private Sub command3_Click()
CDg1.CancelError = True
CDg1.Filter = "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"
CDg1.ShowSave
strFileName = CDg1.FileName
Open strFileName For Output As #1
Print #1, txtshow.Text
Print #1, Text1.Text
Close #1
End Sub
Private Sub Command4_Click()
Unload Me
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label16.ForeColor = vbRed
Label16.Font.Underline = False
End Sub
Private Sub Label16_Click()
CreateObject("wscript.shell").run "http://www.
Label16.ForeColor = vbRed
Label16.Font.Underline = False
End Sub
Private Sub Label16_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label16.ForeColor = vbBlue
Me.MousePointer = 0
Label16.Font.Underline = True
End Sub
'点名 序号转换程序
Public Function Order(str As String) As Integer
Dim i%
For i = 1 To tn
If str = Pname(i) Then
Order = i
Exit For
End If
Next i
End Function