frmrun.frm
来自「16 relay output channels and 16 isolated」· FRM 代码 · 共 401 行
FRM
401 行
VERSION 5.00
Begin VB.Form frmRun
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "Digital Input Demo"
ClientHeight = 2940
ClientLeft = 2988
ClientTop = 1692
ClientWidth = 3684
BeginProperty Font
Name = "MS Sans Serif"
Size = 7.8
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
LinkTopic = "Form1"
MaxButton = 0 'False
PaletteMode = 1 'UseZOrder
ScaleHeight = 2940
ScaleWidth = 3684
Begin VB.Frame frmSampleRate
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Sampling Rate"
ForeColor = &H80000008&
Height = 1095
Left = 240
TabIndex = 5
Top = 1080
Width = 3255
Begin VB.HScrollBar hscrlFreq
Height = 375
LargeChange = 10
Left = 120
Max = 100
TabIndex = 3
Top = 360
Value = 10
Width = 3015
End
Begin VB.Label labFreqHigh
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "10 (time/s)"
ForeColor = &H80000008&
Height = 255
Left = 2160
TabIndex = 1
Top = 720
Width = 975
End
Begin VB.Label labFrequencyLow
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "0 (Stop)"
ForeColor = &H80000008&
Height = 255
Left = 120
TabIndex = 2
Top = 720
Width = 855
End
End
Begin VB.Timer tmrRead
Left = 1680
Top = 2160
End
Begin VB.CommandButton cmdRead
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "&Read one data"
Height = 495
Left = 2040
TabIndex = 4
Top = 2280
Width = 1455
End
Begin VB.CommandButton cmdExit
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "E&xit"
Height = 495
Left = 240
TabIndex = 0
Top = 2280
Width = 1455
End
Begin VB.Label labBit
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "7"
ForeColor = &H80000008&
Height = 255
Index = 7
Left = 360
TabIndex = 7
Top = 600
Width = 255
End
Begin VB.Label labBit
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "6"
ForeColor = &H80000008&
Height = 255
Index = 6
Left = 720
TabIndex = 8
Top = 600
Width = 255
End
Begin VB.Label labBit
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "5"
ForeColor = &H80000008&
Height = 255
Index = 5
Left = 1080
TabIndex = 13
Top = 600
Width = 255
End
Begin VB.Label labBit
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "4"
ForeColor = &H80000008&
Height = 255
Index = 4
Left = 1440
TabIndex = 12
Top = 600
Width = 255
End
Begin VB.Label labBit
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "3"
ForeColor = &H80000008&
Height = 255
Index = 3
Left = 2040
TabIndex = 11
Top = 600
Width = 255
End
Begin VB.Label labBit
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "2"
ForeColor = &H80000008&
Height = 255
Index = 2
Left = 2400
TabIndex = 10
Top = 600
Width = 255
End
Begin VB.Label labBit
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "1"
ForeColor = &H80000008&
Height = 255
Index = 1
Left = 2760
TabIndex = 9
Top = 600
Width = 255
End
Begin VB.Label labBit
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "0"
ForeColor = &H80000008&
Height = 255
Index = 0
Left = 3120
TabIndex = 6
Top = 600
Width = 255
End
Begin VB.Shape Shape1
Height = 735
Left = 240
Top = 240
Width = 3255
End
Begin VB.Shape shapLed
BorderColor = &H000000FF&
BorderStyle = 0 'Transparent
FillColor = &H00808080&
FillStyle = 0 'Solid
Height = 255
Index = 7
Left = 360
Shape = 3 'Circle
Top = 360
Width = 255
End
Begin VB.Shape shapLed
BorderColor = &H000000FF&
BorderStyle = 0 'Transparent
FillColor = &H00808080&
FillStyle = 0 'Solid
Height = 255
Index = 6
Left = 720
Shape = 3 'Circle
Top = 360
Width = 255
End
Begin VB.Shape shapLed
BorderColor = &H000000FF&
BorderStyle = 0 'Transparent
FillColor = &H00808080&
FillStyle = 0 'Solid
Height = 255
Index = 5
Left = 1080
Shape = 3 'Circle
Top = 360
Width = 255
End
Begin VB.Shape shapLed
BorderColor = &H000000FF&
BorderStyle = 0 'Transparent
FillColor = &H00808080&
FillStyle = 0 'Solid
Height = 255
Index = 4
Left = 1440
Shape = 3 'Circle
Top = 360
Width = 255
End
Begin VB.Shape shapLed
BorderColor = &H000000FF&
BorderStyle = 0 'Transparent
FillColor = &H00808080&
FillStyle = 0 'Solid
Height = 255
Index = 3
Left = 2040
Shape = 3 'Circle
Top = 360
Width = 255
End
Begin VB.Shape shapLed
BorderColor = &H000000FF&
BorderStyle = 0 'Transparent
FillColor = &H00808080&
FillStyle = 0 'Solid
Height = 255
Index = 2
Left = 2400
Shape = 3 'Circle
Top = 360
Width = 255
End
Begin VB.Shape shapLed
BorderColor = &H000000FF&
BorderStyle = 0 'Transparent
FillColor = &H00808080&
FillStyle = 0 'Solid
Height = 255
Index = 1
Left = 2760
Shape = 3 'Circle
Top = 360
Width = 255
End
Begin VB.Shape shapLed
BorderColor = &H000000FF&
BorderStyle = 0 'Transparent
FillColor = &H00808080&
FillStyle = 0 'Solid
Height = 255
Index = 0
Left = 3120
Shape = 3 'Circle
Top = 360
Width = 255
End
End
Attribute VB_Name = "frmRun"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim iPreVal As Integer
Dim DiValue As Integer
Function DiBit(bit As Integer)
Dim i As Integer
DiBit = 1
If bit > 1 Then
For i = 1 To bit
DiBit = DiBit * 2
Next i
End If
End Function
Private Sub cmdExit_Click()
frmRun.Hide
frmDevSel.Show
frmDevSel.cmdExit.SetFocus
End Sub
Private Sub cmdRead_Click()
Dim DiValue As Integer
Dim TempBit As Integer
tmrRead.Enabled = False
lpDioReadPort.value = DRV_GetAddress(DiValue)
ErrCde = DRV_DioReadPortByte(DeviceHandle, lpDioReadPort)
If (ErrCde <> 0) Then
DRV_GetErrorMessage ErrCde, szErrMsg
Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
Exit Sub
End If
If DiValue > 0 Then
UpdateLed (DiValue)
End If
End Sub
Private Sub Form_Load()
hscrlFreq_Change
End Sub
Private Sub Form_Unload(Cancel As Integer)
frmDevSel.Show
End Sub
Private Sub hscrlFreq_Change()
If hscrlFreq.value = 0 Then
tmrRead.Interval = 0
Else
tmrRead.Interval = 10000 / hscrlFreq.value
End If
tmrRead.Enabled = True
End Sub
Private Sub tmrRead_Timer()
Dim TempBit As Integer
lpDioReadPort.Port = lpDioPortMode.Port
lpDioReadPort.value = DRV_GetAddress(DiValue)
ErrCde = DRV_DioReadPortByte(DeviceHandle, lpDioReadPort)
If (ErrCde <> 0) Then
DRV_GetErrorMessage ErrCde, szErrMsg
Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
Exit Sub
End If
UpdateLed (DiValue)
End Sub
Private Sub UpdateLed(iValue As Integer)
Dim i, iShift As Integer
iShift = 1
'Check every Digtial data bit
For i = 0 To 7
'If the bit is different from previous value then
If (iValue And iShift) <> (iPreVal And iShift) Then
'Check, it is change to 1 or 0
If (iValue And iShift) = iShift Then
'It changes to 1, light the LED
shapLed(i).FillColor = QBColor(12)
Else
'It changes to 0, turn off the LED
shapLed(i).FillColor = QBColor(8)
End If
End If
'Check next bit
iShift = iShift * 2
Next
'Reserve current Digital value
iPreVal = iValue
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?