推算坐标方位角程序.doc

推算坐标方位角程序分类:土建参考资料2006.9.5 20:26 作者：小杨 | 评论：0 | 阅读：1922 Option ExplicitRem **** GPHVB2.VBP ****Rem **** 奇进偶舍、度分秒与弧度互化、推算坐标方位角程序****Rem **** 2005/03/23*****Private Sub Form_Load()Rem ***** 此为第一个窗体From1.frm ****Form1.Height = Screen.Height: '**** 设置窗体高占整个屏幕Form1.Width = Screen.Width: '*****  设置窗体宽占整个屏幕Form1.Left = 0: '**** 设置窗体位置距离屏幕左端的距离为值零Form1.Top = 0: '****  设置窗体位置距离屏幕上端的距离值为零End SubPrivate Sub GPHT1_Click(index As Integer)Rem **** 奇进偶舍演示 ****Rem ——————————————————————————————Rem **** VB提倡使用显示变量，要显示声明变量，方法有二：Rem **** 1.可在类模块、窗体模块或标准模块的声明段加入如下语句：Rem **** Option ExplicitRem **** 2.在“工具”菜单中选取“选项”，单击“编辑器”选项卡，Rem **** 再复选“要求变量声明”选项，最后单击“确定”退出，这样Rem **** 就在任何新模块（类模块、窗体模块、标准模块）的声明段中Rem **** 自动插入Option Explicit语句，但不会在已经建立起来的Rem **** 模块中自动插入；所在工程内部，只能用手工方法向现有模Rem **** 块添加 Option explicit 语句。

Rem ——————————————————————————————Dim A As IntegerClsPrintPrint Spc(6); "奇进偶舍演示"PrintPrint Spc(6); "PI()"For A = 1 To 20     Print Spc(6); LTrim$(A); "    NNN="; NNN(PI(), A)     'DO     'Loop Until INKEY$<>""     Next AEnd SubPrivate Function NNN(ByVal NM As Double, ByVal BB As Integer) As DoubleRem **** 奇进偶舍函数 ****Rem **** NM为需要奇进偶舍的变量，BB为NM这个变量需要保留的小数点后面的位数 *****Rem **** 分别用NM=PI()、BB=1、2、……Rem **** NM=1.2225、BB=3Rem **** NM=1.2235、BM=3  来验证该FUNCTION过程的正确性  ****Dim BNM As DoubleDim C As IntegerDim J As IntegerDim K As IntegerDim I As DoubleC = Sgn(NM)BNM = Abs(NM)I = (BNM * 10 ^ (BB + 1) + 10 ^ (-11)) - 10 * Fix(BNM * 10 ^ BB + 10 ^ (-11))I = (Fix(I * 10 ^ 10)) / 10 ^ 10J = Fix(BNM * 10 ^ BB + 10 ^ (-11)) - 10 * Fix(BNM * 10 ^ (BB - 1) + 10 ^ (-110))If I > 5 ThenK = 1ElseIf I < 5 ThenK = 0ElseIf (I = 5 And J = 2 * Fix(J / 2)) ThenK = 0ElseK = 1End IfNNN = C * Fix(BNM * 10 ^ BB + K) / 10 ^ BBEnd FunctionPrivate Static Function PI() As DoubleRem ****** 计算PI *******PI = 4 * Atn(1)End FunctionPrivate Sub GPHT2_CLICK(index As Integer)Rem ****** DEG->RAD 演示******Dim D As StringCls'D="0 00 00"'D="0 12 55"'D="2 12 55"'D = "12 36 56"  'D="233 12 45" 'D="-233 12 45"PrintPrint Spc(6); "DEG->RAD　演示"PrintPrint Spc(6); "DEG$="; DPrint Spc(6); "RAD="; RAD(D)'*******当Ｄ$="12 36 56 " 时 , RAD=0.220182981*****End SubPrivate Function RAD(ByVal DEGREE As String) As DoubleRem **** XXX°XX′XX"->rad *****Rem **** DEGREE$如"12 45 18"的形式　****Rem **** 应加上如下功能：１.测试DEGREE$是否带有＋－号；Rem **** ２.测试度和分之间的空格之间有多少字符Dim DEG11 As DoubleDim DEG12 As DoubleDim DEG13 As Double   DEG11 = Val(Left$(DEGREE, 3))   DEG12 = Val(Mid$(DEGEE, 5, 2)) / 60   DEG13 = Val(Right$(DEGEE, 2)) / 3600   RAD = (DEG11 + DEG12 + DEG13) * PI() / 180   End FunctionPrivate Sub GPHT3_CLICK(index As Integer)Rem **** RAD->DEG演示****Dim RADIAN As DoubleClsRADIAN = -2.1234PrintPrint Spc(6); "RAD->DEG演示"PrintPrint Spc(6); "RAD="; RADIANPrint Spc(6); "DEG$="; DEG(RADIAN)End SubPrivate Function DEG(ByVal RAD As Double) As StringRem ****RAD->#XXX°XX'XX″****Rem ****#号表示输出XXX°XX′XX″前应带有的符号，其若为"-"号，即取之；Rem **** 其若为“＋”号，使空格顶位。

Rem **** 新增编一个功能：秒值输出时，可选小数点后保留的位数ＢＢ****Dim SIGN As Integer, WE As IntegerDim G As StringDim DEGREE As Double, DEG21 As Double, DEG31 As DoubleDim I As IntegerDim DEG1 As String, DEG2 As String, DEG3 As StringDim DEG11 As Integer, DEG22 As IntegerDim DEG33 As DoubleDim BB As IntegerRem **** BB 为秒值输出时，可选小数点后保留的位数****Rem **** BB 取值范围；0≤BB≤5****   BB = 2: '**** 此为演示事例的取值　****   SIGN = Sgn(RAD)   If SIGN < 0 Then G = "-" Else G = ""         DEGREE = Abs(RAD * 180 / PI())   If DEGREE < 10 ^ (-10) Then I = 0 Else I = 1      Select Case I   Case 0    DEG1 = " 0"    DEG2 = " 00"    DEG3 = " 00"    If BB > 0 Then      DEG3 = DEG3 + "." + String$(BB, "0")    End If Case Else    DEG11 = Fix(DEGREE)    DEG21 = (DEGREE - DEG11) * 60    DEG22 = Fix(DEG21)    DEG31 = (DEG21 - DEG22) * 60            'DEG33=Cint(DEG31;**** 当秒值只为整数时，采用此公式 ****    DEG33 = NNN(DEG31, BB): '****当秒值输出时，可选小数点后保留的位数时，采用此公式 ****            DEG1 = LTrim$(Str$(DEG11)) + ""    DEG2 = LTrim$(Str$(DEG22))    DEG3 = LTrim$(Str$(DEG33))            If Len(DEG2) = 1 Then DEG2 = "0" + DEG2 Else DEG2 = DEG2    If Len(DEG3) = 1 Then DEG3 = "0" + DEG3 Else DEG3 = DEG3        DEG2 = DEG2 + ""        WE = Len(DEG1)        Select Case WECase 1    DEG1 = "" + DEG1Case 2    DEG1 = "" + DEG1Case 3    DEG1 = DEG1End SelectDEG = G + DEG1 + DEG2 + DEG3End FunctionPrivate Sub GPHT7_CLICK(index As Integer)Rem ****　推算坐标方位角菜单子过程 ****Dim TT12 As String: '****声明起算坐标方位角变量Dim TTAN As Double: '**** 声明所推算终边的坐标方位角变量Dim N As Integer: '**** 声明推算坐标方位角所使用的折角个数变量N = 3: '**** 这里设推算坐标方位角所使用的折角个数为３ReDim PP(1 To N) As String: '**** 声明推算坐标方位角所使用的折角变量，左折角取正号，右折角取负号TT12 = "  228 06 06"PP(1) = "273 12 50"PP(2) = "-106 47 10"PP(3) = "79 34 18"PP(4) = ""'PP(5)=""TT。