水准路线代码.txt

本源码使用VB编写的

Private Sub Command1_Click()
Dim h(), s(), p(), v()
Dim n, i, pp, ph, pvv, m, u, mh
  n = Val(Me.Text1.Text)
  
  ReDim h(1 To n)
  ReDim s(1 To n)
  ReDim p(1 To n)
  ReDim v(1 To n)
 '填写h矩阵和s矩阵的每一个元素
 For i = 0 To n - 1
  If Me.Text2(i).Text = "" Then
    MsgBox "请输入各条路线的高差值！", "输入高差！"
    Text2(k).SetFocus
  End If
  If Me.Text3(i).Text = "" Then
    MsgBox "请输入各条路线的距离！", "输入距离！"
    Text3(k).SetFocus
  End If
 Next i
   '给矩阵的每一个元素赋值,并求出p(i),pp,ph
  For i = 1 To n
    h(i) = Val(Text2(i - 1).Text)
    s(i) = Val(Text3(i - 1).Text)
  
    p(i) = 10 / s(i)
    pp = pp + p(i)
    ph = ph + p(i) * h(i)
  
  Next i
  
  hh = ph / pp
  
  For i = 1 To n
    v(i) = (hh - h(i)) * 1000
    pvv = pvv + p(i) * v(i) * v(i)
    Me.Text4(i - 1).Text = h(i)
    Me.Text5(i - 1).Text = s(i)
    Me.Text6(i - 1).Text = p(i)
    Me.Text7(i - 1).Text = v(i)
  Next i
  
  m = Sqr(pvv / (n - 1))
  u = m / Sqr(10)
  mh = m * Sqr(1 / pp)
  Me.Text8.Text = ph
  Me.Text9.Text = pvv
  Me.Text10.Text = pp
  Me.Text11.Text = hh
  Me.Text12.Text = mh
  Me.Text13.Text = m
  Me.Text14.Text = u

End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
  Dim i, j, k, n As Integer
  If KeyAscii = 13 Then
   n = Val(Text1.Text)
    For i = 1 To n - 1
        Load Text2(i)
          With Text2(i)
           .Left = Text2(i - 1).Left + .Width
           .Visible = True
          End With
        Load Text3(i)
          With Text3(i)
           .Left = Text3(i - 1).Left + .Width
           .Visible = True
          End With
          
         Load Text4(i)
          With Text4(i)
           .Left = Text4(i - 1).Left + .Width
           .Visible = True
          End With
          
         Load Text5(i)
          With Text5(i)
           .Left = Text5(i - 1).Left + .Width
           .Visible = True
          End With
          
          Load Text6(i)
          With Text6(i)
           .Left = Text6(i - 1).Left + .Width
           .Visible = True
          End With
          Load Text7(i)
          With Text7(i)
           .Left = Text7(i - 1).Left + .Width
           .Visible = True
          End With
    Next i
  End If
End Sub