Home    Impressum / Datenschutz    Shop    Download    Links     Blog  

Das I2C-RS232-Modem

Kommunikation zum I2C-Bus über ein Excel-Makro mit "port.dll"

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
I2C-Modem-Test.xls und port.dll (83 kB)
Excel-Makro mit je einem Beispiel zur Ansteuerung der I2C-Ausgabekarte,
I2C-Eingabekarte, und dem Temperatursensor LM75

 

Bausätze können Sie günstig in unserem Onlineshop in der Rubrik
"I2C-Komponenten" bestellen.