frmverdatainput2.frm

自行开发 水准网平差程序

   Unload FrmVerDataInput2
End Sub

Private Sub Form_Load()
     Dim I As Integer
     Dim RecNum As Integer
     Me.Left = (Screen.Width - Me.Width) / 2
     Me.Top = (Screen.Height - Me.Height) / 2
     ChkRule.Value = vbChecked
     ChkNet.Value = vbChecked
     Label1.Enabled = False
     Label1.Visible = False
     Text1.Enabled = False
     Text1.Visible = False
     Set arecord = g_d_Base.OpenRecordset("点名表", dbOpenTable)
    With arecord
        If .RecordCount > 0 Then
            RecNum = .RecordCount
            .MoveFirst
            For I = 1 To RecNum
                If .Fields(1) <> "" Then g_PotName(I) = .Fields(1)
                If I <= g_Ed Then
                    g_Z0(I) = .Fields(2)
                End If
                If I < RecNum Then
                    .MoveNext
                End If
            Next I
        End If
    End With
    arecord.Close
    Set arecord = g_d_Base.OpenRecordset("观测数据表", dbOpenTable)
    With arecord
      If .RecordCount > 0 Then
         RecNum = .RecordCount
         .MoveFirst
         For I = 1 To RecNum
             If .Fields(1) <> "" Then g_StaPotName(I) = .Fields(1)
             If .Fields(2) <> "" Then g_EndPotName(I) = .Fields(2)
             If .Fields(3) <> 0 Then g_H(I) = .Fields(3)
             If .Fields(3) = 0 Then g_H(I) = .Fields(3)
             If .Fields(4) <> 0 Then g_StaNum(I) = .Fields(4)
             If .Fields(4) = 0 Then g_StaNum(I) = .Fields(4)
             If I < RecNum Then
                 .MoveNext
             End If
         Next I
       End If
    End With
    arecord.Close
     g_Mh = 0
     g_PotNum = g_Ed + g_Dd
     Grid1.ColWidth(0) = 400
     Grid1.ColWidth(1) = 800
     Grid1.ColWidth(2) = 1200
     Grid2.ColWidth(0) = 400
     Grid2.ColWidth(1) = 800
     Grid2.ColWidth(2) = 800
     Grid2.ColWidth(3) = 1200
     Grid2.ColWidth(4) = 1200
     Grid1.ColAlignment(0) = 4
     Grid1.ColAlignment(1) = 4
     Grid1.ColAlignment(2) = 4
     Grid2.ColAlignment(0) = 4
     Grid2.ColAlignment(1) = 4
     Grid2.ColAlignment(2) = 4
     Grid2.ColAlignment(3) = 4
     Grid2.ColAlignment(4) = 4
     Grid1.Row = 0
     Grid1.Col = 0
     Grid1.Text = "序号"
     Grid1.Col = 1
     Grid1.Text = "点名"
     Grid1.Col = 2
     Grid1.Text = "高程"
     Grid2.Row = 0
     Grid2.Col = 0
     Grid2.Text = "序号"
     Grid2.Col = 1
     Grid2.Text = "起点名"
     Grid2.Col = 2
     Grid2.Text = "终点名"
     Grid2.Col = 3
     Grid2.Text = "高差"
     Grid2.Col = 4
     Grid2.Text = "长度或测站数"
     Grid1.Rows = g_PotNum + 1
     Grid1.Col = 1: Grid1.ColSel = 2
     Grid1.Row = 1: Grid1.RowSel = g_PotNum
     Grid1.Col = 1
     Grid2.Rows = g_ObsNum + 1
     Grid2.Col = 1: Grid2.ColSel = 4
     Grid2.Row = 1: Grid2.RowSel = g_ObsNum
     For I = 1 To g_PotNum
       Grid1.Col = 0
       Grid1.Row = I
       Grid1.Text = Str$(I)
     Next I
     For I = 1 To g_ObsNum
       Grid2.Col = 0
       Grid2.Row = I
       Grid2.Text = Str$(I)
     Next I
   For I = 1 To g_PotNum
     Grid1.Col = 1
     Grid1.Row = I
     Grid1.Text = g_PotName(I)
     Grid1.Col = 2
     If I <= g_Ed Then
        Grid1.Text = g_Z0(I)
      End If
   Next I
   For I = 1 To g_ObsNum
     Grid2.Col = 1
     Grid2.Row = I
     Grid2.Text = g_StaPotName(I)
     Grid2.Col = 2
     Grid2.Text = g_EndPotName(I)
     Grid2.Col = 3
     Grid2.Text = Str$(g_H(I))
     Grid2.Col = 4
     Grid2.Text = Str$(g_StaNum(I))
   Next I
   If g_Net = 1 Then
      ChkNet.Value = vbChecked
   Else
      ChkNet.Value = vbUnchecked
      Label1.Enabled = True
      Label1.Visible = True
      Text1.Enabled = True
      Text1.Visible = True
   End If
   If g_Ih = 1 Then
      ChkRule.Value = vbChecked
   Else
     ChkRule.Value = vbUnchecked
   End If
End Sub

Private Sub Grid1_KeyPress(KeyAscii As Integer)
   Grid1.Col = wgridcol1
   Grid1.Row = wgridrow1
   If KeyAscii = 8 Then
       If Grid1.Text <> "" Then Grid1.Text = Mid(Grid1.Text, 1, Len(Grid1.Text) - 1)
   Else
         Grid1.Text = Grid1.Text + Chr$(KeyAscii)
   End If
End Sub

Private Sub Grid2_KeyPress(KeyAscii As Integer)
Grid2.Col = wgridcol2
Grid2.Row = wgridrow2
    If KeyAscii = 8 Then
       If Grid2.Text <> "" Then Grid2.Text = Mid(Grid2.Text, 1, Len(Grid2.Text) - 1)
       Else
         Grid2.Text = Grid2.Text + Chr$(KeyAscii)
       End If
End Sub

Private Sub Grid1_RowColChange()
    wgridcol1 = Grid1.Col
    wgridrow1 = Grid1.Row
End Sub
Private Sub Grid2_RowColChange()
    wgridcol2 = Grid2.Col
    wgridrow2 = Grid2.Row
End Sub

Private Sub Text1_Change()
     g_Mh = Val(Text1.Text)
End Sub

Private Sub Grid1_LostFocus()
  Dim I As Integer
  For I = 1 To g_Ed + g_Dd
       Grid1.Col = 1
       Grid1.Row = I
       If Grid1.Text <> "" Then g_PotName(I) = Grid1.Text
       Grid1.Col = 2
       If Grid1.Text <> "" Then g_Z0(I) = Val(Grid1.Text)
  Next I
End Sub

Private Sub Grid2_LostFocus()
  Dim I As Integer
  
  For I = 1 To g_ObsNum
       Grid2.Col = 1
       Grid2.Row = I
       If Grid2.Text <> "" Then g_StaPotName(I) = Grid2.Text
       Grid2.Col = 2
       If Grid2.Text <> "" Then g_EndPotName(I) = Grid2.Text
       Grid2.Col = 3
       If Grid2.Text <> "" Then g_H(I) = Val(Grid2.Text)
       Grid2.Col = 4
       If Grid2.Text <> "" Then g_StaNum(I) = Val(Grid2.Text)
  Next I
End Sub

Private Sub VerDataInput2Save()
    Set arecord = g_d_Base.OpenRecordset("基本信息表", dbOpenTable)
    With arecord
          .Edit
          If g_Net = 1 Then
             .Fields(12) = "是"
          Else
             .Fields(12) = "否"
          End If
          If g_Ih = 1 Then
             .Fields(13) = "是"
          Else
             .Fields(13) = "否"
          End If
          .Fields(14) = g_Mh
          .Update
           .Bookmark = .LastModified
           .Close
        End With
    
        Set arecord = g_d_Base.OpenRecordset("点名表", dbOpenTable)
        With arecord
            ic = .RecordCount
            If .RecordCount > 0 Then
              .MoveFirst
              For I = 1 To ic
                  .Delete
                  If I < ic Then
                      .MoveFirst
                  End If
              Next I
            End If
            For I = 1 To g_PotNum
                .AddNew
                .Fields(0) = I
                If g_PotName(I) <> "" Then .Fields(1) = g_PotName(I)
                .Fields(2) = g_Z0(I)
                .Update
            Next I
            .Close
        End With
        Set arecord = g_d_Base.OpenRecordset("观测数据表", dbOpenTable)
        With arecord
            ic = .RecordCount
            If .RecordCount > 0 Then
              .MoveFirst
              For I = 1 To ic
                   .Delete
                   If I < ic Then
                      .MoveFirst
                  End If
              Next I
            End If
            For I = 1 To g_ObsNum
                .AddNew
                .Fields(0) = I
                If g_StaPotName(I) <> "" Then .Fields(1) = g_StaPotName(I)
                If g_EndPotName(I) <> "" Then .Fields(2) = g_EndPotName(I)
                .Fields(3) = g_H(I)
                .Fields(4) = g_StaNum(I)
                .Update
               Next I
            .Close
        End With
End Sub