www.pudn.com > I2C.rar > PortIO.frm


VERSION 5.00
Begin VB.Form FormMain
BorderStyle = 3 'Fixed Dialog
Caption = "并口I2C模拟通讯"
ClientHeight = 7905
ClientLeft = 4860
ClientTop = 3225
ClientWidth = 8895
FillColor = &amt;H0000FF00&amt;
Icon = "PortIO.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
PaletteMode = 1 'UseZOrder
ScaleHeight = 7905
ScaleWidth = 8895
ShowInTaskbar = 0 'False
Begin VB.CommandButton Command2
Caption = "try"
Height = 615
Left = 2640
TabIndex = 39
Top = 5040
Width = 1095
End
Begin VB.CommandButton test
Caption = "查找所有器件"
Height = 495
Left = 2400
TabIndex = 36
Top = 3480
Width = 1815
End
Begin VB.ComboBox Combo1
Height = 300
ItemData = "PortIO.frx":0442
Left = 2640
List = "PortIO.frx":0444
TabIndex = 35
Text = "&amt;H378"
Top = 360
Width = 1215
End
Begin VB.TextBox Text3
Height = 270
Left = 3600
TabIndex = 32
Text = "&amt;H01"
Top = 1200
Width = 900
End
Begin VB.TextBox Text2
Height = 270
Left = 2040
TabIndex = 31
Text = "&amt;H00"
Top = 1200
Width = 900
End
Begin VB.CommandButton Command4
Caption = "E2PROM test"
Height = 495
Left = 360
TabIndex = 30
Top = 3720
Width = 1215
End
Begin VB.CommandButton test1
Caption = "单地址测试"
Height = 495
Left = 2640
TabIndex = 10
Top = 4320
Width = 1215
End
Begin VB.TextBox Text1
Height = 270
Left = 480
TabIndex = 8
Text = "&amt;H11"
Top = 1200
Width = 900
End
Begin VB.CommandButton Command1
Caption = "写入"
Height = 495
Left = 360
TabIndex = 5
Top = 3120
Width = 1095
End
Begin VB.CommandButton setSDA1
Caption = "SDA=1"
Height = 495
Left = 2040
TabIndex = 4
Top = 6960
Width = 1095
End
Begin VB.CommandButton setSCL1
Caption = "SCL=1"
Height = 495
Left = 240
TabIndex = 3
Top = 6960
Width = 1095
End
Begin VB.CommandButton setSCL0
Caption = "SCL=0"
Height = 495
Left = 240
TabIndex = 2
Top = 5880
Width = 1095
End
Begin VB.CommandButton setSDA0
Caption = "SDA=0"
Height = 495
Left = 2040
TabIndex = 1
Top = 5880
Width = 1095
End
Begin VB.Frame Frame1
Caption = "读写数据"
Height = 1335
Left = 240
TabIndex = 12
Top = 1680
Width = 6255
Begin VB.CommandButton Command3
Caption = "bit0 OLF"
Height = 495
Index = 0
Left = 4440
TabIndex = 20
Top = 600
Width = 615
End
Begin VB.CommandButton Command3
Caption = "bit1 OTF"
Height = 495
Index = 1
Left = 3840
TabIndex = 19
Top = 600
Width = 615
End
Begin VB.CommandButton Command3
Caption = "bit2 EN"
Height = 495
Index = 2
Left = 3240
TabIndex = 18
Top = 600
Width = 615
End
Begin VB.CommandButton Command3
Caption = "bit3 VSEL"
Height = 495
Index = 3
Left = 2640
TabIndex = 17
Top = 600
Width = 615
End
Begin VB.CommandButton Command3
Caption = "bit4 LLC"
Height = 495
Index = 4
Left = 2040
TabIndex = 16
Top = 600
Width = 615
End
Begin VB.CommandButton Command3
Caption = "bit5 TEN"
Height = 495
Index = 5
Left = 1440
TabIndex = 15
Top = 600
Width = 615
End
Begin VB.CommandButton Command3
Caption = "bit6 ISEL"
Height = 495
Index = 6
Left = 840
TabIndex = 14
Top = 600
Width = 615
End
Begin VB.CommandButton Command3
Caption = "bit7 PCL"
Height = 495
Index = 7
Left = 240
TabIndex = 13
Top = 600
Width = 615
End
Begin VB.Label Label5
Alignment = 2 'Center
Caption = "&amt;&amt;H00"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 5280
TabIndex = 29
Top = 240
Width = 735
End
Begin VB.Label Label7
Alignment = 2 'Center
Caption = "0"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 0
Left = 4485
TabIndex = 28
Top = 240
Width = 375
End
Begin VB.Label Label7
Alignment = 2 'Center
Caption = "0"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 1
Left = 3885
TabIndex = 27
Top = 240
Width = 375
End
Begin VB.Label Label7
Alignment = 2 'Center
Caption = "0"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 3
Left = 2640
TabIndex = 26
Top = 240
Width = 375
End
Begin VB.Label Label7
Alignment = 2 'Center
Caption = "0"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 2
Left = 3285
TabIndex = 25
Top = 240
Width = 375
End
Begin VB.Label Label7
Alignment = 2 'Center
Caption = "0"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 4
Left = 2085
TabIndex = 24
Top = 240
Width = 375
End
Begin VB.Label Label7
Alignment = 2 'Center
Caption = "0"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 5
Left = 1485
TabIndex = 23
Top = 240
Width = 375
End
Begin VB.Label Label7
Alignment = 2 'Center
Caption = "0"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 6
Left = 885
TabIndex = 22
Top = 240
Width = 375
End
Begin VB.Label Label7
Alignment = 2 'Center
Caption = "0"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 7
Left = 285
TabIndex = 21
Top = 240
Width = 375
End
End
Begin VB.Label Label11
Height = 3300
Left = 4800
TabIndex = 38
Top = 3960
Width = 3570
End
Begin VB.Label Label10
Caption = "Label10"
Height = 375
Left = 4680
TabIndex = 37
Top = 3240
Width = 3615
End
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 = &amt;H00808080&amt;
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 &amt;H8
DlPortWritePortUchar Val(Combo1.Text + 2), Value
Else
Value = DlPortReadPortUchar(Val(Combo1.Text + 1))
Value = Value And &amt;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 &amt;H7F
DlPortWritePortUchar Val(Combo1.Text), Value
Else
Value = DlPortReadPortUchar(Val(Combo1.Text + 1))
Value = Value Or &amt;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 = &amt;H808080 'Grey
Else
ack = True
Shape1.FillColor = &amt;HFF00&amt; '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 = &amt;H808080 'Grey
Else
Shape1.FillColor = &amt;HFF00&amt; '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 &amt;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 &amt;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("&amt;H" &amt; 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 = "&amt;&amt;H" &amt; SendData

End Sub

Private Sub Form_Load()

Left = (Screen.Width - Width) / 2
Top = (Screen.Height - Height) / 2
SendData = 0
Combo1.AddItem ("&amt;H378")
Combo1.AddItem ("&amt;H3BC")
Combo1.AddItem ("&amt;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