Private Sub Command_IDENT_Click()
Dim A
'Befehl 16: INDENT
'Modem sendet I2C-OK. Dieser Befehl kann dazu verwendet
'werden, das I2C-Modem an der 'RS232 zu erkennen.
'Empfängt das I2C-Modem 'diesen Befehl,
'wird ein Datenbyte generiert,
'in dem die Bits 6 und 7 gesetzt sind. (192 dez)
SENDBYTE (16) 'Befehl IDENT absetzen
TextBox_IDENT.Text = M_Stat(READBYTE) 'Status vom Modem Abfragen
End Sub
Private Sub Command_SPEED_Click()
Dim A
'Befehl 32: SPEED
'Die Busgeschwindigkeit des I2C-Busses wird auf den
'gewünschten Wert eingestellt.
'Der Defaultwert ist Null und stellt die maximale
'Busgeschwindigkeit ein.
' Folgende Werte sind mäglich:
' 0 = 43 KHz, 1 = 28 KHz, 2 = 17 KHz, 3 = 9 KHz
' 4 = 5 KHz, 5 = 2,5 KHz, 6 = 1,3 KHz
' Beispiel: SENDBYTE (32 + 5) stellt den Bustakt auf 2,5 kHz ein
' Antwort 192 = OK
SENDBYTE (32 + Combo_SPEED.ListIndex)
TextBox_SPEED.Text = M_Stat(READBYTE) 'Status vom Modem Abfragen
End Sub
Private Sub Command_VERSION_Click()
Dim By1, By2
'Befehl 80: VERSION
'Das I2C-Modem antwortet mit zwei Byte.
'Werden die Bytes in der Reihenfolge
'zusammengesetzt so ergibt sich die
'Versionsnummer der geladenen Firmware
SENDBYTE (80) 'Befehl 80 = Versionsabfrage
By1 = READBYTE '1. Byte lesen
By2 = READBYTE '2. Byte lesen
TextBox_VERSION.Text = "Version: " & By1 & "." & By2
End Sub
Private Sub Command_STATUS_Click()
Dim A
'Befehl 48: STATUS
'liest er die Zustände der Leitungen
'SDA, SCL und INT aus.
'Diese werden zusammen mit einem OK in einem
'Byte an den PC zurückgesendet.
SENDBYTE (48) 'Befehl 48 = Statusabfrage
A = READBYTE 'Status vom Modem abfragen
If (A And 1) > 0 Then
TextBox_STATUS_SDA.BackColor = vbGreen
Else
TextBox_STATUS_SDA.BackColor = vbWhite
End If
If (A And 2) > 0 Then
TextBox_STATUS_SCL.BackColor = vbYellow
Else
TextBox_STATUS_SCL.BackColor = vbWhite
End If
If (A And 4) > 0 Then
TextBox_STATUS_INT.BackColor = vbWhite
Else
TextBox_STATUS_INT.BackColor = vbRed
End If
TextBox_STATUS.Text = A & " = " & Dec2Bin(A)
End Sub
Private Sub Command_SCHREIBEN_Click()
Dim A, W
'Befehl 64: WRITE
'Mit dem Befehl werden 1-16 Bytes zum I2C-Bus geschrieben
On Error GoTo ErrorHandler 'Für falsche Eingaben im Feld
If TextBox_SWert.Text > 255 Then
MsgBox ("Im Feld WERT nur Zahlen <= 255 erlaubt")
Else
If CheckBox_Sinv.Value = True Then
W = 255 - TextBox_SWert.Text
'invertierten Ausgabewert zum PCF schreiben
Else
W = TextBox_SWert.Text
'Ausgabewert zum Portbaustein schreiben
End If
SENDBYTE (64) 'Befehl 64 = Multiwrite + (Anzahl Bytes -1)
SENDBYTE (Combo_SAdresse.Text) 'Bus-Adresse des PCF 8574
SENDBYTE (W) 'Wert ausgeben
End If
TextBox_SCHREIBEN.Text = M_Stat(READBYTE) 'Status vom Modem Abfragen
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
Private Sub Command_LESEN_Click()
Dim A, W
'Befehl 128: READ
'Mit dem Befehl werden 1-16 Bytes vom I2C-Bus ausgelesen
SENDBYTE (128) 'Befehl 128 = Multiread + (Anzahl Bytes -1)
SENDBYTE (Combo_LAdresse.Text) 'Bus-Adresse des PCF 8574 schreiben
A = READBYTE 'Status vom Modem abfragen
TextBox_LESEN.Text = M_Stat(A) 'Status vom Modem Abfragen
If A = 192 Then
W = READBYTE 'Wert vom PCF lesen
If CheckBox_Linv.Value = True Then
TextBox_LWert.Text = 255 - W 'Wert invert. in Textbox eintragen
Else
TextBox_LWert.Text = W 'Wert in Textbox eintragen
End If
End If
'Lesepuffer leeren
Do: A = READBYTE: Loop Until A = -1
End Sub
Private Sub Command_LM75_Click()
Dim By1, By2, Temperatur, A, W
'Befehl 128: READ
'Mit dem Befehl werden 1-16 Bytes vom I2C-Bus ausgelesen
SENDBYTE (128 + 1) 'Befehl 128 = Multiread + (Anzahl Bytes -1)
SENDBYTE (Combo_LM75_Adresse.Text) 'Bus-Adresse des LM75
A = READBYTE 'Status vom Modem abfragen
TextBox_LM75.Text = M_Stat(A) 'Status vom Modem Abfragen
If A = 192 Then
By1 = READBYTE '1. Byte Wert vom LM75 lesen
By2 = READBYTE '2. Byte lesen
If (By1 And 128) = 0 Then
Temperatur = By1 'Temperatur Vorkomma >= 0°C
Else
Temperatur = By1 - 255 'Temperatur Vorkomma < 0°C
End If
If (By2 And 128) = 0 Then
TextBox_Temperatur.Text = Temperatur & ",0 °C"
Else
TextBox_Temperatur.Text = Temperatur + 0.5 & " °C"
End If
End If
'Lesepuffer leeren
Do: A = READBYTE: Loop Until A = -1
End Sub
Function M_Stat(Status_Byte) 'Status vom Modem abfragen
Dim A
Select Case Status_Byte
Case -1
M_Stat = ""
Case 2
M_Stat = "kein Slave an dieser Adresse"
Case 4
M_Stat = "Slave hat Daten nicht quittiert"
Case 16
M_Stat = "unbekanntes Modem-Kommando"
Case 192
M_Stat = "OK"
Case Else
M_Stat = "FEHLER " & Status_Byte
End Select
End Function
Private Sub Command_OpenCom_Click()
If Command_OpenCom.Caption = "COM öffnen" Then
'Serielle Schnittstelle öffnen
If OPENCOM(Combo_Com.Text & ":" & "19200,n,8,1") = 0 Then
MsgBox ("Fehler, kann " & Combo_Com.Text & " nicht öffnen")
End If
'Buttons einbelnden
Command_OpenCom.Caption = "COM schließen"
Command_IDENT.Visible = True
Command_SPEED.Visible = True
Command_VERSION.Visible = True
Command_STATUS.Visible = True
Command_LESEN.Visible = True
Command_SCHREIBEN.Visible = True
Command_LM75.Visible = True
Else
'Serielle Schnittstelle schließen
CLOSECOM
'Buttons ausbelnden
Command_OpenCom.Caption = "COM öffnen"
Command_IDENT.Visible = False
Command_SPEED.Visible = False
Command_VERSION.Visible = False
Command_STATUS.Visible = False
Command_LESEN.Visible = False
Command_SCHREIBEN.Visible = False
Command_LM75.Visible = False
TextBox_STATUS_SDA.BackColor = vbWhite
TextBox_STATUS_SCL.BackColor = vbWhite
TextBox_STATUS_INT.BackColor = vbWhite
TextBox_VERSION.Text = "Version ?.?"
TextBox_STATUS.Text = "Status ??"
End If
End Sub
Private Function Bin2Dec(ByVal Bin As String) As Long
' Diese Funktion stammt von http://www.activevb.de - Danke :-)
' Von Binaer nach Dezimal umrechnen
Dim i As Long, lngLen As Long
lngLen = Len(Bin) ' Länge der Binärzahl
For i = lngLen To 1 Step -1 ' Für jede Stelle die Schleife
Bin2Dec = Bin2Dec + IIf(Mid$(Bin, i, 1) = "1", 2 ^ (lngLen - i), 0)
' umrechnen in Dezimal
Next i
End Function
Private Function Dec2Bin(ByVal Dec As Long) As String
' Diese Funktion stammt von http://www.activevb.de - Danke :-)
' Von Dezimal in Binaer
Dim Rest As Long
Do
Rest = Dec Mod 2 ' Den Rest bei einer Div. durch 2 errechnen
Dec2Bin = Rest & Dec2Bin ' Rest und bishereige Binaer Zahl zusammen
Dec = Dec \ 2 ' Dezimal Zahl durch 2 Teilen
Loop Until Dec = 0 ' Solange bis Dezimal-Zahl = 0 ist
End Function
| Beispiele als Excel Makro |
 |
Bausätze können Sie günstig in unserem Onlineshop in der Rubrik
"I2C-Komponenten" bestellen. |
|
