Perfect-Silence
08.02.2005, 14:33
hi leute habe ein problem. habe ein interface (USB HighSpeed Interface Modul V2.5 mit 8KB I²C EEPROM)
ich will eine ultraschallmessung auslösen, aber irgendwie geht es nicht.
naja ihr könnt euch den code mal angucken und mir dann mal bescheid sagen.
Const Initialized As Boolean = True
Dim OK As Boolean
Dim Zentimeter As Byte
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Type Daten
Speicher(1) As Byte
End Type
Function fehlerCheck()
Fehler = UsbGetError
Select Case Fehler
Case 0
MsgBox ("no Error")
Case 1
MsgBox ("File Not found")
Case 2
MsgBox ("Device not present: The device is not connected or the driver is not installed correctly")
Case 3
MsgBox ("Unable to open device")
Case 4
MsgBox ("Usb transfer failed: The usb transfer timed out or the device has been removed during a usb transfer")
Case 5
MsgBox ("Out of memory: The DLL failed to allocate memory")
Case 6
MsgBox ("Invalid parameter: One of the parameters passed to a function is wrong or out of range")
Case 7
MsgBox ("Interface is not initialized: The interface has not been initialized using UsbInt")
Case 8
MsgBox ("I2c transfer timed out: The i2c transfer timed out. Perhaps the i2c timeout value has to be modified using UsbSeti2cTimeout")
Case 9
MsgBox ("I2c bus error (lost arbitration)")
Case 10
MsgBox ("The i2c slave did not acknowledge")
Case 11
MsgBox ("Eeprom write timed out: The EEprom did not ackknowledge during the selected EEprom timeout. Perhaps the timeout has to be increased using the function UsbEEpSetTimeout.")
Case 12
MsgBox ("SPI bus has to be initialized before calling this function: You called an SPI-transfer function, but did not initialize the SPI bus using UsbSpiInit before")
Case 13
MsgBox ("Parallel bus has to be initialized before calling this function: You called an Parallel bus function without initializing it using UsbParInit or UsbParInitUsingArray")
Case 14
MsgBox ("UsbParIn transfer timed out")
Case 15
MsgBox ("UsbParOut transfer timed out")
Case 16
MsgBox ("Internal error-Transaction number mismatch")
End Select
End Function
Private Sub Command1_Click()
OK = UsbClose(0)
End
End Sub
Private Sub Command2_Click()
OK = True
OK = UsbI2CWriteByte(0, 112, 0)
OK = UsbI2CWriteByte(0, 112, 81)
If OK Then MsgBox ("OK is Ok") Else MsgBox ("OK is nicht OK")
OK = UsbI2CWriteByte(0, 112, 2)
OK = UsbI2CReadByte(0, 112, Zentimeter)
If OK Then MsgBox ("OK is Ok") Else MsgBox ("OK is nicht OK")
Text1.Text = Zentimeter
End Sub
Private Sub Command3_Click()
Dim Daten As Daten
OK = True
Daten.Speicher(0) = 0
Daten.Speicher(1) = 81
OK = UsbI2CWriteBytes(0, 112, 2, Daten.Speicher(0))
'OK = UsbI2CWriteBytes(0, 112, 2, Daten.Speicher(1))
'
'OK = UsbI2CWriteByte(0, 112, 81)
Sleep 100
OK = UsbI2CWriteByte(0, 112, 0)
OK = UsbI2CReadByte(0, 112, Zentimeter)
Text1.Text = Zentimeter
End Sub
Private Sub Form_Load()
Text1.Text = ""
OK = UsbSetLicense("license.dat")
If OK Then Form1.Visible = True Else MsgBox ("Licens nicht erkannt")
OK = UsbInit(0)
If OK = 0 Then MsgBox ("Unable to initialize USB interface. Device not present?")
If OK = 0 Then End
OK = UsbI2CSetTimeout(0, 200)
If OK = 0 Then MsgBox ("TimeOut nicht gesetzt!")
OK = UsbI2CSetSpeed(0, 0)
If OK = 0 Then MsgBox ("Spped nicht gesetzt!")
End Sub
gruß dave
ich will eine ultraschallmessung auslösen, aber irgendwie geht es nicht.
naja ihr könnt euch den code mal angucken und mir dann mal bescheid sagen.
Const Initialized As Boolean = True
Dim OK As Boolean
Dim Zentimeter As Byte
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Type Daten
Speicher(1) As Byte
End Type
Function fehlerCheck()
Fehler = UsbGetError
Select Case Fehler
Case 0
MsgBox ("no Error")
Case 1
MsgBox ("File Not found")
Case 2
MsgBox ("Device not present: The device is not connected or the driver is not installed correctly")
Case 3
MsgBox ("Unable to open device")
Case 4
MsgBox ("Usb transfer failed: The usb transfer timed out or the device has been removed during a usb transfer")
Case 5
MsgBox ("Out of memory: The DLL failed to allocate memory")
Case 6
MsgBox ("Invalid parameter: One of the parameters passed to a function is wrong or out of range")
Case 7
MsgBox ("Interface is not initialized: The interface has not been initialized using UsbInt")
Case 8
MsgBox ("I2c transfer timed out: The i2c transfer timed out. Perhaps the i2c timeout value has to be modified using UsbSeti2cTimeout")
Case 9
MsgBox ("I2c bus error (lost arbitration)")
Case 10
MsgBox ("The i2c slave did not acknowledge")
Case 11
MsgBox ("Eeprom write timed out: The EEprom did not ackknowledge during the selected EEprom timeout. Perhaps the timeout has to be increased using the function UsbEEpSetTimeout.")
Case 12
MsgBox ("SPI bus has to be initialized before calling this function: You called an SPI-transfer function, but did not initialize the SPI bus using UsbSpiInit before")
Case 13
MsgBox ("Parallel bus has to be initialized before calling this function: You called an Parallel bus function without initializing it using UsbParInit or UsbParInitUsingArray")
Case 14
MsgBox ("UsbParIn transfer timed out")
Case 15
MsgBox ("UsbParOut transfer timed out")
Case 16
MsgBox ("Internal error-Transaction number mismatch")
End Select
End Function
Private Sub Command1_Click()
OK = UsbClose(0)
End
End Sub
Private Sub Command2_Click()
OK = True
OK = UsbI2CWriteByte(0, 112, 0)
OK = UsbI2CWriteByte(0, 112, 81)
If OK Then MsgBox ("OK is Ok") Else MsgBox ("OK is nicht OK")
OK = UsbI2CWriteByte(0, 112, 2)
OK = UsbI2CReadByte(0, 112, Zentimeter)
If OK Then MsgBox ("OK is Ok") Else MsgBox ("OK is nicht OK")
Text1.Text = Zentimeter
End Sub
Private Sub Command3_Click()
Dim Daten As Daten
OK = True
Daten.Speicher(0) = 0
Daten.Speicher(1) = 81
OK = UsbI2CWriteBytes(0, 112, 2, Daten.Speicher(0))
'OK = UsbI2CWriteBytes(0, 112, 2, Daten.Speicher(1))
'
'OK = UsbI2CWriteByte(0, 112, 81)
Sleep 100
OK = UsbI2CWriteByte(0, 112, 0)
OK = UsbI2CReadByte(0, 112, Zentimeter)
Text1.Text = Zentimeter
End Sub
Private Sub Form_Load()
Text1.Text = ""
OK = UsbSetLicense("license.dat")
If OK Then Form1.Visible = True Else MsgBox ("Licens nicht erkannt")
OK = UsbInit(0)
If OK = 0 Then MsgBox ("Unable to initialize USB interface. Device not present?")
If OK = 0 Then End
OK = UsbI2CSetTimeout(0, 200)
If OK = 0 Then MsgBox ("TimeOut nicht gesetzt!")
OK = UsbI2CSetSpeed(0, 0)
If OK = 0 Then MsgBox ("Spped nicht gesetzt!")
End Sub
gruß dave