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

Public Sub i2cLCD(Text As String) 'Zeichen zum LCD-Display senden
Dim i, zeichen

Text = Left$(Text & " ", 8) '8 Zeichen abschneiden

For i = 1 To 8
zeichen = Mid$(Text, i, 1)

  Select Case zeichen
   Case "A": i2cOut 184: i2cOut 141
   Case "B": i2cOut 185: i2cOut 210
   Case "C": i2cOut 153: i2cOut 144
   Case "D": i2cOut 153: i2cOut 153
   Case "E": i2cOut 185: i2cOut 148
   Case "F": i2cOut 184: i2cOut 132
   Case "G": i2cOut 153: i2cOut 149
   Case "H": i2cOut 176: i2cOut 13
   Case "I": i2cOut 13: i2cOut 176
   Case "J": i2cOut 9: i2cOut 153
   Case "K": i2cOut 176: i2cOut 66
   Case "L": i2cOut 145: i2cOut 16
   Case "M": i2cOut 146: i2cOut 11
   Case "N": i2cOut 146: i2cOut 73
   Case "O": i2cOut 153: i2cOut 153
   Case "P": i2cOut 184: i2cOut 140
   Case "Q": i2cOut 153: i2cOut 217
   Case "R": i2cOut 184: i2cOut 204
   Case "S": i2cOut 169: i2cOut 149
   Case "T": i2cOut 12: i2cOut 160
   Case "U": i2cOut 145: i2cOut 25
   Case "V": i2cOut 208: i2cOut 2
   Case "W": i2cOut 208: i2cOut 73
   Case "X": i2cOut 66: i2cOut 66
   Case "Y": i2cOut 6: i2cOut 2
   Case "Z": i2cOut 73: i2cOut 146
   Case "1": i2cOut 4: i2cOut 32
   Case "2": i2cOut 57: i2cOut 156
   Case "3": i2cOut 41: i2cOut 157
   Case "4": i2cOut 160: i2cOut 13
   Case "5": i2cOut 169: i2cOut 149
   Case "6": i2cOut 185: i2cOut 21
   Case "7": i2cOut 104: i2cOut 134
   Case "8": i2cOut 185: i2cOut 157
   Case "9": i2cOut 168: i2cOut 157
   Case "0": i2cOut 153: i2cOut 153
   Case "°": i2cOut 168: i2cOut 140
   Case Else: i2cOut 0: i2cOut 0
  End Select
Next i

End Sub