teamform.frm

某机械工程学院的毕业设计以及毕业论文 非常参考价值

End Sub

Private Sub c1_Click()
  griddata = griddata + "1"
  Call fill_grid
End Sub

Private Sub c2_Click()
  griddata = griddata + "2"
  Call fill_grid
End Sub

Private Sub c3_Click()
  griddata = griddata + "3"
  Call fill_grid
End Sub

Private Sub c4_Click()
  griddata = griddata + "4"
  Call fill_grid
End Sub

Private Sub c5_Click()
  griddata = griddata + "5"
  Call fill_grid
End Sub

Private Sub c6_Click()
  griddata = griddata + "6"
  Call fill_grid
End Sub

Private Sub C7_Click()
  griddata = griddata + "7"
  Call fill_grid
End Sub

Private Sub C8_Click()
  griddata = griddata + "8"
  Call fill_grid
End Sub

Private Sub C9_Click()
  griddata = griddata + "9"
  Call fill_grid
End Sub

Sub fill_grid()
  ch$ = Chr(13) + Chr(10)
  msg1$ = "该阀门编号不存在，      "
  msg2$ = "请重新输入！"
  msg$ = msg1$ + ch$ + msg2$
  If gridtype = 1 Then
    Grid1.Text = griddata
    If (Val(griddata) > maxnum) Then
      ppp = MsgBox(msg$, 48, "特别提示")
      Grid1.Text = "": griddata = ""
      filedata(datarow, datacol) = ""
      data(datarow, datacol) = 0
      Exit Sub
    Else
      filedata(datarow, datacol) = griddata
      data(datarow, datacol) = Val(filedata(datarow, datacol))
    End If
  End If
  If gridtype = 2 Then
    Grid2.Col = 1
    Grid2.Text = griddata
    lgsettime(timerow) = Val(griddata)
  End If
  If (gridtype = 3) Then
    timeText.Text = griddata
  End If
  If (gridtype = 4) Then
    numText.Text = griddata
  End If
End Sub

Private Sub Cmdtime_Click()
  Call cal_bz
  For j = 1 To lgnum
    Grid2.Row = j
    Grid2.Col = 1
    Grid2.Text = timeText.Text
    lgsettime(j) = Val(timeText.Text)
    Grid2.Col = 2
    Grid2.Text = ""
    Grid2.Col = 3
    Grid2.Text = ""
    Grid2.Col = 4
    Grid2.Text = ""
  Next j
End Sub

Sub cal_bz()
  On Error GoTo hh
  lgnum = 0: fmnum = 0
  timenum = 0
  For i = 1 To 15
    For j = 1 To 50
      If filedata(j, i) <> "" Then
        If j >= lgnum Then lgnum = j
      End If
    Next j
  Next i
  For j = 1 To 50
    num(j) = 0
    For i = 1 To 15
      If filedata(j, i) <> "" Then
        If i >= fmnum Then fmnum = i
        num(j) = i
      End If
    Next i
  Next j
  For j = 1 To 50
    If lgsettime(j) <> 0 Then
      timenum = j
    End If
  Next j
hh: Exit Sub
End Sub

Private Sub Cmdnew_Click()
  ch$ = Chr(13) + Chr(10)
  msg1$ = "你确信要重新编组吗？      "
  msg2$ = "它将清除现有编组！"
  msg$ = msg1$ + ch$ + msg2$
  ppp = MsgBox(msg$, 65, "特别提示")
  If (ppp = 1) Then
    Call renew
  End If
End Sub

Sub renew()
  On Error GoTo hh
  griddata = ""
  For j = 1 To 50
    Grid1.Row = j
    For i = 1 To 15
      Grid1.Col = i
      Grid1.Text = ""
      Grid1.CellForeColor = RGB(0, 0, 0)
      filedata(j, i) = ""
      data(j, i) = 0
    Next i
    num(j) = 0
  Next j
  For j = 1 To 50
    Grid2.Row = j
    For i = 1 To 4
      Grid2.Col = i
      Grid2.Text = ""
    Next i
    lgsettime(j) = 0
    lgbacktime(j) = 0
  Next j
  lgnum = 0
  fmnum = 0
  timenum = 0
  timeadd = 0
  timeText.Text = ""
  Frame1.Enabled = True
  Cmdtime.Enabled = True
hh: Exit Sub
End Sub

Private Sub Cmdload_Click()
  commandbz = 10
  bzForm.Show vbModal
End Sub

Public Sub open_file()
  Dim datastring(2000) As String
  Dim opendatafile(200, 20) As String
  Dim l As Long
  Dim a As String, b As String, X As String
  Dim n As Integer
  On Error GoTo hh
  F1% = FreeFile
  Close
  Open fname For Input As #F1%
  Do While Not EOF(F1%)
    Line Input #F1%, a
    l = Len(a)
    b = ""
    For i = 1 To l
      X = Mid$(a, i, 1)
      If Asc(X) > 31 Then b = b + X
    Next i
    datastring(n) = b
    n = n + 1
  Loop
  Close #F1%

      For i = 0 To n - 1
        opendatafile(i, 0) = Mid$(datastring(i), 1, 14)
        opendatafile(i, 1) = Mid$(datastring(i), 15, 14)
        opendatafile(i, 2) = Mid$(datastring(i), 29, 14)
        opendatafile(i, 3) = Mid$(datastring(i), 43, 14)
        opendatafile(i, 4) = Mid$(datastring(i), 57, 14)
        opendatafile(i, 5) = Mid$(datastring(i), 71, 14)
        opendatafile(i, 6) = Mid$(datastring(i), 85, 14)
        opendatafile(i, 7) = Mid$(datastring(i), 99, 14)
        opendatafile(i, 8) = Mid$(datastring(i), 113, 14)
        opendatafile(i, 9) = Mid$(datastring(i), 127, 14)
        opendatafile(i, 10) = Mid$(datastring(i), 141, 14)
        opendatafile(i, 11) = Mid$(datastring(i), 155, 14)
        opendatafile(i, 12) = Mid$(datastring(i), 169, 14)
        opendatafile(i, 13) = Mid$(datastring(i), 183, 14)
        opendatafile(i, 14) = Mid$(datastring(i), 197, 14)
        opendatafile(i, 15) = Mid$(datastring(i), 211, 14)
      Next i
 
      Call renew
 
      For i = 1 To 15
        Grid1.Col = i
        For j = 0 To n - 1
          Grid1.Row = j + 1
          Grid1.CellForeColor = RGB(0, 0, 0)
          Grid1.Text = Trim$(opendatafile(j, i))
          filedata(j + 1, i) = Trim$(opendatafile(j, i))
          data(j + 1, i) = Val(filedata(j + 1, i))
        Next j
      Next i
      For j = 0 To n - 1
        Grid2.Col = 1
        Grid2.Row = j + 1
        Grid2.Text = Trim$(opendatafile(j, 0))
        lgsettime(j + 1) = Trim$(opendatafile(j, 0))
      Next j
    numText.Text = ""
    timeText.Text = ""
    Call cal_bz
hh: Exit Sub
End Sub

Private Sub Cmdsave_Click()
  commandbz = 11
  bzForm.Show vbModal
End Sub

Public Sub save_bz()
  On Error GoTo hh
  Call pd
  If (pdnum = 1) Then
    Exit Sub
  End If
  F3 = FreeFile
  Close
  Open fname For Output As #F3
  For j = 1 To lgnum
    Print #F3, Str$(lgsettime(j)), filedata(j, 1), filedata(j, 2), filedata(j, 3), _
               filedata(j, 4), filedata(j, 5), filedata(j, 6), filedata(j, 7), _
               filedata(j, 8), filedata(j, 9), filedata(j, 10), filedata(j, 11), _
               filedata(j, 12), filedata(j, 13), filedata(j, 14), filedata(j, 15)
  Next j
  Close #F3
hh: Exit Sub
End Sub

Sub pd()
  ch$ = Chr(13) + Chr(10)
  pdnum = 0
  Call cal_bz
  ddd = lgnum
  If (lgnum = 0 Or fmnum = 0) Then
    ppp = MsgBox("当前没有设定灌溉编组！  ", 48, "特别提示")
    pdnum = 1
    Exit Sub
  End If

  For j = 1 To lgnum
    If (num(j) = 0) Then
      ppp = MsgBox("第 " + Str$(j) + " 编组没有阀门号，  " + ch$ + "这是不允许的！", 48, "特别提示")
      pdnum = 1
      Exit Sub
    End If
    For i = 1 To num(j)
      If (data(j, i) = 0) Then
        ppp = MsgBox("第 " + Str$(j) + " 编组中第" + Str$(i) + " 列是空格或0阀门号，  " + ch$ + "这是不允许的！", 48, "特别提示")
        pdnum = 1
        Exit Sub
      End If
      For k = 1 To num(j)
        If (k <> i) Then
          If (filedata(j, k) = filedata(j, i)) Then
            ppp = MsgBox("第 " + Str$(j) + " 编组中第" + Str$(k) + " 列与第" + Str$(i) + "列同号，  " + ch$ + "这是不允许的！", 48, "特别提示")
            pdnum = 1
            Exit Sub
          End If
        End If
      Next k
    Next i
  Next j
  If (timenum = 0) Then
    ppp = MsgBox("没有设定灌溉时间！  ", 48, "特别提示")
    pdnum = 1
    Exit Sub
  End If
  For j = 1 To lgnum
    If (lgsettime(j) = 0) Then
      ppp = MsgBox("第 " + Str$(j) + " 编组未设定时间，  " + ch$ + "这是不允许的！", 48, "特别提示")
      pdnum = 1
      Exit Sub
    End If
  Next j
  If (timenum > lgnum) Then
    ppp = MsgBox("请删除编组之外的时间值！  ", 48, "特别提示")
    pdnum = 1
    Exit Sub
  End If
  If (Option2.value = True And (Val(numText.Text) > lgnum Or Val(numText.Text) = 0)) Then
    ppp = MsgBox("设定的编组号不存在！", 48, "特别提示")
    pdnum = 1
    Exit Sub
  End If
End Sub

Private Sub Cmdsure_Click()
  Call pd
  If (pdnum = 1) Then
    Exit Sub
  End If
  timeadd = 0
  ppp = MsgBox("你确认要使用当前的灌溉编组吗？ ", 65, "特别提示")
  If (ppp = 1) Then
    For j = 1 To lgnum
      Grid1.Row = j
      For i = 1 To num(j)
        Grid1.Col = i
        Grid1.CellForeColor = RGB(0, 0, 0)
      Next i
    Next j
    For j = 1 To 50
      Grid2.Row = j
      For i = 1 To 4
        Grid2.Col = i
        Grid2.Text = ""
      Next i
    Next j
    For j = 1 To lgnum
      Grid2.Row = j
      For i = 1 To 2
        Grid2.Col = i
        Grid2.Text = lgsettime(j)
      Next i
      lgbacktime(j) = lgsettime(j)
      Grid2.Col = 3
      Grid2.Text = ""
      Grid2.Col = 4
      Grid2.Text = ""
    Next j
    For k = 1 To lgnum
      Grid2.Col = 1
      Grid2.Row = k
      timeadd = timeadd + Val(Grid2.Text)
      timeText.Text = timeadd
      filedForm.Ladd.Caption = timeadd
    Next k
    For k = 1 To 42
      filedForm.Shape3(k).FillColor = QBColor(7)
      TeamForm2.Check1(k - 1).ForeColor = QBColor(0)
      TeamForm2.Check1(k - 1).value = 0
    Next k

    For k = 0 To 6
      filedForm.Shape5(k).FillColor = QBColor(14)
    Next k
    If Cauto.value = 0 And Option1.value = True Then
      ggtype = 1
      hnum = 1
      Cmdstart.Enabled = True
    End If
    If Cauto.value = 0 And Option2.value = True Then
      ggtype = 2
      hnum = Val(numText.Text)
      Cmdstart.Enabled = True
    End If
    If Cauto.value = 1 And Option1.value = True Then
      ggtype = 11
      hnum = 1
      Cmdstart.Enabled = False
      'Call Auto_gg
    End If
    If Cauto.value = 1 And Option2.value = True Then
      ggtype = 22
      hnum = Val(numText.Text)
      Cmdstart.Enabled = False
      'Call Auto_gg
    End If
    Frame1.Enabled = False
    Frame2.Enabled = False
    Cmdload.Enabled = False
    Cmdsave.Enabled = False
    Cmdnew.Enabled = False
    Cmdsure.Enabled = False
    numText.Enabled = False
    Cmdtime.Enabled = False
    timeText.Enabled = False
    Cmddl.Enabled = True
  End If
End Sub

Private Sub Cmdstart_Click()
  Cmdstart.Enabled = False