Dim fso As New FileSystemObject, ts As TextStream, Fl As File, fname As String 定义用于各个过程的模块级变量Dim xo() As Double, yo() As Double, ym() As String, yds As IntegerDim ma As Single, ms As Single, mk As Single, zds As Integer, m(20) As IntegerPrivate l() As Double, s() As Double, dm() As StringPrivate nl() As Integer, ns() As Integer, lb() As String, sb() As String, cds As IntegerPrivate x() As Double, y() As Double, NX() As Double, UX() As Double, ll As DoubleConst pi = 3.141592654Private Sub Form_load() 启动程序时初始化Fil(2).Enabled = False “保存“菜单不可用Fil(3).Enabled = False “另存“菜单不可用Text1.Visible = False 文本框不可见MMControl1.Visible = False 播放控件不可视MMControl1.DeviceType = “sequencer“ 指定音乐文件类型是MIDI 型MMControl1.FileName = “c:windowsmedia贝多芬第五交响乐.rmi“ 等号右边部分是文件名及地址MMControl1.Command = “open“ 打开背景音乐文件MMControl1.Command = “play“ 播放End SubPrivate Sub Form_Resize() 设置窗体变化时,文本框对应变化功能With Text1 以下属性值前可省略对象名.Left = 0 窗体外框左边缘与屏幕显示区左边缘距离为 0.Top = Picture1.Height 窗体外框上边缘与屏幕显示区上边缘距离为图片框高度值.Height = Form1.Height - Picture1.Height 文本框的高度为窗体高度减图片框高度.Width = Form1.Width 文本框宽度等于窗体宽度End WithEnd SubPrivate Sub Fil_Click(Index As Integer) 文件菜单点击事件Select Case IndexCase 0 新建文件，调入写字板程序建立新文本文件Form1.Caption = “建立新数据文件“xx = Shell(“notepad.exe“, vbNormalFocus) 参数设定最大化方式并有焦点，变量 xx 用来接受调用成功后返回的任务标识码,是语法所要求的。Case 1 打开一个已有文件，显示在文本框中CommonDialog1.ShowOpen 打开公共对话框中的“open“对话框fname = CommonDialog1.FileName 将用户在“open“对话框中选中的文件名(字符串)赋给变量 fnameIf fname TrueB = ts.ReadLineB = Trim(B): i = 1:m(i) = InStr(B, “,“)Do While m(i) 1 Then tr(i) = Right(B, Len(B) - m(i - 1)If m(2) = 0 Thenk = k + 1: ReDim Preserve ym(k): ReDim Preserve xo(k): ym(k) = tr(1): xo(k) = Val(tr(2)Elsej = j + 1: ReDim Preserve dm1(j): ReDim Preserve lbb(j): ReDim Preserve h1(j): ReDim Preserve ss(j): dm1(j) = tr(1): lbb(j) = tr(2): h1(j) = Val(tr(3): ss(j) = Val(tr(4)End IfLoopa1 = j: yds = k: b1 = a1End IfFor t1 = 1 To a1 - 1e1 = 0For n = t1 + 1 To a1If dm1(n) = dm1(t1) Then e1 = 1Next nIf e1 = 1 Then b1 = b1 - 1Next t1i = 0For p = 1 To a1e2 = 0If p = 1 ThenReDim Preserve nl(p): nl(p) = 1: ReDim Preserve dm(p): ReDim Preserve lb(nl(p): ReDim Preserve l(nl(p): ReDim Preserve s(nl(p): dm(p) = dm1(p): lb(nl(p) = lbb(p): l(nl(p) = h1(p): s(nl(p) = ss(p)ElseFor q = 1 To p - 1If dm1(p) = dm1(q) Then e2 = 1Next qEnd IfIf e2 = 0 Theni = i + 1: ReDim Preserve nl(i): nl(i) = nl(i - 1) + 1: ReDim Preserve dm(i): ReDim Preserve lb(nl(i): ReDim Preserve l(nl(i): ReDim Preserve s(nl(i): dm(i) = dm1(p): lb(nl(i) = lbb(p): l(nl(i) = h1(p): s(nl(i) = ss(p)If p 0 ThenFor j = 1 To nl(i)h = seqn(lb(j)If x(h) = 0 Then x(h) = x(i) + l(j)Next jEnd IfNext iFor i = 1 To cdsIf x(i) = 0 ThenFor j = 1 To nl(i)h = seqn(lb(j)If x(h) zdsFor i = 1 To ydsFor j = 1 To zdsIf ym(i) = dm(j) Then m(i) = jNext jNext iFor i = 1 To ydsx(m(i) = xo(i)Next ic = Space(11) & “近 似 高 程 值“ & Chr(13) & Chr(10) & Space(5)c = c & Space(3) & “点 名“ & Space(4) & “高程值“ & Space(4) & “序号“ & Chr(13) & Chr(10)For i = 1 To zdsd1 = dm(i)d1 = Format(d1, “)x1 = x(i): x1 = Format(x1, “#.000“)c = c & Space(5) & d1 & Space(5) & x1 & Space(5) & i & Chr(13) & Chr(10)Next iText1.Text = cText1.Visible = Trueadj(2).Enabled = TrueCase 2 组法方程Text1.Visible = FalseDim n1 As Integer, n2 As Integer, l1 As Double, pp As Doublell = 0n1 = zds - ydsn2 = n1 * (n1 + 1) / 2ReDim NX(n2), UX(n1)Call order(m(), yds)For i = 1 To cdsk1 = nl(i - 1) + 1: k2 = nl(i)For j = k1 To k2ReDim nb(n1)h = seqn(lb(j)cha = charact(i, k)If cha = “n“ Thend = i - knb(d) = -1End Ifcha = charact(h, k)If cha = “n“ Thend = h - knb(d) = 1End Ifl1 = (x(h) - x(i) - l(j) * 100pp = 200 / s(j)Call equationg(nb(), pp, l1)ll = ll + pp * l1 2Next jNext iText1.Visible = FalseMsgBox (“法方程组成完毕“)adj(3).Enabled = TrueCase 3 高斯约化法解法方程n = zds - ydsReDim nb(n)For i = 1 To nnb(i) = -UX(i)Next iFor k = 1 To n - 1m1 = k * (k + 1) / 2For j = k + 1 To nm3 = (j - 1) * j / 2 + kFor i = j To nd = (i - 1) * i / 2n1 = d + kn2 = d + jNX(n2) = NX(n2) - NX(n1) * NX(m3) / NX(m1)Next iNext jFor i = k + 1 To nnub = (i - 1) * i / 2 + knb(i) = nb(i) - nb(k) * NX(nub) / NX(m1)Next iNext k 法方程约化完毕For k = n To 1 Step -1u = nb(k)If k “ Then 若无此判断当对话框中选择取消时、下面赋值语句将出错Set ts = fso.OpenTextFile(fname) 将 fname 作为文本文件打开,并设置句柄j = 0: k = 0: p = 0: h = 0j 是测站数累计变量,k 是已知点累计变量,l（j） 、ns（j）分别是方向值、边长累积计数Do While ts.AtEndOfLine 0 前测型 Do. Loop 循环，成立条件是该行字符串中有逗号tr(i) = Mid(B, m(i - 1) + 1, m(i) - m(i - 1) - 1) 提取指定位置开始的指定数目字符。i = i + 1m(i) = InStr(m(i - 1) + 1, B, “,“) 从上一个找到的逗号位置起，查找下一个逗号的位置LoopIf m(i) = 0 And i 1 Then tr(i) = Right(B, Len(B) - m(i - 1) 处理一行中最后一个逗号后的字符串以下部分是将存储在数组变量 m(i)中的字符分类存放到方向、边长、已知坐标、网型信息等数组中If p = 0 Then 读到的是文件第一行。ma = tr(1): ms = tr(2): mk = tr(3): p = 1 提取观测方向,边先验精度值，并使该句以后不能再执行。ElseIf m(1) = 0 Then j = j + 1: ReDim Preserve dm(j): ReDim Preserve nl(j): ReDim Preserve ns(j): dm(j) = B: nl(j) = nl(j - 1): ns(j) = ns(j - 1)该行中没有逗号,但又不是结束符，则一定是测站点名。将读出的字符串赋值到点名数组变量 dm(j)，并对该测站最大方向号，最大边长号数组变量 nl(j)、ns(j)赋值累计起始值If m(1) “l“ And tr(2) 0.001 T