main.frm

用vb编写的usb转I2c例子

VERSION 5.00
Begin VB.Form frmMain 
   Caption         =   "USB I2C/IO VbSimple Example Application"
   ClientHeight    =   2565
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7110
   Icon            =   "main.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   2565
   ScaleWidth      =   7110
   StartUpPosition =   2  'CenterScreen
   Begin VB.Timer tmrDetect 
      Enabled         =   0   'False
      Interval        =   100
      Left            =   600
      Top             =   2640
   End
   Begin VB.Frame fraI2C 
      Caption         =   "I2C"
      Height          =   2295
      Left            =   4680
      TabIndex        =   7
      Top             =   120
      Width           =   2295
      Begin VB.CommandButton cmdWriteI2c 
         Caption         =   "Write I2C"
         Enabled         =   0   'False
         Height          =   495
         Left            =   480
         TabIndex        =   9
         Top             =   360
         Width           =   1215
      End
      Begin VB.CommandButton cmdReadI2C 
         Caption         =   "Read I2C"
         Enabled         =   0   'False
         Height          =   495
         Left            =   480
         TabIndex        =   8
         Top             =   960
         Width           =   1215
      End
   End
   Begin VB.Frame fraPortIo 
      Caption         =   "Port I/O"
      Height          =   2295
      Left            =   2280
      TabIndex        =   3
      Top             =   120
      Width           =   2295
      Begin VB.CommandButton cmdReadIo 
         Caption         =   "Read I/O"
         Enabled         =   0   'False
         Height          =   495
         Left            =   480
         TabIndex        =   6
         Top             =   1560
         Width           =   1215
      End
      Begin VB.CommandButton cmdWriteIo 
         Caption         =   "Write I/O"
         Enabled         =   0   'False
         Height          =   495
         Left            =   480
         TabIndex        =   5
         Top             =   960
         Width           =   1215
      End
      Begin VB.CommandButton cmdConfigIo 
         Caption         =   "Configure I/O"
         Enabled         =   0   'False
         Height          =   495
         Left            =   480
         TabIndex        =   4
         Top             =   360
         Width           =   1215
      End
   End
   Begin VB.Frame fraHandle 
      Caption         =   "Device Handle"
      Height          =   2295
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   2055
      Begin VB.CommandButton cmdClose 
         Caption         =   "Close  Device"
         Enabled         =   0   'False
         Height          =   495
         Left            =   360
         TabIndex        =   2
         Top             =   960
         Width           =   1215
      End
      Begin VB.CommandButton cmdOpen 
         Caption         =   "Open  Device"
         Height          =   495
         Left            =   360
         TabIndex        =   1
         Top             =   360
         Width           =   1215
      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 sAppName As String            ' Application name
Public sDevSymName As String      ' symbolic name of USB device, example: "UsbI2cIo"
Private byDevInstance As Byte     ' currently selected device instance number
Public hDevInstance As Long       ' handle to the currently selected device instance
Dim bDevicePresent As Boolean     ' flag to indicate presence of device
'

Private Sub Form_Load()
  ' perform initialization tasks for the application
  
  sDevSymName = "UsbI2cIo"                        ' UsbI2cIo device symbolic name
  sAppName = "VbSimple "                          ' Application name
  frmMain.Caption = sAppName & " - no device"     ' Application Title Caption

  byDevInstance = 255                             ' initial device instance (255 = no device)
  hDevInstance = INVALID_HANDLE_VALUE             ' initialize file handle

End Sub

Public Sub AppExit()
  ' this subroutine performs cleanup tasks and then exits the application
  CloseDiHandle
  End
End Sub
'

Private Sub Form_Terminate()
  ' terminate main application form
  AppExit
End Sub
'

Private Sub Form_Unload(Cancel As Integer)
  ' unload main application form
  AppExit
End Sub
'

Private Sub cmdOpen_Click()
  ' attempt to open a device (open first detected device)
  
  Dim I As Byte
  
  For I = 0 To 127 Step 1
    If (OpenDiHandle(I)) Then
      ' succesfully opened a device
      Exit For
    End If
  Next I
  
  ' indicate success or notify of failure
  If (I = 128) Then
    ' no device was found
    Call MsgBox("No UsbI2cIo Devices were detected", vbOKOnly, "Device Open Error")
  Else
    ' found a device
    byDevInstance = I
    EnableButtons (True)
    tmrDetect.Enabled = True
    frmMain.Caption = sAppName & " - " & sDevSymName & Format(I)     ' Application Title Caption
  End If
 
End Sub

Private Sub cmdClose_Click()
  ' close the currently open device
  tmrDetect.Enabled = False
  CloseDiHandle
  byDevInstance = 0
  EnableButtons (False)
  frmMain.Caption = sAppName & " - no device"     ' Application Title Caption
End Sub
'

Private Sub cmdConfigIo_Click()
  ' Configures the IoPorts
  ' Io Port bit mapping is 0x000CBBAA
  ' individual bits are configured by writing 0 = output, 1 = input
  
  ' configure IO Ports for C = input, B = output A = input
  If DAPI_ConfigIoPorts(hDevInstance, &HF00FF) Then
    ' function call ok
  Else
    ' function call failed
  End If
End Sub
'

Private Sub cmdWriteIo_Click()
  ' Writes to the IoPorts
  ' Io Port bit mapping is 0x000CBBAA for both pin values and mask
  ' mask value allows for individual bit modifications without read/modify/write cycle
  
  Dim ulIoValue As Long
  Dim ulIoMask As Long
  
  ulIoValue = &HFFFFFFFF
  ulIoMask = &HFFFFFFFF
  
  ' set all pins that were previously configure for outputs
  ' input pins are unaffected by write operations
  If DAPI_WriteIoPorts(hDevInstance, ulIoValue, ulIoMask) Then
    ' function call ok
  Else
    ' function call failed
  End If
  
  ulIoValue = &H0
  ' clear all pins that were previously configure for outputs
  ' input pins are unaffected by write operations
  If DAPI_WriteIoPorts(hDevInstance, ulIoValue, ulIoMask) Then
    ' function call ok
  Else
    ' function call failed
  End If

  ulIoValue = &H8000
  ulIoMask = &H8100
  ' set B.7 and clear B.0, leave all other pins un-modified
  ' input pins are unaffected by write operations
  If DAPI_WriteIoPorts(hDevInstance, ulIoValue, ulIoMask) Then
    ' function call ok
  Else
    ' function call failed
  End If

End Sub
'

Private Sub cmdReadIo_Click()
  ' Reads from the IoPorts
  ' Io Port bit mapping is 0x000CBBAA for both pin values and mask
  ' all pin values are read, regardless of input or output configuration
  
  Dim ulIoPortData As Long        ' holds read value, passed by reference (pointer)
  
  If DAPI_ReadIoPorts(hDevInstance, ulIoPortData) Then
    ' function call ok
  Else
    ' function call failed
  End If

End Sub
'

Private Sub cmdWriteI2c_Click()
  ' Perform an I2C Write transaction to a Phillips PCF8574 (8 bit IO device)
  
  ' NOTE:
  ' this function call will normally fail... unless you actually have a PCF8574 device attached
  ' to the I2C header of the USB I2C/IO board
  
  Dim I2cTrans As I2C_TRANS                     ' Dimension an I2C_TRANS structure
  Dim lWritten As Long                          ' Dimension a long to hold the returned value
  
  ' Initialize the structure elements
  I2cTrans.byDevId = &H42                       ' PCF8574 device ID
  I2cTrans.byType = I2C_TRANS_NOADR             ' device does not use sub-address
  I2cTrans.wMemAddr.hi = 0                      ' unused for I2C_TRANS_NOADDR
  I2cTrans.wMemAddr.lo = 0                      ' unused for I2C_TRANS_NOADDR
  I2cTrans.wCount.hi = 0                        ' only writing 1 byte, so set to 0
  I2cTrans.wCount.lo = 1                        ' writing 1 byte, so set to 1
  I2cTrans.Data(0) = &H71                       ' the actual data that will be written to PCF8574
  
  ' call the function
  lWritten = DAPI_WriteI2c(hDevInstance, I2cTrans)

  If (lWritten = 1) Then
    ' function call ok
  Else
    ' function call failed
    Call MsgBox("Incorrect Return value", vbOKOnly, " Error calling DAPI_WriteI2C() function")
  End If

End Sub
'

Private Sub cmdReadI2c_Click()
  ' Perform an I2C Read transaction to a Phillips PCF8574 (8 bit IO device)
  
  ' NOTE:
  ' this function call will normally fail... unless you actually have a PCF8574 device attached
  ' to the I2C header of the USB I2C/IO board
  
  Dim I2cTrans As I2C_TRANS                     ' Dimension an I2C_TRANS structure
  Dim lRead As Long                          ' Dimension a long to hold the returned value
  
  ' Initialize the structure elements
  I2cTrans.byDevId = &H42                       ' PCF8574 device ID
  I2cTrans.byType = I2C_TRANS_NOADR             ' device does not use sub-address
  I2cTrans.wMemAddr.hi = 0                      ' unused for I2C_TRANS_NOADDR
  I2cTrans.wMemAddr.lo = 0                      ' unused for I2C_TRANS_NOADDR
  I2cTrans.wCount.hi = 0                        ' only reading 1 byte, so set to 0
  I2cTrans.wCount.lo = 1                        ' reading 1 byte, so set to 1
  
  ' call the function
  lRead = DAPI_ReadI2c(hDevInstance, I2cTrans)

  If (lRead = 1) Then
    ' function call ok
  Else
    ' function call failed
    Call MsgBox("Incorrect Return value", vbOKOnly, " Error calling DAPI_ReadI2C() function")
  End If

  ' Perform an I2C Read transaction

End Sub

Private Function OpenDiHandle(byDevInstance As Byte) As Byte
  ' this subroutine will handle opening the specified device instance
  
  ' make sure no handle is currently open
  CloseDiHandle
  
  ' now attempt to open handle to device instance
  hDevInstance = DAPI_OpenDeviceInstance(sDevSymName, byDevInstance)
  
  ' test result of function call and flag success or failure
  If (hDevInstance <> INVALID_HANDLE_VALUE) Then
    OpenDiHandle = 1
  Else
    OpenDiHandle = 0
  End If

End Function
'

Private Sub CloseDiHandle()

  If hDevInstance <> INVALID_HANDLE_VALUE Then
    If DAPI_CloseDeviceInstance(hDevInstance) Then
      ' everythings zen
    Else
      ' SNAFU
    End If
    hDevInstance = INVALID_HANDLE_VALUE
  End If
  
End Sub
'

Public Function CheckDevice() As Boolean
  
  If hDevInstance = INVALID_HANDLE_VALUE Then
    If OpenDiHandle(byDevInstance) Then
      CheckDevice = True
    Else
      CheckDevice = False
    End If
  ElseIf DAPI_DetectDevice(hDevInstance) Then
    CheckDevice = True
  Else
    CloseDiHandle
    CheckDevice = False
  End If
  
End Function
'

Private Sub EnableButtons(bEnable As Boolean)
  If bEnable Then
    frmMain.cmdOpen.Enabled = False
    frmMain.cmdClose.Enabled = True
    frmMain.cmdConfigIo.Enabled = True
    frmMain.cmdWriteIo.Enabled = True
    frmMain.cmdReadIo.Enabled = True
    frmMain.cmdWriteI2c.Enabled = True
    frmMain.cmdReadI2C.Enabled = True
  Else
    frmMain.cmdOpen.Enabled = True
    frmMain.cmdClose.Enabled = False
    frmMain.cmdConfigIo.Enabled = False
    frmMain.cmdWriteIo.Enabled = False
    frmMain.cmdReadIo.Enabled = False
    frmMain.cmdWriteI2c.Enabled = False
    frmMain.cmdReadI2C.Enabled = False
  End If
End Sub
'

Private Sub tmrDetect_Timer()
  ' perform periodic tasks for the application
  
  Static bDevPrevPresent As Boolean
  
  ' check if UsbI2cIo device is still present
  bDevicePresent = CheckDevice
  If (bDevicePresent = bDevPrevPresent) Then
    ' no change in device detection, nothing to do
  Else
    ' device detection change
    If (bDevicePresent) Then
      EnableButtons (True)
    Else
      EnableButtons (False)
    End If
    bDevPrevPresent = bDevicePresent
  End If
End Sub
'