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_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
Command_RAM_AUSLESEN.Visible = True
TextBox_STATUS.Text = "COM geöffnet 19200,n,8,1"
Else
'Serielle Schnittstelle schließen
CLOSECOM
'Buttons ausbelnden
Command_OpenCom.Caption = "COM öffnen"
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
Command_RAM_AUSLESEN.Visible = False
TextBox_STATUS.Text = "COM geschlossen"
End If
End Sub
Private Sub Command_LICHT_Click()
SENDBYTE (170) 'FF
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 I2C_Adr
I2C_Adr = Combo_Adresse.Text
'Reset mit Pausen
Call LCD_Befehl_out(1, 48) '1. Reset
DELAY (1) 'Wartezeit nach Datenblatt
Call LCD_Befehl_out(1, 48) '2. Reset
DELAY (1) 'Wartezeit nach Datenblatt
Call LCD_Befehl_out(1, 48) '3. Reset
DELAY (1) 'Wartezeit nach Datenblatt
'Einstellungen
Call LCD_Befehl_out(1, 56) '8 Bit Interface, 2 Lines
Call LCD_Befehl_out(1, 8) 'Display OFF
Call LCD_Befehl_out(1, 1) 'Display Clear
Call LCD_Befehl_out(1, 2) 'Cursor HOME
Call LCD_Befehl_out(1, 14) 'Display on, Cursor on, Cursor nicht blinken
End Sub
Private Sub Command_DISPLAY_Click()
Dim 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
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()
Call LCD_Befehl_out(1, 128) 'DD-Ram Adresse Zeile 1 80h
Call LCD_Text_out(1, Zeile1.Text, 16)
Call LCD_Befehl_out(1, 192) 'DD-Ram Adresse Zeile 2 C0h
Call LCD_Text_out(1, Zeile2.Text, 16)
End Sub
Private Sub Command_TEXT_4x16_Click()
Call LCD_Befehl_out(1, 128) 'DD-Ram Adresse Zeile 1 80h
Call LCD_Text_out(1, Zeile1.Text, 16)
Call LCD_Befehl_out(1, 192) 'DD-Ram Adresse Zeile 2 C0h
Call LCD_Text_out(1, Zeile2.Text, 16)
Call LCD_Befehl_out(1, 144) 'DD-Ram Adresse Zeile 1 90h
Call LCD_Text_out(1, Zeile3.Text, 16)
Call LCD_Befehl_out(1, 208) 'DD-Ram Adresse Zeile 2 D0h
Call LCD_Text_out(1, Zeile4.Text, 16)
End Sub
Private Sub Command_TEXT_4x20_Click()
Call LCD_Befehl_out(1, 128) 'DD-Ram Adresse Zeile 1 80h
Call LCD_Text_out(1, Zeile1.Text, 20)
Call LCD_Befehl_out(1, 192) 'DD-Ram Adresse Zeile 2 C0h
Call LCD_Text_out(1, Zeile2.Text, 20)
Call LCD_Befehl_out(1, 148) 'DD-Ram Adresse Zeile 1 94h
Call LCD_Text_out(1, Zeile3.Text, 20)
Call LCD_Befehl_out(1, 212) 'DD-Ram Adresse Zeile 2 D4h
Call LCD_Text_out(1, Zeile4.Text, 20)
End Sub
Function M_Stat(Status_Byte) 'Status vom Gateway abfragen
Dim A
Select Case Status_Byte
Case -1
M_Stat = "keine Verbindung"
Case 96
M_Stat = "OK"
Case Else
M_Stat = "FEHLER " & Status_Byte
End Select
End Function
Private Function LCD_Befehl_out(E1_2, Befehl)
Dim stat, RB
SENDBYTE (170) 'FF
SENDBYTE (Combo_Adresse.Text) 'Bus-Adresse des Gateways schreiben
SENDBYTE (E1_2) 'Steuerbyte (zum LCD am E1 oder E2)
SENDBYTE (Befehl) 'Datenbyte (Befehl absetzen)
Do 'Status vom Gateway Abfragen
RB = READBYTE 'Alle Bytes lesen
If RB = -1 Then Exit Do 'und das letzte ...
stat = RB
Loop
LCD_Befehl_out = stat 'an die Funktion übergeben
End Function
Private Function LCD_Text_out(E1_2, Text$, Zeichen)
Dim stat, SteuBy, T$, z$, S, AnzS, i, anzB, RB
If E1_2 = 2 Then
SteuBy = 6 'Steuerbyte (RW=0 RS=1 E2=1 E1=0)
Else
SteuBy = 5 'Steuerbyte (RW=0 RS=1 E2=0 E1=1)
End If
'Wenn Zeichenanzahl angegeben String anpassen
If Zeichen > 0 Then
T$ = Left$(Text$ & Space(Zeichen), Zeichen)
Else
T$ = Text$
End If
SENDBYTE (170) 'FF
SENDBYTE (Combo_Adresse.Text) 'Bus-Adresse des Gateways schreiben
For i = 1 To Len(T$)
z$ = Mid$(T$, i, 1) 'Zeichen extrahieren
SENDBYTE (SteuBy) 'Steuerbyte (Control-Byte)
SENDBYTE (Asc(z$)) 'Datenbyte (Zeichencode)
Next
Do 'Status vom Gateway Abfragen
RB = READBYTE 'Alle Bytes lesen
If RB = -1 Then Exit Do 'und das letzte ...
stat = RB
Loop
stat = READBYTE 'Status vom Gateway Abfragen
LCD_Text_out = stat '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 <> 96 Then Exit Sub
SteuBy = 5 'Steuerbyte (RW=0 RS=1 E2=0 E1=1)
SENDBYTE (170) 'FF
SENDBYTE (Combo_Adresse.Text) 'Bus-Adresse des Gateways schreiben
For i = 0 To 7 '8 Zeichen übertragen
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
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 (RW=0 RS=1 E2=0 E1=1)
stat = LCD_Befehl_out(1, 128) 'DD-Ram Adresse Zeile 1 80h
If stat <> 96 Then Exit Sub
SENDBYTE (170) 'FF
SENDBYTE (Combo_Adresse.Text) 'Bus-Adresse des Gateways schreiben
For i = 0 To 7
SENDBYTE (SteuBy) 'Steuerbyte (Control-Byte)
SENDBYTE (i) 'Datenbyte (Zeichen)
Next i
End Sub
Private Sub Command_RAM_auslesen_Click()
'8 Bytes aus dem RAM-Inhalt des LCDs auslesen
' und in die Tabelle eintragen
Dim i, SteuBy, Wert, Adr, stat
'Ram Adresse aus Textbox in Dezimal wandeln
Adr = CLng("&H" & TextBox_RAM_ADR.Text)
'Register einstellen
stat = LCD_Befehl_out(1, Adr)
If stat <> 96 Then Exit Sub
'8 Bytes vom LCD lesen
SteuBy = 13 'Steuerbyte (RW=1 RS=1 E2=0 E1=1)
SENDBYTE (170) 'FF
SENDBYTE (Combo_Adresse.Text) 'Bus-Adresse des Gateways
For i = 0 To 7
SENDBYTE (SteuBy) 'Steuerbyte (Control-Byte)
SENDBYTE (0) 'Dummy-Bites schreiben
Next i
'Werte vom Eingangsbuffer lesen und in die Tabelle eintragen
For i = 0 To 7
Wert = READBYTE
Cells(30, i + 3) = Wert
If Wert > 0 Then
Cells(31, i + 3) = Chr$(Wert)
End If
Next i
End Sub
|
