📄 frmmain.frm
字号:
Width = 2415
End
Begin VB.Label Label39
Caption = "Data WORD ADDRESS to Read"
Height = 255
Left = 315
TabIndex = 23
Top = 270
Width = 2730
End
Begin VB.Label Label35
Caption = "Data Buffer (Hex)"
Height = 225
Left = 330
TabIndex = 22
Top = 1725
Width = 3075
End
Begin VB.Label Label34
Caption = "(<400H)"
Height = 255
Left = 1800
TabIndex = 21
Top = 1020
Width = 765
End
Begin VB.Label Label32
Caption = "Data Length"
Height = 255
Left = 330
TabIndex = 20
Top = 1020
Width = 1155
End
End
Begin VB.Frame Frame10
Caption = "EEPROM Chip"
Height = 6405
Left = -74895
TabIndex = 1
Top = 420
Width = 1620
Begin VB.OptionButton eppromtype
Caption = "24C4096"
Height = 255
Index = 12
Left = 180
TabIndex = 14
Top = 5190
Width = 1320
End
Begin VB.OptionButton eppromtype
Caption = "24C2048"
Height = 255
Index = 11
Left = 180
TabIndex = 13
Top = 4777
Width = 1320
End
Begin VB.OptionButton eppromtype
Caption = "24C1024"
Height = 255
Index = 10
Left = 180
TabIndex = 12
Top = 4370
Width = 1320
End
Begin VB.OptionButton eppromtype
Caption = "24C512"
Height = 255
Index = 9
Left = 180
TabIndex = 11
Top = 3963
Width = 1320
End
Begin VB.OptionButton eppromtype
Caption = "24C256"
Height = 255
Index = 8
Left = 180
TabIndex = 10
Top = 3556
Width = 1320
End
Begin VB.OptionButton eppromtype
Caption = "24C128"
Height = 255
Index = 7
Left = 180
TabIndex = 9
Top = 3149
Width = 1320
End
Begin VB.OptionButton eppromtype
Caption = "24C64"
Height = 255
Index = 6
Left = 180
TabIndex = 8
Top = 2742
Width = 1320
End
Begin VB.OptionButton eppromtype
Caption = "24C32"
Height = 255
Index = 5
Left = 180
TabIndex = 7
Top = 2335
Width = 1320
End
Begin VB.OptionButton eppromtype
Caption = "24C16"
Height = 255
Index = 4
Left = 180
TabIndex = 6
Top = 1928
Width = 1320
End
Begin VB.OptionButton eppromtype
Caption = "24C08"
Height = 255
Index = 3
Left = 180
TabIndex = 5
Top = 1521
Width = 1320
End
Begin VB.OptionButton eppromtype
Caption = "24C04"
Height = 255
Index = 2
Left = 180
TabIndex = 4
Top = 1114
Width = 1320
End
Begin VB.OptionButton eppromtype
Caption = "24C02"
Height = 255
Index = 1
Left = 165
TabIndex = 3
Top = 707
Width = 1320
End
Begin VB.OptionButton eppromtype
Caption = "24C01"
Height = 255
Index = 0
Left = 180
TabIndex = 2
Top = 300
Value = -1 'True
Width = 1320
End
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim hopen As Long
Private Sub eepromRdDate_Click()
Dim mDataAddr As Long
Dim mLen As Long
Dim buffer As arrRBuffer
Dim bu() As Byte
mLen = HexToBcd(RdDataLen)
If (RdDataAddr.Text = "") Then
MsgBox "请输入数据单元起始地址！", vbExclamation, "USB2I2C DEMO"
Exit Sub
End If
If (mLen <= 0) Then
MsgBox "请输入读取长度！", vbExclamation, "USB2I2C DEMO"
Exit Sub
End If
mDataAddr = HexToBcd(RdDataAddr)
If (mOpen = True) Then
If (USBIO_ReadEEPROM(mIndex, eepromid, mDataAddr, mLen, buffer)) Then
Dim buff As String
Dim i As Long
For i = 0 To mLen - 1
buff = buff & Hex2bit(buffer.buf(i)) & " "
Next i
RdDataBuf.Text = buff
Else
MsgBox "读E2PROM数据失败！", vbExclamation, "USB2I2C DEMO"
End If
RdDataLen.Text = Hex(mLen)
Else
MsgBox "USB2I2C Device NOT Oper!", vbExclamation, "USB2I2C DEMO"
End If
End Sub
Private Sub eepromWrDate_Click()
Dim mData As Byte
Dim mDataAddr As Long
Dim mLen As Long
Dim buffer As arrRBuffer
mLen = HexToBcd(WrDataLen.Text)
If (WrDataAddr.Text = "") Then
MsgBox "请输入数据单元起始地址！", vbExclamation, "USB2I2C DEMO"
Exit Sub
End If
If (mLen <= 0 Or WrDataBuf.Text = "") Then
MsgBox "请输入要写入的数据,长度！", vbExclamation, "USB2I2C DEMO"
Exit Sub
End If
If (mLen > (Len(WrDataBuf) \ 2)) Then '在输入长度和数据长度中取小值
mLen = Len(WrDataBuf) \ 2
End If
mDataAddr = HexToBcd(WrDataAddr.Text)
Call mStrtoVal(WrDataBuf.Text, buffer, mLen) '将输入的十六进制格式字符数据转成数值数据
If (mOpen = True) Then
If (USBIO_WriteEEPROM(mIndex, eepromid, mDataAddr, mLen, buffer) = False) Then
MsgBox "读E2PROM数据失败！", vbExclamation, "USB2I2C DEMO"
End If
WrDataLen.Text = Hex(mLen)
Else
MsgBox "USB2I2C Device NOT Oper!", vbExclamation, "USB2I2C DEMO"
End If
End Sub
Private Sub eppromtype_Click(Index As Integer)
Select Case Index
Case 0
eepromid = ID_24C01
Case 1
eepromid = ID_24C02
Case 2
eepromid = ID_24C04
Case 3
eepromid = ID_24C08
Case 4
eepromid = ID_24C16
Case 5
eepromid = ID_24C32
Case 6
eepromid = ID_24C64
Case 7
eepromid = ID_24C128
Case 8
eepromid = ID_24C256
Case 9
eepromid = ID_24C512
Case 10
eepromid = ID_24C1024
Case 11
eepromid = ID_24C2048
Case 12
eepromid = ID_24C4096
End Select
End Sub
Private Sub Form_Load()
mIndex = 0
SSTab1.TabVisible(0) = False
SSTab1.TabVisible(1) = False
'SSTab1.TabVisible(2) = False
'SSTab1.TabVisible(3) = False
SSTab1.TabVisible(4) = False
SSTab1.TabVisible(5) = False
hopen = USBIO_OpenDevice(mIndex)
If (hopen = INVALID_HANDLE_VALUE) Then
mOpen = False
Else
mOpen = True
End If
'设置设备插拔通知
If USBIO_SetDeviceNotify(mIndex, vbNullString, AddressOf mUSBIO_NOTIFY_ROUTINE) = False Then
MsgBox "设置设备插拔通知失败", vbExclamation, "USB2I2C DEMO"
End If
enablebtn (mOpen)
End Sub
Private Sub Form_Unload(Cancel As Integer)
USBIO_SetDeviceNotify mIndex, vbNullString, 0&
If (mOpen = True) Then
USBIO_CloseDevice (mIndex)
End If
End Sub
Private Sub StreamICRW_Click()
Dim mWRLen As Long
Dim mRdLen As Long
Dim iBuff As arrRBuffer
Dim buffer As arrRBuffer
mWRLen = HexToBcd(I2CWRLen.Text)
mRdLen = HexToBcd(I2CRDLen.Text)
'----------------------------------------
If (I2CM(0).Value = True) Then
If (USBIO_SetStream(mIndex, &H80) = False) Then
MsgBox "设置I2C时钟 = 20KHz失败！ ", vbExclamation, "USB2I2C DEMO"
Exit Sub
End If
ElseIf (I2CM(1).Value = True) Then
If (USBIO_SetStream(mIndex, &H81) = False) Then
MsgBox "设置I2C时钟 = 100KHz失败！ ", vbExclamation, "USB2I2C DEMO"
Exit Sub
End If
ElseIf (I2CM(2).Value = True) Then
If (USBIO_SetStream(mIndex, &H82) = False) Then
MsgBox "设置I2C时钟 = 400KHz失败！ ", vbExclamation, "USB2I2C DEMO"
Exit Sub
End If
ElseIf (I2CM(3).Value = True) Then
If (USBIO_SetStream(mIndex, &H83) = False) Then
MsgBox "设置I2C时钟 = 750KHz失败！ ", vbExclamation, "USB2I2C DEMO"
Exit Sub
End If
End If
'----------------------------------------
If (mWRLen > 0 And I2CWRBuf.Text = "") Then
MsgBox "请输入要写的数据,长度！", vbExclamation, "USB2I2C DEMO"
Exit Sub
End If
If ((mWRLen = 0) And (mRdLen = 0)) Then
MsgBox "请输入读数据所需的长度！", vbExclamation, "USB2I2C DEMO"
Exit Sub
End If
If (mWRLen > Len(Trim(I2CWRBuf.Text)) \ 2) Then
mWRLen = Len(Trim(I2CWRBuf.Text)) \ 2
End If
Call mStrtoVal(I2CWRBuf.Text, buffer, mWRLen) '将输入的十六进制格式字符数据转成数值数据
If (mOpen = True) Then
If (USBIO_StreamI2C(mIndex, mWRLen, buffer, mRdLen, iBuff) = False) Then
MsgBox "I2C流模式读写数据失败！", vbExclamation, "USB2I2C DEMO"
Else
If (mRdLen > 0) Then '有数据返回
Dim buff As String
Dim i As Long
For i = 0 To mRdLen - 1
buff = buff & Hex2bit(iBuff.buf(i)) + " "
Next
I2CRDBuf.Text = buff
End If
End If
I2CWRLen.Text = Hex(mWRLen)
I2CRDLen.Text = Hex(mRdLen)
Else
MsgBox "USB2I2C Device NOT Oper!", vbExclamation, "USB2I2C DEMO"
End If
End Sub
Private Sub USBIO_NOTIFY_ROUTINE_KeyUp(KeyCode As Integer, Shift As Integer) '设备插拔通知处理程序
Dim iEventStatus As Long
iEventStatus = KeyCode '插拔事件
If (iEventStatus = USBIO_DEVICE_ARRIVAL) Then ' 设备插入事件,已经插入
If (USBIO_OpenDevice(mIndex) = INVALID_HANDLE_VALUE) Then
MsgBox "打开设备失败!", vbOK, "USB2I2C DEMO"
mOpen = False
Else
mOpen = True '打开成功
End If
ElseIf (iEventStatus = USBIO_DEVICE_REMOVE) Then ' 设备拔出事件,已经拔出
USBIO_CloseDevice (mIndex)
mOpen = False
End If
enablebtn (mOpen) '设备打开,按钮可用,设备没打开,按钮禁用
End Sub
Public Sub enablebtn(ByVal bEnable As Boolean) 'bEnable=true :各窗体按钮可用 ;=false:enable:各窗体按钮禁用
With frmMain
.StreamICRW.Enabled = bEnable
.eepromRdDate.Enabled = bEnable
.eepromWrDate.Enabled = bEnable
If (bEnable = True) Then '窗体标题显示
frmMain.Caption = "USB2I2C **PlugIn"
Else
frmMain.Caption = "USB2I2C **PlugOut"
End If
End With
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -