📄 portio.frm
字号:
Begin VB.Label Label9
Caption = "子地址2："
Height = 255
Left = 3600
TabIndex = 34
Top = 840
Width = 975
End
Begin VB.Label Label6
Caption = "子地址1："
Height = 255
Left = 2040
TabIndex = 33
Top = 840
Width = 975
End
Begin VB.Label Label8
AutoSize = -1 'True
Caption = "应答位状态"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 5040
TabIndex = 11
Top = 1200
Width = 1425
End
Begin VB.Label Label4
Caption = "I2C地址："
Height = 255
Left = 480
TabIndex = 9
Top = 840
Width = 975
End
Begin VB.Label Label3
Alignment = 2 'Center
Caption = "1"
BeginProperty Font
Name = "宋体"
Size = 21.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 360
TabIndex = 7
Top = 6480
Width = 735
End
Begin VB.Label Label2
Alignment = 2 'Center
Caption = "1"
BeginProperty Font
Name = "宋体"
Size = 21.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2280
TabIndex = 6
Top = 6480
Width = 615
End
Begin VB.Shape Shape1
FillColor = &H00808080&
FillStyle = 0 'Solid
Height = 495
Left = 5520
Shape = 3 'Circle
Top = 480
Width = 495
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "并口地址："
Height = 255
Left = 1200
TabIndex = 0
Top = 360
Width = 975
End
End
Attribute VB_Name = "FormMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim ack As Boolean
Dim SendData As String
'设置clk
Sub SetClock(ByVal level)
Dim Value As Byte 'CLK_out = CLK_in
If level = 1 Then
Value = DlPortReadPortUchar(Val(Combo1.Text + 1))
Value = Value Or &H8
DlPortWritePortUchar Val(Combo1.Text + 2), Value
Else
Value = DlPortReadPortUchar(Val(Combo1.Text + 1))
Value = Value And &HF7
DlPortWritePortUchar Val(Combo1.Text + 2), Value
End If
End Sub
'设置dat
Sub SetData(ByVal level)
Dim Value As Byte 'DAT_out=not DAT_in
If level = 1 Then
Value = DlPortReadPortUchar(Val(Combo1.Text + 1))
Value = Value And &H7F
DlPortWritePortUchar Val(Combo1.Text), Value
Else
Value = DlPortReadPortUchar(Val(Combo1.Text + 1))
Value = Value Or &H80
DlPortWritePortUchar Val(Combo1.Text), Value
End If
End Sub
'I2C 启动总线函数
Sub I2C_Start() ' With clock hi, make data go from hi to lo to start transfer
Call SetData(1)
Call SetClock(1)
Call Wait4Clock(1)
Call Wait4Data(1)
Call SetData(0)
Call SetClock(0)
End Sub
'I2C 结束总线函数
Sub I2C_Stop() ' With clock hi, make data go from lo to hi to end transfer
Call SetData(0)
Call SetClock(1)
Call Wait4Clock(1)
Call SetData(1)
End Sub
'I2C 字节发送函数
Sub ByteOut(ByVal byteval)
Dim i
For i = 7 To 0 Step -1 ' same as left shift, send msb data first
If Val(byteval) >= 2 ^ i Then
Call SetData(1)
byteval = byteval - 2 ^ i
Label7(i).Caption = 1
Else
Call SetData(0)
Label7(i).Caption = 0
End If
Call SetClock(1)
Call Wait4Clock(1)
Call SetClock(0)
Next
Call SetData(1) '发送完8位后释放总线准备接收应答位
Call Wait4Data(1)
Call SetClock(1)
Call Wait4Clock(1)
If (ReadData() = 1) Then ' data is hi - no ACK
ack = False
Shape1.FillColor = &H808080 'Grey
Else
ack = True
Shape1.FillColor = &HFF00& 'green
End If
Call SetClock(0)
End Sub
'I2C 字节接收函数
Sub ByteIn(ByRef byteval)
Dim i, databit
byteval = 0
Call SetData(1)
For i = 7 To 0 Step -1 ' same as left shift, read msb data first
Call SetClock(0)
Call SetClock(1)
Call Wait4Clock(1)
If (ReadData() = 1) Then ' data is hi
byteval = byteval + 2 ^ i
End If
Next
Call SetData(1)
End Sub
'I2C 获取应答位函数
Sub GetACK(ByRef ack_light) ' during 9th clk pulse, data line is pulled low signalling ACK
Dim tf, databit
Call SetData(1)
Call SetClock(0)
Call SetClock(1)
Call SetData(1)
Call Wait4Clock(1)
If (ReadData() = 1) Then ' data is hi - no ACK
Shape1.FillColor = &H808080 'Grey
Else
Shape1.FillColor = &HFF00& 'green
End If
Call SetClock(0)
End Sub
'I2C 发送应答位函数
Sub DoACK(ByVal ack_val)
Call SetClock(0)
Call SetData(ack_val)
Call SetClock(1)
Call SetClock(0)
End Sub
Sub Wait4Clock(ByVal level)
Dim i
i = 10 ' arbitrary delay
While i > 0
If ReadClock() = level Then
i = 0
Else
i = i - 1
End If
Wend
End Sub
Sub Wait4Data(ByVal level)
Dim i
i = 10 ' arbitrary delay
While i > 0
If ReadData() = level Then
i = 0
Else
i = i - 1
End If
Wend
End Sub
Function ReadData()
Dim Value As Byte
Value = DlPortReadPortUchar(Val(Combo1.Text + 1))
If (Value And &H80) Then
ReadData = 1 ' data lo
Else
ReadData = 0 ' data hi
End If
End Function
Function ReadClock()
Dim Value As Byte
Value = DlPortReadPortUchar(Val(Combo1.Text + 1))
If (Value And &H8) Then
ReadClock = 1
Else
ReadClock = 0
End If
End Function
Private Sub Command1_Click()
Call I2C_Start
Call ByteOut(Text1.Text) ' send addr
Call ByteOut(Text2.Text) ' send sub addr H
Call ByteOut(Text3.Text) ' send sub addr L
Call ByteOut("&H" & SendData) ' send data
Call I2C_Stop
End Sub
Private Sub Command2_Click()
Call I2C_Start
Call I2C_Stop
End Sub
Private Sub Command3_Click(Index As Integer)
If (Label7(Index).Caption = 1) Then
Label7(Index).Caption = 0
Else
Label7(Index).Caption = 1
End If
SendData = 2 ^ 7 * Label7(7) + 2 ^ 6 * Label7(6) + 2 ^ 5 * Label7(5) + 2 ^ 4 * Label7(4)
SendData = SendData + 2 ^ 3 * Label7(3) + 2 ^ 2 * Label7(2) + 2 ^ 1 * Label7(1) + 2 ^ 0 * Label7(0)
SendData = Hex(SendData)
Label5.Caption = "&&H" & SendData
End Sub
Private Sub Form_Load()
Left = (Screen.Width - Width) / 2
Top = (Screen.Height - Height) / 2
SendData = 0
Combo1.AddItem ("&H378")
Combo1.AddItem ("&H3BC")
Combo1.AddItem ("&H278")
End Sub
Private Sub read_Click()
End Sub
Private Sub setSCL0_Click()
SetClock (0)
Label3.Caption = ReadClock()
End Sub
Private Sub setSCL1_Click()
SetClock (1)
Label3.Caption = ReadClock()
End Sub
Private Sub setSDA0_Click()
SetData (0)
Label2.Caption = ReadData()
End Sub
Private Sub setSDA1_Click()
SetData (1)
Label2.Caption = ReadData()
End Sub
Private Sub test_Click()
Dim i As Byte
Dim Result As String
i = 1
Label10.Caption = "正在查找..."
Label11.Caption = ""
While i < 255
Call I2C_Start
Call ByteOut(i) ' send addr
Call I2C_Stop
If ack = True Then
Result = Result + "哈哈，找到一个家伙，地址是0x" + Hex(i) + Chr(10) + Chr(13)
End If
i = i + 1
Wend
Label11.Caption = Result
Label10.Caption = "查找完毕！"
End Sub
Private Sub test1_Click()
Call I2C_Start
Call ByteOut(Text1.Text) ' send addr
Call I2C_Stop
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -