Option Explicit
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_TEXT_2x16.Visible = True
Command_TEXT_4x16.Visible = True
Command_TEXT_4x20.Visible = True
Command_DISPLAY.Visible = True
Command_RESET.Visible = True
Command_LICHT.Visible = True
Command_CR.Visible = True
Command_CL.Visible = True
Command_AR.Visible = True
Command_AL.Visible = True
Command_ZEICHEN_DEFINIEREN.Visible = True
Command_ZEICHEN_AUSGEBEN.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_TEXT_2x16.Visible = False
Command_TEXT_4x16.Visible = False
Command_TEXT_4x20.Visible = False
Command_DISPLAY.Visible = False
Command_RESET.Visible = False
Command_LICHT.Visible = False
Command_CR.Visible = False
Command_CL.Visible = False
Command_AR.Visible = False
Command_AL.Visible = False
Command_ZEICHEN_DEFINIEREN.Visible = False
Command_ZEICHEN_AUSGEBEN.Visible = False
TextBox_VERSION.Text = "Version ?.?"
TextBox_STATUS.Text = "Status ??"
TextBox_IDENT.Text = "?"
TextBox_SPEED.Text = "?"
End If
End Sub
Private Sub Command_IDENT_Click()
Dim A
'Befehl 16: INDENT (nähere Beschreibung siehe I2C-Modem-Befehle)
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 (nähere Beschreibung siehe I2C-Modem-Befehle)
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 (nähere Beschreibung siehe I2C-Modem-Befehle)
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_LICHT_Click()
SENDBYTE (65) 'Befehl 64 = Multiwrite + (Anzahl Bytes -1)
SENDBYTE (Combo_Adresse.Text) 'Bus-Adresse des Gateways schreiben
SENDBYTE (16) 'Steuerbyte (Licht EIN/AUS)
SENDBYTE (0) 'Datenbyte (Dummy)
TextBox_STATUS.Text = M_Stat(READBYTE) 'Status vom Gateway Abfragen
End Sub
Private Sub Command_RESET_Click()
'Display initialisieren
'Welche Befehle hier gesendet werden müssen entnehmen
'Sie bitte dem Datenblatt des Displayherstellers
Dim stat, I2C_Adr
I2C_Adr = Combo_Adresse.Text
'Reset mit Pausen
stat = LCD_Befehl_out(1, 48) '1. Reset
DELAY (5) 'Wartezeit nach Datenblatt
stat = LCD_Befehl_out(1, 48) '2. Reset
DELAY (5) 'Wartezeit nach Datenblatt
stat = LCD_Befehl_out(1, 48) '3. Reset
DELAY (5) 'ÄWartezeit nach Datenblatt
'Einstellungen
stat = LCD_Befehl_out(1, 56) '8 Bit Interface, 2 Lines
stat = LCD_Befehl_out(1, 8) 'Display OFF
stat = LCD_Befehl_out(1, 1) 'Display Clear
stat = LCD_Befehl_out(1, 2) 'Cursor HOME
stat = LCD_Befehl_out(1, 14) 'Display on, Cursor on, Cursor nicht blinken
End Sub
Private Sub Command_DISPLAY_Click()
Dim stat, Wert
Wert = 8 'Bit 3 = TRUE
If CheckBox_Display.Value = True Then Wert = Wert + 4 'Bit 2
If CheckBox_Cursor.Value = True Then Wert = Wert + 2 'Bit 1
If CheckBox_Blinken.Value = True Then Wert = Wert + 1 'Bit 0
' Wert zum Display schreiben
Call LCD_Befehl_out(1, Wert)
End Sub
Private Sub Command_CR_Click() 'CURSOR nach Rechts verschieben
Dim stat
Call LCD_Befehl_out(1, 20) 'Cursor nach rechts verschieben
End Sub
Private Sub Command_CL_Click() 'CURSOR nach Links verschieben
Call LCD_Befehl_out(1, 16) 'Cursor nach Links verschieben
End Sub
Private Sub Command_AR_Click() 'Anzeige nach Rechts verschieben
Call LCD_Befehl_out(1, 28) 'Cursor nach rechts verschieben
End Sub
Private Sub Command_AL_Click() 'Anzeige nach Links verschieben
Call LCD_Befehl_out(1, 24) 'Cursor nach Links verschieben
End Sub
Private Sub Command_TEXT_2x16_Click()
Dim stat
stat = LCD_Befehl_out(1, 128) 'DD-Ram Adresse Zeile 1 80h
stat = LCD_Text_out(1, Zeile1.Text, 16)
stat = LCD_Befehl_out(1, 192) 'DD-Ram Adresse Zeile 2 C0h
stat = LCD_Text_out(1, Zeile2.Text, 16)
End Sub
Private Sub Command_TEXT_4x16_Click()
Dim stat
stat = LCD_Befehl_out(1, 128) 'DD-Ram Adresse Zeile 1 80h
stat = LCD_Text_out(1, Zeile1.Text, 16)
stat = LCD_Befehl_out(1, 192) 'DD-Ram Adresse Zeile 2 C0h
stat = LCD_Text_out(1, Zeile2.Text, 16)
stat = LCD_Befehl_out(1, 144) 'DD-Ram Adresse Zeile 1 90h
stat = LCD_Text_out(1, Zeile3.Text, 16)
stat = LCD_Befehl_out(1, 208) 'DD-Ram Adresse Zeile 2 D0h
stat = LCD_Text_out(1, Zeile4.Text, 16)
End Sub
Private Sub Command_TEXT_4x20_Click()
Dim stat
stat = LCD_Befehl_out(1, 128) 'DD-Ram Adresse Zeile 1 80h
stat = LCD_Text_out(1, Zeile1.Text, 20)
stat = LCD_Befehl_out(1, 192) 'DD-Ram Adresse Zeile 2 C0h
stat = LCD_Text_out(1, Zeile2.Text, 20)
stat = LCD_Befehl_out(1, 148) 'DD-Ram Adresse Zeile 1 94h
stat = LCD_Text_out(1, Zeile3.Text, 20)
stat = LCD_Befehl_out(1, 212) 'DD-Ram Adresse Zeile 2 D4h
stat = LCD_Text_out(1, Zeile4.Text, 20)
End Sub
Function M_Stat(Status_Byte) 'Status vom Modem abfragen
Dim A
Select Case Status_Byte
Case -1
M_Stat = "keine Verbindung"
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 Function LCD_Befehl_out(E1_2, Befehl)
Dim stat
SENDBYTE (65) '2 Bytes senden
SENDBYTE (Combo_Adresse.Text) 'Bus-Adresse des Gateways schreiben
SENDBYTE (E1_2) 'Steuerbyte (zum LCD am E1 oder E2)
SENDBYTE (Befehl) 'Datenbyte (Befehl absetzen)
stat = (READBYTE) 'Status vom Gateway Abfragen
LCD_Befehl_out = stat 'Status an die Funktion übergeben
If stat <> 192 Then
MsgBox (M_Stat(stat)) 'Fehlermeldung ausgeben
End If
End Function
Private Function LCD_Text_out(E1_2, Text$, Zeichen)
Dim stat, SteuBy, T$, z$, S, AnzS, i, anzB
If E1_2 = 2 Then
SteuBy = 6 'Steuerbyte (RS=1 und E2=1)
Else
SteuBy = 5 'Steuerbyte (RS=1 und E1=1)
End If
'Wenn Zeichenanzahl angegeben ist String anpassen
If Zeichen > 0 Then
T$ = Left$(Text$ & Space(Zeichen), Zeichen)
Else
T$ = Text$
End If
'Das Modem kann max. 16 Byte auf einmal übertragen
'1 Zeichen = 1 Datenbyte + 1 Steuerbyte
'Anzahl Schleifen a. 8 Zeichen ermitteln
AnzS = Fix(Len(T$) / 8)
If Len(T$) > AnzS * 8 Then AnzS = AnzS + 1
For S = 0 To AnzS - 1
anzB = Len(T$) - S * 8
If anzB > 8 Then anzB = 8
SENDBYTE ((64 + anzB * 2) - 1) 'Befehl 64 + Anzahl Bytes -1
SENDBYTE (Combo_Adresse.Text) 'Bus-Adresse des Gateways schreiben
For i = 1 To anzB 'Zeichen übergeben
z$ = Mid$(T$, i + (S * 8), 1) 'Zeichen extrahieren
SENDBYTE (SteuBy) 'Steuerbyte
SENDBYTE (Asc(z$)) 'Datenbyte (Zeichencode)
Next i
stat = READBYTE 'Status vom Modem abfragen
TextBox_STATUS = M_Stat(stat) 'Status anzeigen
If stat <> 192 Then
MsgBox (M_Stat(stat)) 'Fehlermeldung ausgeben
Exit For 'Bei Fehler => ende
End If
Next
LCD_Text_out = stat 'Status an die Funktion übergeben
End Function
Private Sub Command_ZEICHEN_DEFINIEREN_Click()
'Eigene Zeichen für das LCD-Display im CGRAM ablegen
Dim stat, SteuBy, i, ii, Wert
stat = LCD_Befehl_out(1, 64) 'CG-Ram Adresse Zeile 1 40h
If stat <> 192 Then Exit Sub
SteuBy = 5 'Steuerbyte (RS=1 RW=0 E1=1)
For i = 0 To 7 '8 Zeichen übertragen
SENDBYTE (79) '16 Bytes senden
SENDBYTE (Combo_Adresse.Text) 'Bus-Adresse des Gateways schreiben
For ii = 0 To 7 '8 Werte / Zeichen
Wert = Cells(i + 13, ii + 3) 'Werte liegen in der Tabelle ab z13s3
SENDBYTE (SteuBy) 'Steuerbyte senden
SENDBYTE (Wert) 'Datenbyte (Zeichen)
Next ii
stat = READBYTE 'Status vom Modem abfragen
TextBox_STATUS = M_Stat(stat) 'Status anzeigen
If stat <> 192 Then
MsgBox (M_Stat(stat)) 'Fehlermeldung ausgeben
Exit For 'Bei Fehler => ende
End If
Next i
End Sub
Private Sub Command_ZEICHEN_AUSGEBEN_Click()
'Ersten acht Zeichen des LCDs in der ersten Zeile ausgeben
'Diese Zeichen können ggf. selbst definiert werden
Dim stat, z$, i, SteuBy
SteuBy = 5 'Steuerbyte (RS=1 E1=1)
stat = LCD_Befehl_out(1, 128) 'DD-Ram Adresse Zeile 1 80h
If stat <> 192 Then Exit Sub
SENDBYTE (79) '16 Bytes senden
SENDBYTE (Combo_Adresse.Text) 'Bus-Adresse des Gateways schreiben
For i = 0 To 7
SENDBYTE (SteuBy) 'Steuerbyte senden
SENDBYTE (i) 'Datenbyte (Zeichen)
Next i
stat = READBYTE 'Status vom Modem abfragen
TextBox_STATUS = M_Stat(stat) 'Status anzeigen
End Sub
| 
