|
Declare Function
OPENCOM Lib "Port.dll" (ByVal
A$) As Integer
Declare Sub CLOSECOM
Lib "Port.dll" ()
Declare Sub DTR
Lib "Port.dll" (ByVal b%)
Declare Sub RTS
Lib "Port.dll" (ByVal b%)
Declare Function CTS
Lib "Port.dll" ()
As Integer
Declare Function
DSR Lib "Port.dll" ()
As Integer
Declare Sub DELAY Lib "Port.dll"
(ByVal b%) Public Function SCL(i) As Boolean
Public Function
SCL(i) As Boolean
'SCL auf der RTS-Leitung am COM-Port
RTS i
End Function
Public Function
SDA(i) As Boolean
'Die Daten werden über DTR am COM-Port
geschreiben
DTR i
End Function
Public Function
SDA_in() As Boolean
'Die SDA-Leitung wird über DSR am COM-Port
wieder zurückgelesen
If DSR =
1 Then
SDA_in =
True
Else
SDA_in = False
End If
End
Function
Public Function
I2C_INT() As Boolean
'Die INT-Leitung der Eingabekarten wird über
CTS am COM-Port überwacht
If
CTS = 1 Then
I2C_INT =
True
Else
I2C_INT = False
End If
End
Function
Public Sub i2cInit()
'Ruhezustand SDA=high und SCL=high
SDA 1
SCL 1
If Not SDA_in
Then MsgBox ("Keine Antwort vom
I2C-Seriell Interface")
End Sub
Public Sub
i2cStart()
'START => SDA=low anschließend
SCL=low
SDA 0
SCL 0
End Sub
Public Sub i2cStop()
'STOP => SDA=high, dann SCL=high
SDA
0
SDA 1
SCL 1
End Sub
Public Sub i2cAck()
'ACKNOWLEDGE => Byte empfangen weitere Daten
senden
SDA 0
SCL 1
SCL 0
SDA 1
End Sub
Public Sub
i2cNoAck()
'NO ACKNOWLEDGE => Byte
empfangen - Keine weiteren Daten senden
SDA 1
SCL 1
SCL 0
End Sub
Function
i2cSlave(Adresse) 'Slave adressieren
' Die 8 Bits der Slaveadresse werden
nacheinander auf die SDA-Leitung
' gelegt und jeweils mit einem
Impuls auf der SCL-Leitung bestätigt.
' nach dem Stop-Befehl
quittiert der Slave den Empfnag der Daten
Bit = 128
For n = 1 To 8 '8
Bits senden
If
(Adresse And Bit) = 0
Then SDA 0 Else
SDA 1 'Daten übertragen
SCL 1 'pos Impuls
SCL 0
'neg Impuls
Bit = Bit /
2
Next n
SDA 1
'SDA high setzen - wird vom Slave
heruntergezogen
SCL 1 '9. Impuls
' Slave antwortet mit neg. Flanke
If SDA_in Then
MsgBox ("Kein I2C-Slave an Adresse " & Adresse)
i2cSlave = False
Else
'ok
i2cSlave =
True
End If
SCL 0
End Function
Public Function
i2cIn() 'Wert vom Slave empfangen
' Der Master sendet 8 Impulse auf die
SCL-Leitung und erhält die
' high- oder low-Signale über die
SDA-Leitung zurück.
Bit = 128
Wert = 0
SDA 1
For n = 1 To
8
SCL 1 'pos Impuls
If SDA_in Then
Wert = Wert + Bit
SCL 0 'neg
Impuls
Bit = Bit / 2
Next n
i2cIn = Wert
End Function
Public Sub
i2cOut(Wert) 'Wert zum Slave senden
Dim Bit, n
'
Die 8 Datenbits werden nacheinander auf die SDA-Leitung gelegt und
' jeweils mit einem Impuls auf der SCL-Leitung bestätigt.
'
nach dem neunten Impuls quittiert der Slave den Empfnag der Daten
Bit = 128
For n = 1
To 8 '8 Bits
senden
If (Wert And Bit) = 0 Then SDA 0
Else SDA 1 'Daten
übertragen
SCL 1 'pos Impuls
SCL 0 'neg Impuls
Bit = Bit / 2
Next n
'
9. Impuls
SDA 1
SCL 1 'pos Impuls
' Slave antwortet mit neg. Flanke
If SDA_in Then
MsgBox ("keine quittierung der Daten vom Slave " & Adresse)
SCL 0 'neg Impuls
End Sub
Private Sub Command_OpenCom_Click()
If Command_OpenCom.Caption = "COM
öffnen" Then
'Serielle Schnittstelle öffnen
If OPENCOM(Combo_Com.Text & ":"
& Combo_Baud.Text & ",n,8,1") = 0 Then
MsgBox ("Fehler, kann " & Combo_Com.Text & " nicht öffnen")
Else
SDA 1 'I2C-Interface testen
If Not SDA_in
Then
MsgBox ("Keine Antwort vom I2C-Seriell
Interface")
Else
Command_OpenCom.Caption = "COM
schließen"
'I2C-Bus initialisieren
i2cInit
i2cStart
i2cStop
End If
End If
Else/font>
CLOSECOM 'Serielle Schnittstelle schließen
Command_OpenCom.Caption = "COM öffnen"
End If
End Sub
Private Sub Command_Schreiben_Click()
On Error GoTo ErrorHandler
If TextBox_SWert.Text > 255
Then
MsgBox ("Im Feld WERT nur Zahlen <= 255 erlaubt")
Else
i2cStart
If i2cSlave(Combo_SAdresse.Text)
Then 'Bus-Adresse
des PCF 8574 schreiben
If CheckBox_inv.Value = True
Then
i2cOut 255 - TextBox_SWert.Text
'invertierten Wert ausgeben
Else
i2cOut TextBox_SWert.Text
'Ausgabewert zum Portbaustein schreiben
End If
End If
i2cStop
End If
ErrorHandler:
Select Case Err.Number
'Fehlernummer auswerten.
Case 0 'ok
Case 13
MsgBox ("Im Feld WERT nur Zahlen erlaubt")
TextBox_SWert.Text = ""
Case Else
MsgBox ("Fehler " & Err.Number)
End Select
End Sub
|
