VB程序上机实验报告.docx
《VB程序上机实验报告.docx》由会员分享，可在线阅读，更多相关《VB程序上机实验报告.docx（27页珍藏版）》请在冰豆网上搜索。
VB程序上机实验报告
VB程序设计
专业：
测绘工程
班级学号：
1102601-24
编写人：
丁浩
指导老师：
唐争气
日期：
2013.12
实验一
1、实验名称
程序登录界面
二、实验原理与过程
（1）用户通过界面登录系统，输入用户名和密码；
（2）用户名错误或者密码错误时提醒用户出现错误，并提醒用户共有三次操作机会；
（3）当选择用户名和密码都正确时，提醒用户登录成功；
三、部分代码
PrivateSubCommand1_Click（）
StatictAsInteger
IfText1.Text=""Then'如果Text1为空，即没有输入用户
MsgBox"请输入用户名!
",vbOKOnly+vbCritical,"错误"
ExitSub'退出这个过程
EndIf
IfText1.Text="110260124"AndText2.Text="666666"Then
'如果输入的用户名是"110260124"且密码为"666666"
MsgBox"密码正确，欢迎进入！
",vbOKOnly+vbInformation,"欢迎进入"
CX.Show
DL.Hide
Else'如果不是"1102601"或密码不是"666666"
MsgBox"用户名或密码错误!
",vbOKOnly+vbCritical,"错误"
Text1.SetFocus
t=t+1
Ift=3Then
MsgBox"3次出现错误，程序将自动退出"
End
EndIf
四、实验结果
五、心得体会
本次课外实验合理使用VB操作软件，设计了一个简易用户登录系统，能方便地实用户登录功能。
其中用到了VB中自定义数据类型，随机文件的读写，常用控件的使用（文本框，单选按扭等）。
通过本次课外实验，初步了解了VB语言知识，提高了综合运用所学知识解决实际问题的能力。
虽然程序中存在诸多的问题，比如调试程序时的出错，程序没有运行，多余等问题。
希望在以后的学习中不断探索,不断创新，改进，实践。
在这次课程设计中积累的这些宝贵的经验对于以后的学习和工作一定会起着非常重要的作用。
实验四
2、实验名称
坐标正反算
二、实验原理与过程
通常极坐标法正反算是采用工程计算器计算取得，各种工程计算器的计算操作方法不尽相同，这就导致在不同的计算器使用时产生错误操作，反复的计算检核，给测绘工作带来不便。
随着便携式微型电脑的普及，野外工程测量工作中随时随地的采用电脑计算绘图成为现实，不仅方便准确，而且效率大大提高。
本文利用VB编程中的面向对象功能，开发方便实用的工程测量小程序：
极坐标正反算
三、部分代码
Private Sub Command1_Click（Index As Integer）
Dim a1%, a2%, a3%, a4!
a5!
pi!
Const conpi = 3.14159265358979
If IsNumeric（Text1
（1）） = False Or IsNumeric（Text2
（2）） = False Or IsNumeric（Text3（3）） = False Or IsNumeric（Text4（4）） = False Or IsNumeric（Text5（5）） = False Or IsNumeric（Text6（6）） = False
Then
MsgBox "输入有误"
Text1
（1）.SetFocus
Else If
Val（Trim（Text5（5）.Text）） > 60 Or Val（Trim（Text5（5）.Text）） < 0 Or Val（Trim（Text6（6）.Text）） > 60 Or Val（Trim（Text6（6）.Text）） < 0 Then
MsgBox "方位角输入有误，请重新输入"
Text4（4）.SetFocus ：
Text4（4）.Text = "" ：
Text5（5）.Text = "" ：
Text6（6）.Text = ""
End If
a1 = Val（Text4（4）.Text） ：
a2 = Val（Text5（5）.Text） ：
a3 = Val（Text6（6）.Text）
a4 = a1 + a2 / 60 + a3 / 3600：
a5 = a4 * conpi / 180
Label12.Caption = Val（Text3（3）.Text） * Cos（a5）
Label13.Caption = Val（Text3（3）.Text） * Sin（a5）
Label14.Caption = Val（Text1
（1）.Text） + Val（Label12.Caption）
Label15.Caption = Val（Text2
（2）.Text） + Val（Label13.Caption）
Label12.Caption = Format（（Val（Label12.Caption） * 10000 + 0.5） / 10000, "####.0000"）
Label13.Caption = Format（（Val（Label13.Caption） * 10000 + 0.5） / 10000, "####.0000"）
Label14.Caption = Format（（Val（Label14.Caption） * 10000 + 0.5） / 10000, "####.0000"）
Label15.Caption = Format（（Val（Label15.Caption） * 10000 + 0.5） / 10000, "####.0000"）
End If
End Sub
Private Sub Command2_Click（Index As Integer）
Text1
（1）.Text = " "：
Text2
（2）.Text = " " ：
Text3（3）.Text = " " ：
Text4（4）.Text = " "
Text5（5）.Text = " " “Text6（6）.Text = " " ：
Label12.Caption = "" ：
Label13.Caption = ""
Label14.Caption = ""：
Label15.Caption = "" ：
Text1
（1）.SetFocus
End Sub
Private Sub Command3_Click（）
Dim dx!
dy!
a12!
r12!
d12!
Const conpi = 3.14159265358979
If IsNumeric（Text7） = False Or IsNumeric（Text8） = False Or IsNumeric（Text9） = False Or IsNumeric（Text10） = False
Then MsgBox "输入有误"
Else
dx = Val（Text9.Text） - Val（Text7.Text）
dy = Val（Text10.Text） - Val（Text8.Text）
d12 = Sqr（dx ^ 2 + dy ^ 2）
Label25.Caption = Format（（d12 * 10000 + 0.5） / 10000, "####.0000"）
If dx = 0 And dy > 0 Then
Label31.Caption = 90:
Label32.Caption = 0:
Label33.Caption = 0
ElseIf dx = 0 And dy < 0 Then
Label31.Caption = 270:
Label32.Caption = 0:
Label33.Caption = 0
Else
r12 = Atn（Abs（dy / dx））
If dx > 0 And dy > 0 Then ：
a12 = r12
ElseIf dx < 0 And dy > 0 Then ：
a12 = pi - r12
ElseIf dx < 0 And dy < 0 Then ：
a12 = pi + r12
ElseIf dx > 0 And dy < 0 Then ：
a12 = 2 * pi - r12
End If
a12 = a12 / conpi * 180
Label31.Caption = Fix（a12）
Label32.Caption = Abs（Fix（（a12 - Fix（a12）） * 60））
Label33.Caption = Abs（Fix（（（（a12 - Fix（a12）） * 60） - Fix（（a12 - Fix（a12）） * 60）） * 60））
End If
End If End Sub
Private Sub Command4_Click（）
Text7.Text = "" ：
Text8.Text = "" ：
Text9.Text = "" ：
Text10.Text = ""
Label25.Caption = ""：
Label31.Caption = "" ：
Label32.Caption = "" ：
Label33.Caption = ""
Text7.SetFocus End Sub
Private Sub Timer1_Timer（）
Label34.Left = Label34.Left + 20
If Label34.Left = 12300 Then
Label34.Left = 0
End If
End Sub
四、实验结果
五、心得体会
经过测量学的学习，已经初步认识到坐标的换算。
所以对于这种左边换算的程序，难点不在于知识点，对于原理和思路并不难。
难点在于慢慢的去写代码，把所掌握的知识变成能运行的程序。
写程序还是蛮锻炼思维能力的。
只要思路对，就不要急，慢慢来就能出来。
实验三
一、实验名称
角度与弧度的换算
二、实验原理与过程
设计一个角表示为A（度），弧度表示为R（弧度），则角度与弧度的转化公式为：
角度化为弧度：
R=3.1415926/180弧度化为角度：
A=R*180/3.1415926
在输入时，将度分秒的形式化为弧度表示，为程序设计做准备，在输出时，将弧度化为度分秒的形式，以便于显示和观看。
三、部分代码
OptionExplicit
Dima%,b%,c%,d#
Constpi=3.1415926
PrivateSubCommand1_Click（）
a=Text1.Text：
b=Text2.Text：
c=Text3.Text：
d=（a+b/60+c/3600）*pi/180
Text4.Text=Format（d,"0.000000"）
EndSub
PrivateSubCommand2_Click（）
d=Text4.Text：
d=d*180/pi：
a=Int（d）：
d=（d-a）*60
b=Int（d）：
d=（d-b）*600：
c=Int（d）/10#
Text1.Text=a：
Text2.Text=b：
Text3.Text=c
EndSub
PrivateSubCommand3_Click（）
Text1.Text=""：
Text2.Text=""：
Text3.Text=""：
Text4.Text=""
Text1.SetFocus
Command1.Enabled=False
Command2.Enabled=False
EndSub
PrivateSubCommand4_Click（）
CX.Show
JD.Hide
EndSub
PrivateSubText1_Change（）
IfText1.Text<>""AndText2.Text<>""AndText3.Text<>""Then
Command1.Enabled=True
EndIf
EndSub
PrivateSubText2_Change（）
IfText1.Text<>""AndText2.Text<>""AndText3.Text<>""Then
Command1.Enabled=True
EndIf
EndSub
PrivateSubText3_Change（）
IfText1.Text<>""AndText2.Text<>""AndText3.Text<>""Then
Command1.Enabled=True
EndIf
EndSub
PrivateSubText4_Change（）
IfText4.Text<>""Then
Command2.Enabled=True
EndIf
EndSub
PrivateSubText1_KeyPress（KeyAsciiAsInteger）
IfKeyAscii=13Then
Text2.SetFocus
EndIf
EndSub
PrivateSubText2_KeyPress（KeyAsciiAsInteger）
IfKeyAscii=13Then
Text3.SetFocus
EndIf
EndSub
PrivateSubText3_KeyPress（KeyAsciiAsInteger）
IfKeyAscii=13Then
Text4.SetFocus
EndIf
EndSub
四、实验结果
五、心得体会
角度与弧度的换算并不是很难，在测量学的学习中就已经掌握了这个知识点，只是在编程的时候有点生疏而已，简单的回忆一下就能想起。
所以，在寝室里简单的查询了一些编写的方法和代码后，程序很快就写出来了，经过调试后，程序也能够运行。
我个人认为这个程序还是比较简单的。
程序的知识，是在日常生活中不断的积累出来的，所以，平时我们也必须要时常的编写一些小的程序，以后再编写大的程序时，就能够得心应手。
实验二
一、实验名称
两点间距离和方位角的计算
二、实验原理与过程
利用两点的坐标，然后求差，计算出X、Y的增量。
再利用勾股定理求出两点间的距离。
用三角函数的只是求出方位角。
三、部分代码
PrivateSubCommand1_Click（）
DimXa#,Ya#,Xb#,Yb#,detX#,detY#,tana#,ab#,du%,fen%,miao%,s#
ConstPi=3.14159265358979
Xa=Val（txtXa.Text）
Ya=Val（txtYa.Text）
Xb=Val（txtXb.Text）
Yb=Val（txtYb.Text）
detX=Xb-Xa
detY=Yb-Ya
IfAbs（detX）<0.00000001Then
MsgBox"除数为零，请检查坐标输入是否正确！
"
txtXa.SetFocus
ExitSub
EndIf
s=Sqr（detX*detX+detY*detY）
IfAbs（detX）<0.000001Then
IfdetY>0Then
ab=90
Else
ab=270
EndIf
Else
tana=detY/detX
ab=Atn（tana）'得到的是弧度
ab=ab*180/Pi
IfdetX<0Then
ab=180+ab
ElseIfdetX>0AnddetY<0Then
ab=360+ab
EndIf
EndIf
du=Fix（ab）
ab=（ab-du）*60
fen=Fix（ab）
ab=（ab-fen）*60
miao=Fix（ab）
txtDu.Text=Trim（Str（du））
txtFen.Text=Trim（Str（fen））
txtMiao.Text=Trim（Str（miao））
txtS.Text=Trim（Format（s,"0.0000"））
EndSub
PrivateSubCommand2_Click（）
txtXa.Text=""
txtYa.Text=""
txtXb.Text=""
txtYb.Text=""
txtDu.Text=""
txtFen.Text=""
txtMiao.Text=""
txtS.Text=""
txtXa.SetFocus
EndSub
PrivateSubCommand3_Click（）
End
EndSub
四、实验结果
五、心得体会
基本知识的学习很重要，编写程序前，首先是回顾知识。
然后按照知识点慢慢的编写。
其实知识并不难，稍微麻烦的就是思维的延伸和编写能力。
对于初步认识VB编程，我们应该尽可能多的去了解和写一些小的程序。
同时，在不知道该如何继续下去的时候，可以休息一会，或者找别人帮忙。
这样的效率才会更高。
不要盲目扎进去，进入死胡同。
实验五
3、实验名称
四等水准计算
二、实验原理与过程
通过水准仪提供的水平视线读取不同地方的高差，经过一定的水准路线进而求得待定点高程。
相应等级的水准测量注意事项可参考《水准测量规范》。
在工程建设领域，一般涉及二等及以下水准测量，服务的对象也是与工程建设有关的。
在基础测绘方面，通常会涉及一等水准测量和重力水准测量，服务的对象也是科学研究方向，为应用于建设提供保障。
三、部分代码
OptionExplicit
DimstartPoint!
endPoint!
PrivateSubcmdCheckCalc_Click（）
Dimi%,tDist'距离
tDist=0
DimtotalDetH!
closeDetH!
'累计高差和高差闭合差
Fori=1TonMarks
tDist=tDist+dis（i）
Nexti
totalDetH=0
Fori=1TonMarks'计算累计高差
totalDetH=totalDetH+detH（i）
Nexti
'计算闭合差
startPoint=Val（txtStartPoint.Text）
endPoint=Val（txtEndPoint.Text）
IfoptAnnex.ValueThen'附合水准
closeDetH=（endPoint-startPoint）-totalDetH
Else'闭合水准和支水准
closeDetH=-totalDetH
EndIf
'检查闭合差是否超限
IfcloseDetH>0.04*Sqr（tDist）Then'采用40*Sqr（L）来计算，单位是毫米
MsgBox"闭合差超限，测量成果不合格！
",,"闭合差超限"
txtShowResult.Text=txtShowResult.Text&"闭合差超限，测量成果不合格！
"
ExitSub
Else
MsgBox"闭合差合格，继续计算转点高程！
",,"闭合差合格"
EndIf
Dimtemp!
temp=startPoint
txtShowResult.Text=txtShowResult.Text&"平差后的高程为：
"&vbCrLf
Fori=0TonMarks
temp=temp+detH（i）+closeDetH*dis（i）/tDist
txtShowResult.Text=txtShowResult.Text&"（"&Str（i）&"）：
"&Str（Format（temp,"0.000"））&vbCrLf
Nexti
EndSub
PrivateSubcmdExit_Click（）
End
EndSub
PrivateSubcmdInput_Click（）
'检查输入的几个文本框：
是否已经输入了
IftxtStartPoint.Text="0"Then
MsgBox"还没有输入起始点高程！
"
ExitSub
EndIf
IftxtEndPoint.Text="0"AndoptAnnex.Value=TrueThen
MsgBox"还没有输入终点高程！
"
ExitSub
EndIf
IftxtBMNum.Text="0"AndoptAnnex.Value=TrueThen
MsgBox"还没有输入测站数！
"
ExitSub
EndIf
frmInput.Show
EndSub
PrivateSuboptAnnex_Click（）
txtEndPoint.Enabled=optAnnex.Value
EndSub
PrivateSuboptClose_Click（）
txtEndPoint.Enabled=NotoptClose.Value
EndSub
PrivateSuboptSpur_Click（）
txtEndPoint.Enabled=NotoptSpur.Value
EndSub
PrivateSubtxtStartPoint_LostFocus（）
IfNotIsNumeric（txtStartPoint.Text）Then
MsgBox"输入的高程含有非数字字符！
"
txtStartPoint.Text=""
txtStartPoint.SetFocus
ExitSub
EndIf
IfVal（txtStartPoint.Text）>5000OrVal（txtStartPoint.Text）<-100Then
MsgBox"输入的高程有误！
"
txtStartPoint.Text=""
txtStartPoint.SetFocus
ExitSub
EndIf
st
升级会员 