📄 setform.frm
字号:
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 + -