📄 dioform.frm
字号:
Left = 3840
TabIndex = 16
Top = 240
Width = 735
Begin VB.Label diodata
AutoSize = -1 'True
Caption = "关"
BeginProperty Font
Name = "System"
Size = 24
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 480
Index = 5
Left = 120
TabIndex = 17
Top = 240
Width = 480
End
End
Begin VB.Frame Frame2
Caption = "4路"
Height = 855
Index = 3
Left = 2400
TabIndex = 14
Top = 240
Width = 735
Begin VB.Label diodata
AutoSize = -1 'True
Caption = "关"
BeginProperty Font
Name = "System"
Size = 24
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 480
Index = 3
Left = 120
TabIndex = 15
Top = 240
Width = 480
End
End
Begin VB.Frame Frame2
Caption = "3路"
Height = 855
Index = 2
Left = 1680
TabIndex = 12
Top = 240
Width = 735
Begin VB.Label diodata
AutoSize = -1 'True
Caption = "关"
BeginProperty Font
Name = "System"
Size = 24
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 480
Index = 2
Left = 120
TabIndex = 13
Top = 240
Width = 480
End
End
Begin VB.Frame Frame2
Caption = "1路"
Height = 855
Index = 0
Left = 240
TabIndex = 11
Top = 240
Width = 735
Begin VB.Label diodata
AutoSize = -1 'True
Caption = "关"
BeginProperty Font
Name = "System"
Size = 24
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 480
Index = 0
Left = 120
TabIndex = 8
Top = 240
Width = 480
End
End
Begin VB.Frame Frame2
Caption = "2路"
Height = 855
Index = 1
Left = 960
TabIndex = 10
Top = 240
Width = 735
Begin VB.Label diodata
AutoSize = -1 'True
Caption = "关"
BeginProperty Font
Name = "System"
Size = 24
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 480
Index = 1
Left = 120
TabIndex = 9
Top = 240
Width = 480
End
End
Begin VB.CommandButton Exit
Cancel = -1 'True
Caption = "返 回"
Default = -1 'True
Height = 495
Left = 4560
TabIndex = 7
Top = 3645
Width = 1455
End
Begin VB.CommandButton HelpCom
Caption = "操作帮助"
Height = 495
Left = 4545
TabIndex = 6
Top = 2925
Width = 1455
End
Begin VB.CommandButton DoCom
Caption = "确定输出"
Height = 495
Left = 4560
TabIndex = 5
Top = 2295
Width = 1455
End
Begin VB.Frame Frame1
Caption = "开关量显示区"
ForeColor = &H00000000&
Height = 2085
Left = 120
TabIndex = 0
Top = 0
Width = 6015
End
End
Attribute VB_Name = "DioForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'did(2)为DI输入数据
Dim did(2) As Byte
'diod(2)为DO输出数据
Dim diod(2) As Byte
'diofs为DIO方式
Dim diofs As Boolean '=true为DIO =false为DI
'oldkey为旧键值
Dim oldkey As Integer
'kmin,ksec为旧键的时间，分为分钟，秒钟
Dim kmin, ksec
'改变DO量显示区函数
Private Sub diodata_Click(Index As Integer)
'判断是否为DO方式
If diofs = True Then
' 改变开关量显示区
If diodata(Index).Caption = "关" Then
diodata(Index).ForeColor = RGB(255, 0, 0)
diodata(Index).Caption = "开"
Else
diodata(Index).ForeColor = RGB(0, 0, 255)
diodata(Index).Caption = "关"
End If
Dim X(16) As Integer
For i = 0 To 15
If diodata(i).Caption = "开" Then
X(i) = 1
Else
X(i) = 0
End If
Next i
diod(0) = 0
diod(1) = 0
For i = 0 To 7
diod(0) = X(i) * 2 ^ i + diod(0)
Next i
For i = 8 To 15
diod(1) = X(i) * 2 ^ (i - 8) + diod(1)
Next i
doedit(0) = Hex(diod(0))
doedit(1) = Hex(diod(1))
End If
End Sub
'DI输入定时检测函数
Private Sub DioTimer_Timer()
'判断是否是DI方式
If diofs = False Then
'调用DI函数，取出did数据
' Call pc7484_di(did(0), Port, Delay)
'hplx = 0
'hplx = pci7483check(0, 0, False)
did(0) = pci7483di(hplx, False, 0)
did(1) = pci7483di(hplx, False, 1)
' If hplx <> 1 Then
'hplx = pci7483close(hplx)
'End If
'显示到开关量显示区
For i = 0 To 1
X = did(i)
For j = 0 To 7
'判断每一路是否有数据
If (X Mod 2 ^ (j + 1)) = 2 ^ j Then
X = X - 2 ^ j
diodata(i * 8 + j).ForeColor = RGB(255, 0, 0)
diodata(i * 8 + j).Caption = "开"
Else
diodata(i * 8 + j).ForeColor = RGB(0, 0, 255)
diodata(i * 8 + j).Caption = "关"
End If
Next j
Next i
End If
End Sub
'DO输出函数
Private Sub DoCom_Click()
'根据开关量显示区确定DO转换数据
For i = 0 To 1
X = 0
For j = 0 To 7
If diodata(i * 8 + j).Caption = "开" Then
X = X + 2 ^ j
End If
Next j
diod(i) = X
Next i
X1 = diod(0)
X2 = diod(1)
'hplx = 0
'hplx = pci7483check(0, 0, False)
Call pci7483do(hplx, False, 0, X1)
Call pci7483do(hplx, False, 1, X2)
'If hplx <> 1 Then
'hplx = pci7483close(hplx)
'End If
End Sub
'DO数据编辑函数
Private Sub DoEditCom_Click()
j = 1
For i = 0 To 1
'判断DO输入数据是否为空
If doedit(i) = "" Then
k = MsgBox("DO数据为空，请重新输入，范围在（0--FFH）！", vbQuestion, "DO数据输入")
j = 0
i = 3
Else
k = Val("&h" & doedit(i))
'判断DO输入数据是否有错
If k < 0 Or k > &HFF Then
k = MsgBox("DO数据输入错误，请重新输入，范围在（0--FFH）！", vbQuestion, "DO数据输入")
j = 0
i = 3
End If
End If
Next i
'输入DO数据正确
If j = 1 Then
'根据输入DO数据更新开关量显示区
For i = 0 To 1
X = Val("&h" & doedit(i))
For j = 0 To 7
If (X Mod 2 ^ (j + 1)) = 2 ^ j Then
X = X - 2 ^ j
diodata(i * 8 + j).ForeColor = RGB(255, 0, 0)
diodata(i * 8 + j).Caption = "开"
Else
diodata(i * 8 + j).ForeColor = RGB(0, 0, 255)
diodata(i * 8 + j).Caption = "关"
End If
Next j
Next i
End If
End Sub
Private Sub Exit_Click()
If hplx <> 1 Then
hplx = pci7483close(hplx)
End If
Unload DioForm
End Sub
'检测键盘输入函数
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim keytime
Dim newksec, newkmin
'判断是否为DO输出方式，是否同时按了Alt键，键值是否为数字键
If diofs = True And Shift = 4 And KeyCode > 47 And KeyCode < 58 Then
'取当时时间
mytime = Time
newksec = Second(mytime)
newkmin = Minute(mytime)
'判断当时秒钟是否刚好变小
If newksec < 2 Then
newksec = 60 + newksec
kmin = kmin + 1
End If
'判断是否超过2秒钟,如超时则旧键值为初始值
If newksec > ksec + 2 Or kmin <> newkmin Then oldkey = -1
'判断旧键值是否为初始值
If oldkey = -1 Then
'为初始值，则改变旧键值
If KeyCode > 47 And KeyCode < 51 Then oldkey = KeyCode - 48
Else
'不为初始值,则取数字
Index = oldkey * 10 + KeyCode - 49
'还原旧键值为初始
oldkey = -1
'改变开关量显示区
If Index >= 0 And Index < 24 Then
If diodata(Index).Caption = "关" Then
diodata(Index).ForeColor = RGB(255, 0, 0)
diodata(Index).Caption = "开"
Else
diodata(Index).ForeColor = RGB(0, 0, 255)
diodata(Index).Caption = "关"
End If
End If
End If 'oldkey=-1
'取当时的分钟，秒钟
ksec = Second(mytime)
kmin = Minute(mytime)
End If
End Sub
'开关量测试初始化函数
Private Sub Form_Load()
Dim mytime
mytime = Time
ksec = Second(mytime)
kmin = Minute(mytime)
'设置为DI方式
diofs = False
oldkey = -1
doedit(0) = 0
doedit(1) = 0
DoCom.Enabled = False
DoInput.Enabled = False
'允许DI定时检测
DioTimer.Enabled = True
'执行DI检测函数，更新开关量显示区
hplx = 0
hplx = pci7483check(0, 0, False, 1)
DioTimer_Timer
End Sub
'DI/DO方式设置函数
Private Sub fs_Click(Index As Integer)
'判断改变的方式
If Index = 0 Then
'改变为DI输入方式
If diofs = True Then
k = MsgBox("真想设置为输入方式吗？", vbYesNo + vbSystemModal, "开关量方式设置")
'确认为DI输入方式
If k = vbYes Then
DoInput.Enabled = False
DoCom.Enabled = False
diofs = False
Else
'否认改变则还原DO方式
fs(1).Value = True
End If
End If
Else
'改变为DO输出方式
If diofs = False Then
k = MsgBox("真想设置为输出方式吗？", vbYesNo + vbSystemModal, "开关量方式设置")
'确认为改变为DO输出方式
If k = vbYes Then
DoInput.Enabled = True
DoCom.Enabled = True
diofs = True
Else
'否认改变则还原DI方式
fs(0).Value = True
End If
End If
End If
End Sub
'开关量测试操作帮助函数
Private Sub HelpCom_Click()
DioHelpForm.Show
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -