实验报告一一实验内容
应用程序进行四等水准的计算
二程序界面设计
1 程序的设计界面
2 程序的运行界面
3 程序计算界面
三、编写程序
Option Explicit
Dim startPoint!, endPoint!
Private Sub cmdCheckCalc_Click()
Dim i%, tDist '距离
tDist = 0
Dim totalDetH!, closeDetH! '累计高差和高差闭合差
For i = 1 To nMarks
tDist = tDist + dis(i)
Next i
totalDetH = 0
For i = 1 To nMarks '计算累计高差
totalDetH = totalDetH + detH(i)
Next i
'计算闭合差
startPoint = Val(txtStartPoint.Text)
endPoint = Val(txtEndPoint.Text)
If optAnnex.Value Then '附合水准
closeDetH = (endPoint - startPoint) - totalDetH
Else '闭合水准和支水准
closeDetH = -totalDetH
End If
'检查闭合差是否超限
If closeDetH > 0.04 * Sqr(tDist) Then '采用40*Sqr(L)来计算，单位是毫米
MsgBox "闭合差超限，测量成果不合格！", , "闭合差超限"
txtShowResult.Text = txtShowResult.Text & "闭合差超限，测量成果不合格！"
Exit Sub
Else
MsgBox "闭合差合格，继续计算转点高程！", , "闭合差合格"
End If
Dim temp!
temp = startPoint
txtShowResult.Text = txtShowResult.Text & "平差后的高程为：" & vbCrLf For i = 0 To nMarks
temp = temp + detH(i) + closeDetH * dis(i) / tDist
txtShowResult.Text = txtShowResult.Text & " （" & Str(i) & "）：" & Str(Format(temp, "0.000")) & vbCrLf
Next i
End Sub
Private Sub cmdExit_Click()
End
End Sub
Private Sub cmdInput_Click()
'检查输入的几个文本框：是否已经输入了
If txtStartPoint.Text = "0" Then
MsgBox "还没有输入起始点高程！"
Exit Sub
End If
If txtEndPoint.Text = "0" And optAnnex.Value = True Then MsgBox "还没有输入终点高程！"
Exit Sub
End If
If txtBMNum.Text = "0" And optAnnex.Value = True Then
MsgBox "还没有输入测站数！"
Exit Sub
End If
frmInput.Show
End Sub
Private Sub optAnnex_Click()
txtEndPoint.Enabled = optAnnex.Value
End Sub
Private Sub optClose_Click()
txtEndPoint.Enabled = Not optClose.Value
End Sub
Private Sub optSpur_Click()
txtEndPoint.Enabled = Not optSpur.Value
End Sub
Private Sub Timer1_Timer()
Label5.Caption = Now
End Sub
Private Sub txtStartPoint_LostFocus()
If Not IsNumeric(txtStartPoint.Text) Then
MsgBox "输入的高程含有非数字字符！"
txtStartPoint.Text = ""
txtStartPoint.SetFocus
Exit Sub
End If
If Val(txtStartPoint.Text) > 5000 Or Val(txtStartPoint.Text) < -100 Then
MsgBox "输入的高程有误！"
txtStartPoint.Text = ""
txtStartPoint.SetFocus
Exit Sub
End If
startPoint = Val(txtStartPoint.Text)
End Sub
Private Sub txtEndPoint_LostFocus()
If Not IsNumeric(txtEndPoint.Text) Then
MsgBox "输入的高程含有非数字字符！"
txtEndPoint.Text = ""
txtEndPoint.SetFocus
Exit Sub
End If
If Val(txtEndPoint.Text) > 5000 Or Val(txtEndPoint.Text) < -100 Then MsgBox "输入的高程有误！"
txtEndPoint.Text = ""
txtEndPoint.SetFocus
Exit Sub
End If
endPoint = Val(txtEndPoint.Text)
End Sub
Private Sub txtBMNum_LostFocus()
If Not IsNumeric(txtBMNum.Text) Then
MsgBox "输入的测站数含有非数字字符或尚未输入！"
txtBMNum.Text = ""
txtBMNum.SetFocus
Exit Sub
End If
nMarks = Val(txtBMNum.Text)
If txtBMNum.Text <> "" And (nMarks > 20 Or nMarks < 2) Then
MsgBox "输入的测站数有误！"
txtBMNum.Text = ""
txtBMNum.SetFocus
Exit Sub
End If
ReDim dis(nMarks) As Single, detH(nMarks) As Single
End Sub
四总结
通过这次对VB测量程序的学习，让我们认识到了VB在生活中的广泛应用，我们完成了一个个程序的输入，运行，我感慨非常的高兴，更加激发了我对VB 这门课程的学习，让我们在其中学到了许多的知识，增加了我们的视野，为我们以后的工作打下了坚实的基础。