frmrun.frm
来自「16 relay output channels and 16 isolated」· FRM 代码 · 共 484 行
FRM
484 行
VERSION 5.00
Begin VB.Form frmRun
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "Digital Output Demo"
ClientHeight = 2160
ClientLeft = 1935
ClientTop = 1500
ClientWidth = 4605
FillColor = &H00FF0000&
FillStyle = 3 'Vertical Line
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
LinkTopic = "Form1"
MaxButton = 0 'False
PaletteMode = 1 'UseZOrder
ScaleHeight = 2160
ScaleWidth = 4605
Begin VB.Frame frmButton
Appearance = 0 'Flat
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 1095
Left = 240
TabIndex = 1
Top = 240
Width = 4215
Begin VB.CommandButton cmdBit
Appearance = 0 'Flat
BackColor = &H80000005&
Height = 375
Index = 7
Left = 120
TabIndex = 17
TabStop = 0 'False
Top = 240
Width = 375
End
Begin VB.CommandButton cmdBit
Appearance = 0 'Flat
BackColor = &H80000005&
Height = 375
Index = 6
Left = 600
TabIndex = 16
TabStop = 0 'False
Top = 240
Width = 375
End
Begin VB.CommandButton cmdBit
Height = 375
Index = 5
Left = 1080
TabIndex = 15
TabStop = 0 'False
Top = 240
Width = 375
End
Begin VB.CommandButton cmdBit
Appearance = 0 'Flat
BackColor = &H80000005&
Height = 375
Index = 4
Left = 1560
TabIndex = 14
TabStop = 0 'False
Top = 240
Width = 375
End
Begin VB.CommandButton cmdBit
Appearance = 0 'Flat
BackColor = &H80000005&
Height = 375
Index = 3
Left = 2160
TabIndex = 13
TabStop = 0 'False
Top = 240
Width = 375
End
Begin VB.CommandButton cmdBit
Appearance = 0 'Flat
BackColor = &H80000005&
Height = 375
Index = 2
Left = 2640
TabIndex = 12
TabStop = 0 'False
Top = 240
Width = 375
End
Begin VB.CommandButton cmdBit
Appearance = 0 'Flat
BackColor = &H80000005&
Height = 375
Index = 1
Left = 3120
TabIndex = 11
TabStop = 0 'False
Top = 240
Width = 375
End
Begin VB.PictureBox pictureBit
Appearance = 0 'Flat
BackColor = &H00FF0000&
BorderStyle = 0 'None
FillColor = &H00FF0000&
FillStyle = 0 'Solid
ForeColor = &H00FF0000&
Height = 375
Index = 7
Left = 120
ScaleHeight = 375
ScaleWidth = 375
TabIndex = 10
TabStop = 0 'False
Top = 240
Visible = 0 'False
Width = 375
End
Begin VB.PictureBox pictureBit
Appearance = 0 'Flat
BackColor = &H00FF0000&
BorderStyle = 0 'None
FillColor = &H00FF0000&
ForeColor = &H80000008&
Height = 375
Index = 6
Left = 600
ScaleHeight = 375
ScaleWidth = 375
TabIndex = 9
Top = 240
Visible = 0 'False
Width = 375
End
Begin VB.PictureBox pictureBit
Appearance = 0 'Flat
BackColor = &H00FF0000&
BorderStyle = 0 'None
FillColor = &H00FF0000&
ForeColor = &H80000008&
Height = 375
Index = 5
Left = 1080
ScaleHeight = 375
ScaleWidth = 375
TabIndex = 8
TabStop = 0 'False
Top = 240
Visible = 0 'False
Width = 375
End
Begin VB.PictureBox pictureBit
Appearance = 0 'Flat
BackColor = &H00FF0005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 375
Index = 4
Left = 1560
ScaleHeight = 375
ScaleWidth = 375
TabIndex = 7
TabStop = 0 'False
Top = 240
Visible = 0 'False
Width = 375
End
Begin VB.PictureBox pictureBit
Appearance = 0 'Flat
BackColor = &H00FF0005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 375
Index = 3
Left = 2160
ScaleHeight = 375
ScaleWidth = 375
TabIndex = 6
TabStop = 0 'False
Top = 240
Visible = 0 'False
Width = 375
End
Begin VB.PictureBox pictureBit
Appearance = 0 'Flat
BackColor = &H00FF0005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 375
Index = 2
Left = 2640
ScaleHeight = 375
ScaleWidth = 375
TabIndex = 5
TabStop = 0 'False
Top = 240
Visible = 0 'False
Width = 375
End
Begin VB.PictureBox pictureBit
Appearance = 0 'Flat
BackColor = &H00FF0000&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 375
Index = 1
Left = 3120
ScaleHeight = 375
ScaleWidth = 375
TabIndex = 4
TabStop = 0 'False
Top = 240
Visible = 0 'False
Width = 375
End
Begin VB.CommandButton cmdBit
Appearance = 0 'Flat
BackColor = &H80000005&
Height = 375
Index = 0
Left = 3600
TabIndex = 3
TabStop = 0 'False
Top = 240
Width = 375
End
Begin VB.PictureBox pictureBit
Appearance = 0 'Flat
BackColor = &H00FF0005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 375
Index = 0
Left = 3600
ScaleHeight = 375
ScaleWidth = 375
TabIndex = 2
TabStop = 0 'False
Top = 240
Visible = 0 'False
Width = 375
End
Begin VB.Label labBit
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "bit7"
ForeColor = &H80000008&
Height = 255
Index = 7
Left = 120
TabIndex = 19
Top = 720
Width = 375
End
Begin VB.Label labBit
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "bit6"
ForeColor = &H80000008&
Height = 255
Index = 6
Left = 600
TabIndex = 25
Top = 720
Width = 375
End
Begin VB.Label labBit
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "bit5"
ForeColor = &H80000008&
Height = 255
Index = 5
Left = 1080
TabIndex = 24
Top = 720
Width = 375
End
Begin VB.Label labBit
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "bit4"
ForeColor = &H80000008&
Height = 255
Index = 4
Left = 1560
TabIndex = 23
Top = 720
Width = 375
End
Begin VB.Label labBit
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "bit3"
ForeColor = &H80000008&
Height = 255
Index = 3
Left = 2160
TabIndex = 22
Top = 720
Width = 375
End
Begin VB.Label labBit
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "bit2"
ForeColor = &H80000008&
Height = 255
Index = 2
Left = 2640
TabIndex = 21
Top = 720
Width = 375
End
Begin VB.Label labBit
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "bit1"
ForeColor = &H80000008&
Height = 255
Index = 1
Left = 3120
TabIndex = 20
Top = 720
Width = 375
End
Begin VB.Label labBit
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "bit0"
ForeColor = &H80000008&
Height = 255
Index = 0
Left = 3600
TabIndex = 18
Top = 720
Width = 375
End
End
Begin VB.CommandButton cmdExit
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "E&xit"
Height = 495
Left = 1560
TabIndex = 0
Top = 1560
Width = 1455
End
End
Attribute VB_Name = "frmRun"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Function DoBit(bit As Integer) As Integer
Dim i As Integer
DoBit = 1
If bit >= 1 Then
For i = 1 To bit
DoBit = DoBit * 2
Next i
End If
End Function
Private Sub cmdBit_Click(Index As Integer)
Dim i As Integer
cmdBit(Index).Visible = False
pictureBit(Index).Visible = True
DoValue = 0
For i = 0 To 7
If (pictureBit(i).Visible = True) Then
DoValue = DoValue + DoBit(i)
End If
Next i
lpDioWritePort.Port = lpDioPortMode.Port
lpDioWritePort.Mask = 255
lpDioWritePort.state = DoValue
ErrCde = DRV_DioWritePortByte(DeviceHandle, lpDioWritePort)
If (ErrCde <> 0) Then
DRV_GetErrorMessage ErrCde, szErrMsg
Response = MsgBox(szszErrMsg, vbOKOnly, "Error!!")
Exit Sub
End If
End Sub
Private Sub cmdExit_Click()
frmRun.Hide
frmDevSel.Show
frmDevSel.cmdExit.SetFocus
End Sub
Private Sub Form_Activate()
Dim value As Long
Dim BitStatus As Integer
Dim i As Integer
lpDioGetCurrentDoByte.Port = frmDevSel.lstChannel.ListIndex
lpDioGetCurrentDoByte.value = DRV_GetAddress(value)
ErrCde = DRV_DioGetCurrentDOByte(DeviceHandle, lpDioGetCurrentDoByte)
If (ErrCde <> 0) Then
DRV_GetErrorMessage ErrCde, szszErrMsg
Response = MsgBox(szszErrMsg, vbOKOnly, "Error!!")
Exit Sub
End If
i = 0
While (i < 8)
BitStatus = 2 ^ i
If ((value And BitStatus) > 0) Then
pictureBit(i).Visible = True
cmdBit(i).Visible = False
Else
pictureBit(i).Visible = False
cmdBit(i).Visible = True
End If
i = i + 1
Wend
End Sub
Private Sub Form_Unload(Cancel As Integer)
frmDevSel.Show
End Sub
Private Sub pictureBit_Click(Index As Integer)
Dim i As Integer
cmdBit(Index).Visible = True
pictureBit(Index).Visible = False
DoValue = 0
For i = 0 To 7
If (pictureBit(i).Visible = True) Then
DoValue = DoValue + DoBit(i)
End If
Next i
lpDioWritePort.Port = lpDioPortMode.Port
lpDioWritePort.Mask = 255
lpDioWritePort.state = DoValue
ErrCde = DRV_DioWritePortByte(DeviceHandle, lpDioWritePort)
If (ErrCde <> 0) Then
DRV_GetErrorMessage ErrCde, szszErrMsg
Response = MsgBox(szszErrMsg, vbOKOnly, "Error!!")
Exit Sub
End If
End Sub
Private Sub Timer1_Timer()
list1.Clear
For i = 0 To 7
If cmdBit(Index).Visible = True Then
list1.AddItem Str(i)
End If
Next
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?