⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 setform.frm

📁 某机械工程学院的毕业设计以及毕业论文 非常参考价值
💻 FRM
📖 第 1 页 / 共 3 页
字号:
  texttype = 1
  griddata = ""
  idnumText.Text = ""
End Sub

Private Sub idnumText_Change()
  If Not IsNumeric(idnumText.Text) Then
    idnumText.Text = ""
  End If
End Sub

Private Sub fmnumText_Click()
  texttype = 2
  griddata = ""
  fmnumText.Text = ""
End Sub

Private Sub fmnumText_Change()
  If Not IsNumeric(fmnumText.Text) Then
    fmnumText.Text = ""
  End If
End Sub

Private Sub IDText_Click()
  texttype = 3
  griddata = ""
  IDText.Text = ""
End Sub

Private Sub IDText_Change()
  If Not IsNumeric(IDText.Text) Then
    IDText.Text = ""
  End If
End Sub

Private Sub numText_Click()
  texttype = 4
  griddata = ""
  numText.Text = ""
End Sub

Private Sub numText_change()
  If Not IsNumeric(numText.Text) Then
    numText.Text = ""
  End If
End Sub

Private Sub Grid1_Click()
  texttype = 5
  griddata = ""
  Grid1.Text = ""
End Sub

Private Sub Command1_Click()
  Grid1.Text = Tname.Text
End Sub

Private Sub C0_Click()
  griddata = griddata + "0"
  Call fill_grid
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()
  If (texttype = 1) Then
    idnumText.Text = Val(griddata)
  End If
  
  If (texttype = 2) Then
    fmnumText.Text = Val(griddata)
  End If
  
  If (texttype = 3) Then
    IDText.Text = Val(griddata)
  End If
  
  If (texttype = 4) Then
    numText.Text = Val(griddata)
  End If
  
  If texttype = 5 Then
    Grid1.Text = griddata
    If (Val(griddata) > fmn) Then
      ppp = MsgBox("设置的阀门编号不存在" + "(1-" + Str$(fmn) + ")!    ", 48, "特别提示")
      Grid1.Text = "": griddata = ""
      Exit Sub
    End If
  End If
End Sub

Private Sub Cmdset1_Click()
  If Val(idnumText.Text) = 0 Then
    ppp = MsgBox("必须设置RTU总数!  ", 48, "特别提示")
    idnumText.Text = ""
    Exit Sub
  End If
  
  If Val(fmnumText.Text) = 0 Then
    ppp = MsgBox("必须设置阀门总数!  ", 48, "特别提示")
    fmnumText.Text = ""
    Exit Sub
  End If
  
  If Val(fmnumText.Text) > getnum Then
    ppp = MsgBox("设置阀门总数不能大于" + Str$(getnum) + "!  ", 48, "特别提示")
    fmnumText.Text = ""
    Exit Sub
  End If
  
  If Val(fmnumText.Text) < Val(idnumText.Text) Then
    ppp = MsgBox("设置的阀门总数必须超过RTU总数!  ", 48, "特别提示")
    idnumText.Text = "": fmnumText.Text = ""
    Exit Sub
  Else
    idn = Val(idnumText.Text)
    fmn = Val(fmnumText.Text)
    Call tabinit1
    Frame3.Enabled = False
    Frame2.Enabled = True
  End If
End Sub

Private Sub Cmdset2_Click()
  If Val(IDText.Text) <= 0 Then
    ppp = MsgBox("必须设置RTU号!  ", 48, "特别提示")
    IDText.Text = ""
    Exit Sub
  End If
  
  If Val(numText.Text) <= 0 Then
    ppp = MsgBox("必须设置阀门数!  ", 48, "特别提示")
    numText.Text = ""
    Exit Sub
  End If
  
  For i = 1 To bk
    If IDText.Text = idnum(i) Then
      ppp = MsgBox("设置的RTU号不能重复!  ", 48, "特别提示")
      IDText.Text = "": numText.Text = ""
      Exit Sub
    End If
  Next i
  If kkk + Val(numText.Text) > fmn Then
    ppp = MsgBox("设置的阀门数超过总数!  ", 48, "特别提示")
    numText.Text = ""
    Exit Sub
  End If
  
     For k = 1 To getnum
       If IDText.Text = Trim$(getaddr(k, 1)) Then
         For j = 1 To Val(numText.Text)
           fileaddr0(j, 1) = Trim$(getaddr(k, 2))
         Next j
       End If
       If numText.Text = Trim$(getaddr(k, 1)) Then
         For j = 1 To Val(numText.Text)
           fileaddr0(j, 2) = Trim$(getaddr(j, 2))
         Next j
       End If
     Next k
     
     For j = 1 To Val(numText.Text)
       Grid1.Row = j + kkk
       For i = 1 To 2
         Grid1.Col = i
         Grid1.Text = fileaddr0(j, i)
       Next i
     Next j
        
   kkk = kkk + Val(numText.Text)
   idnum(bk) = IDText.Text
   bk = bk + 1
   IDText.Text = ""
   numText.Text = ""
   If bk > idn Then
     Frame2.Enabled = False
     If kkk < fmn Then
       ppp = MsgBox("所有阀门都必须编址!  ", 48, "特别提示")
     End If
   End If
End Sub

Private Sub Cmdsure_Click()
  On Error GoTo hh
  ch$ = Chr(13) + Chr(10)
  For j = 1 To kkk
    Grid1.Row = j
    For i = 1 To 4
      Grid1.Col = i
      fileaddr(j, i) = Grid1.Text
    Next i
  Next j
  
  For j = 1 To kkk
    If Val(fileaddr(j, 3)) = 0 Then
      ppp = MsgBox("设置的第" + Str$(j) + "行阀门号为0或空号," + ch$ + "这是不允许的!", 48, "特别提示")
      Exit Sub
    End If
    For k = 1 To kkk
      If (k <> j) Then
        If (fileaddr(j, 3) = fileaddr(k, 3)) Then
          ppp = MsgBox("设置的第" + Str$(j) + "行阀门号与第" + Str$(k) + "行阀门号重复" + ch$ + "这是不允许的!", 48, "特别提示")
          Exit Sub
        End If
      End If
    Next k
    If Val(fileaddr(j, 2)) = 0 Or Val(fileaddr(j, 2)) > 8 Then
      ppp = MsgBox("设置的第" + Str$(j) + "行RTU端口号不存在," + ch$ + "这是不允许的!", 48, "特别提示")
      Exit Sub
    End If
    If fileaddr(j, 4) = "" Then
      ppp = MsgBox("设置的第" + Str$(j) + "行承包户为空," + ch$ + "这是不允许的!", 48, "特别提示")
      Exit Sub
    End If
  Next j

  ch$ = Chr(13) + Chr(10)
  msg1$ = "你确信要重新设定阀门地址吗?       "
  msg2$ = "它将覆盖原有编码地址!"
  msg$ = msg1$ + ch$ + msg2$
  ppp = MsgBox(msg$, 65, "特别提示")
  If (ppp = 1) Then
    F3 = FreeFile
    fname2b = App.Path & "\data\idset.txt"
    'fname2b = WinDir & "\" & "\system32\" & "idset.txt"
    Open fname2b For Output As #F3
    For j = 1 To kkk
      Print #F3, fileaddr(j, 3), fileaddr(j, 1), fileaddr(j, 2), fileaddr(j, 4)
    Next j
    Close #F3
    Call open_addr
  
    Frame2.Enabled = False
    Frame3.Enabled = False
  End If
hh: Exit Sub
End Sub

Private Sub Cmdclear_Click()
  Frame2.Enabled = False
  Frame3.Enabled = True
  
  IDText.Enabled = True
  numText.Enabled = True
  
  For j = 1 To kkk
    Grid1.Row = j
    For i = 1 To 4
      Grid1.Col = i
      Grid1.Text = ""
    Next i
  Next j
  For i = 0 To 99
    idnum(i) = ""
  Next i
  kkk = 0: bk = 1
  fmn = 0: idn = 0
  idnumText.Text = "": fmnumText.Text = ""
  IDText.Text = "": numText.Text = ""
End Sub

Public Sub get_addrnum()
  Dim datastring(3000) As String
  Dim l As Long
  Dim a As String, b As String, X As String
  On Error GoTo hh
  F1% = FreeFile
  b = ""
  getnum = 0
  Close
  fname2a = App.Path & "\data\addrnum.txt"
  'fname2a = WinDir & "\" & "\system32\" & "addrnum.txt"
  Open fname2a 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(getnum) = b
    getnum = getnum + 1
  Loop
  Close #F1%

  For i = 0 To getnum - 1
    getaddr(i + 1, 1) = Mid$(datastring(i), 1, 14)
    getaddr(i + 1, 2) = Mid$(datastring(i), 15, 14)
  Next i
hh: Exit Sub
End Sub

Private Sub Cclose_Click()
  Unload Me
  filedForm.Show
End Sub

Private Sub Cmdbz_Click()
  TeamForm.Show
End Sub

Private Sub Cmdzt_Click()
  filedForm.Show
End Sub

Private Sub Cmdxx_Click()
  xxForm.Show
End Sub

Private Sub Cdata_Click()
  HisForm.Show
  Call HisForm.get_cdata
End Sub

Private Sub Cmdzn_Click()
  GuideForm.Show
End Sub

Private Sub Cmdquit_Click()
  commandbz = 3
  PassForm.Show
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -