'© 2003 Christof Rueß - www.hobby-elektronik.de.vu
'Die Verwendung dieses Moduls ist ist Freeware, solange diese Zeilen erhalten bleiben!
'Anschlussbelegung für HD4478(kompatible)-Displays (_nicht_ 4x40 und/oder höher...)
'Computer (LPT-Port, D-SUB-Stecker) - Display
' 1 (Datatrobe) - 6 (Enable)
' 2 (D1) - 7 (DB0)
' 3 (D2) - 8 (DB1)
' 4 (D2) - 9 (DB2)
' 5 (D2) - 10 (DB3)
' 6 (D2) - 11 (DB4)
' 7 (D2) - 12 (DB5)
' 8 (D2) - 13 (DB6)
' 9 (D2) - 14 (DB7)
' 14 (Autofeed) - 5 (R/W - Read/Write)
' 16 (Init) - 4 (RS - Register Select)
' 18 - 25 (GND) - 1 (GND)
'Zusätzlich ans Display:
'Masse an Pin 1 (Vss) & evtl. an 16 (LED K)
' +5V an Pin 2 (Vdd) & evtl. (mit Vorwiderstand!! - dimension: 50 Ohm) an 15 (A/Vee)
'Kontrastspannung an Pin 3 (10 oder 20kOhm-Poti - Einsteller an Pin 3 die anderen zwei jeweils an +5V und GND)
'Deklaration für die Portansteuerung (auch für Win2k & WinXP) und für eine Pause, da das Display auch rechenzeit hat...
Private Declare Sub PortOut32 Lib "inpout32.dll" Alias "Out32" (ByVal PortAddress As Integer, ByVal Value As Integer)
Public Declare Function PortIn32 Lib "inpout32.dll" Alias "Inp32" (ByVal PortAddress As Integer) As Integer
'Da man mit mit der "normalen" Anschlussbelegung des Displays das Busy-Flag nicht auslesen kann, wird diese Routine benötigt.
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliSeconds As Long)
'Damit das Auslesen der Bilder für die selbstdefinierten Zeichen schneller geht, bediene ich mich dieser API.
Private Declare Function GetPixel Lib "gdi32" (ByVal _
hDC As Long, ByVal x As Long, ByVal y As Long) _
As Long
'Die Displaygrößen für die Adressfindung definieren.
'Das 2x24 wurde auskommentiert, da ich keine Adress-Codes fand.
Public Enum DspSize
s2x08 = 0
s1x16 = 1
s2x16 = 0
s4x16 = 3
s2x20 = 0
s4x20 = 5
's2x24 = 6
s2x40 = 0
End Enum
Public Enum CsrDir
crLeft = 0
crRight = 1
End Enum
'Hier werden die Zeilen für die eigenen Zeichen definiert.
'Die Function zum "richtigen" definieren der Zeichen folgt später...
Public Type DspOwnSymbol
Line0 As String
Line1 As String
Line2 As String
Line3 As String
Line4 As String
Line5 As String
Line6 As String
Line7 As String
End Type
'Diese Funktion zwei Funktionen stammen (leider) nicht von mir.
'Sie sind aber sehr nützlich...
'Hier werden Binäre Zahlen zu Dezimalen umgewandelt...
Public Function ConvertBintoDez(ByVal Bin As String) As Long
Dim x&, y&
Bin = Bin & String$(8 - Len(Bin), "0")
For x = 1 To Len(Bin)
If Mid$(Bin, x, 1) = "1" Then
y = y + 2 ^ (8 - x)
End If
Next x
ConvertBintoDez = y
End Function
'...und hier Dezimale zu Binären.
Public Function ConvertDeztoBin(ByVal Dez As Long) As String
Dim x%
If Dez >= 2 ^ 32 Then
Call MsgBox("Zahl ist größer als 32 Bit")
Exit Function
End If
Do
If (Dez And 2 ^ x) Then
ConvertDeztoBin = "1" & ConvertDeztoBin
Else
ConvertDeztoBin = "0" & ConvertDeztoBin
End If
x = x + 1
Loop Until 2 ^ x > Dez
ConvertDeztoBin = Format(ConvertDeztoBin, "00000000")
End Function
'Ausgabe an das LCD zum Testen. Diese Function kann weggelassen werden.
'In den Zeilen ist auch gut zu sehen, dass das R/W- und Enable-Signal wegen einer Eigenschaft des Druckerports invertiert werden müssen.
Public Function TestingOutLcd(ByVal LcdPort As Long, ByVal LcdDB7 As Boolean, ByVal LcdDB6 As Boolean, ByVal LcdDB5 As Boolean, ByVal LcdDB4 As Boolean, ByVal LcdDB3 As Boolean, _
ByVal LcdDB2 As Boolean, ByVal LcdDB1 As Boolean, ByVal LcdDB0 As Boolean, ByVal LcdRW As Boolean, ByVal LcdRS As Boolean)
PortOut32 LcdPort, ConvertBintoDez(IIf(LcdDB7 = True, 1, 0) & IIf(LcdDB6 = True, 1, 0) & IIf(LcdDB5 = True, 1, 0) & IIf(LcdDB4 = True, 1, 0) & _
IIf(LcdDB3 = True, 1, 0) & IIf(LcdDB2 = True, 1, 0) & IIf(LcdDB1 = True, 1, 0) & IIf(LcdDB0 = True, 1, 0))
'So, hier werden die Daten an die DB-Kanäle ausgegeben. Da man Booleans (komischerweise) nicht direkt als 1/0-Werte ausgeben kann,
'greife ich hier auf die IIF-Befehle zurück. Dann noch schnell nach Dezimal konvertiert und ab ans Display
PortOut32 LcdPort + 2, ConvertBintoDez("00000" & IIf(LcdRS = True, 1, 0) & IIf(LcdRW = True, 0, 1) & 0)
Sleep 1
PortOut32 LcdPort + 2, ConvertBintoDez("00000" & IIf(LcdRS = True, 1, 0) & IIf(LcdRW = True, 0, 1) & 1)
Sleep 1
End Function
'Ausgabe an das LCD, die ideal ist. Die DB-Kanäle werden über LcdData ausgegeben, Der Rest sollte bekannt sein ;)
Public Function OutLcd(ByVal LcdPort As Long, ByVal LcdData As Byte, ByVal LcdRW As Boolean, ByVal LcdRS As Boolean)
PortOut32 LcdPort, LcdData
'Hier ist die Dateiausgabe sehr simpel. "LcdData" wird schon als Byte angefordert. So ist ein Runtime-Error schon von vorne heraus ausgeschlossen...
PortOut32 LcdPort + 2, ConvertBintoDez("00000" & IIf(LcdRS = True, 1, 0) & IIf(LcdRW = True, 0, 1) & 0)
Sleep 0.1
PortOut32 LcdPort + 2, ConvertBintoDez("00000" & IIf(LcdRS = True, 1, 0) & IIf(LcdRW = True, 0, 1) & 1)
'Die Leitungen für E, R/W und RS werden über die fast gleiche Adresse, wie der "normale" LPT-Port angesteuert - einfach Portadresse + 2
Sleep 0.1 'Traurig aber wahr - bis jetzt war es mir nicht möglich, das Busyflag (BF) auszulesen - Das Signal des LCDs ist einfach zu schwach (~0,87 V)
End Function
'Da die HD44780-Displays (und kompatible) einen Charset haben,
'der etwas von dem ASCII-Zeichensatz abweicht, habe ich einen
'kleinen Parser geschrieben. Es ist zwar nicht sehr ideal, aber immerhin...
Public Function Parsetext(ByVal Text As String) As String
Dim Parsed As Long
Dim Temp As String
For x = 1 To Len(Text)
Select Case Asc(Mid(Text, x, 1))
Case 176: Parsed = 223 ' °
Case 167: Parsed = 32 ' § (als Leerzeichen, da kein Char vorhanden ist)
Case 178: Parsed = 32 ' ² (als Leerzeichen, da kein Char vorhanden ist)
Case 179: Parsed = 32 ' ³ (als Leerzeichen, da kein Char vorhanden ist)
Case 92: Parsed = 47 ' \
Case 180: Parsed = 96 ' ´ (als Leerzeichen, da kein Char vorhanden ist)
Case 126: Parsed = 243 ' ~ (als Leerzeichen, da kein Char vorhanden ist)
Case 246: Parsed = 239 ' ö
Case 228: Parsed = 225 ' ä
Case 252: Parsed = 245 ' ü
Case 246: Parsed = 239 ' Ö (nicht ideal)
Case 228: Parsed = 225 ' Ä (nicht ideal)
Case 252: Parsed = 245 ' Ü (nicht ideal)
Case 223: Parsed = 226 ' ß
Case 181: Parsed = 228 ' µ
'Case xxx: Parsed = xxx zum fortführen
Case Else: Parsed = Asc(Mid(Text, x, 1))
End Select
Temp = Temp & Chr(Parsed)
Next
Parsetext = Temp
End Function
'Hier kann man die DD-RAM-Adresse aus der Reihe und des Zeichens herausfinden.
'Ich habe die Displays, die gleich angesteuert werden wie das 2x08 auskommentiert.
'Für das "komische" 2x24 habe ich keine Address-Codes gefunden, deshalb wurde dies auch auskommentiert.
Public Function GetDDRamAddress(ByVal LcdSize As DspSize, ByVal LcdRow As Long, ByVal LcdColumn)
If LcdSize = 0 Then '2x8
Select Case LcdRow
Case 1: GetDDRamAddress = -1 + LcdColumn
Case 2: GetDDRamAddress = 63 + LcdColumn
End Select
ElseIf LcdSize = 1 Then '1x16
If LcdColumn <= 8 Then
GetDDRamAddress = -1 + LcdColumn
Else
GetDDRamAddress = 63 + LcdColumn
End If
'ElseIf LcdSize = 2 Then '2x16
' Select Case LcdRow
' Case 1: GetDDRamAddress = -1 + LcdColumn
' Case 2: GetDDRamAddress = 63 + LcdColumn
' End Select
ElseIf LcdSize = 3 Then '4x16
Select Case LcdRow
Case 1: GetDDRamAddress = -1 + LcdColumn
Case 2: GetDDRamAddress = 63 + LcdColumn
Case 3: GetDDRamAddress = 15 + LcdColumn
Case 4: GetDDRamAddress = 79 + LcdColumn
End Select
'ElseIf LcdSize = 4 Then '2x20
' Select Case LcdRow
' Case 1: GetDDRamAddress = -1 + LcdColumn
' Case 2: GetDDRamAddress = 63 + LcdColumn
' End Select
ElseIf LcdSize = 5 Then '4x20
Select Case LcdRow
Case 1: GetDDRamAddress = -1 + LcdColumn
Case 2: GetDDRamAddress = 63 + LcdColumn
Case 3: GetDDRamAddress = 19 + LcdColumn
Case 4: GetDDRamAddress = 83 + LcdColumn
End Select
'ElseIf LcdSize = 6 Then '2x24
' Select Case LcdRow
' Case 1: GetDDRamAddress = xx + LcdColumn
' Case 2: GetDDRamAddress = xx + LcdColumn
' End Select
'ElseIf LcdSize = 7 Then '2x40
' Select Case LcdRow
' Case 1: GetDDRamAddress = -1 + LcdColumn
' Case 2: GetDDRamAddress = 63 + LcdColumn
' End Select
End If
End Function
'Hier kann man die Position des Cursors auf dem Display setzen:
Public Function LcdSetPos(ByVal LcdPort As Long, ByVal LcdSize As DspSize, ByVal LcdRow As Long, ByVal LcdColumn)
OutLcd LcdPort, GetDDRamAddress(LcdSize, LcdRow, LcdColumn) + 128, False, False
End Function
'Das hier ist so ziemlich der einzige Initialisierbefehl:
Public Function Functionset(ByVal LcdPort As Long, Interface8bit As Boolean, ByVal Multiline As Boolean)
OutLcd LcdPort, ConvertBintoDez("001" & IIf(Interface8bit = True, 1, 0) & IIf(Multiline = True, 1, 0) & "000"), False, False
End Function
'Hier gibts noch etwas für das Display einzustellen. LCD an/aus, Cursor anzeigen und/oder Corsor blinken...
Public Function Displayset(ByVal LcdPort As Long, ByVal DisplayOn As Boolean, ByVal ShowCursor As Boolean, ByVal CursorBlink As Boolean)
OutLcd LcdPort, ConvertBintoDez("00001" & IIf(DisplayOn = True, 1, 0) & IIf(ShowCursor = True, 1, 0) & IIf(CursorBlink = True, 1, 0)), False, False
End Function
'Hier werden einfach nur die beiden vorhergehenden Funktionen vereinigt.
'Dies fördert eigentlich nur die Faulheit des Programmierers - aber egal - so wird es sehr simpel.
Public Function LcdInit(ByVal LcdPort As Long, Optional ByVal ShowCursor As Boolean, Optional ByVal CursorBlink As Boolean)
Functionset LcdPort, True, True
Displayset LcdPort, True, ShowCursor, CursorBlink
LcdSetCursorHome LcdPort
End Function
'Mit diesem Befehl kann man das Display kurz und schmerzlos löschen.
'Hier wird nur der DD-RAM gelöscht - nicht der CG-RAM.
Public Function LcdClearDisplay(ByVal LcdPort As Long)
OutLcd LcdPort, 1, False, False
End Function
'Diese Funktion setzt den Cursor auf die DD-RAM-Adresse 0 zurück.
'Das kann man auch mit einem größeren aufwand mit der LcdSetPos-Funktion machen.
Public Function LcdSetCursorHome(ByVal LcdPort As Long)
OutLcd LcdPort, 2, False, False
End Function
'Hier ist der eigentliche Textausgabe. Hierzu braucht man nur den Port und den gewünschten text...
'...dieser wird dann Buchstabe für Buchstabe als ASCII-Code ausgegeben.
Public Function LcdWriteText(ByVal LcdPort As Long, ByVal LcdText As String)
For x = 1 To Len(LcdText)
OutLcd LcdPort, Asc(Mid(LcdText, x, 1)), False, True
Next
End Function
'Um benutzerdefinierte Symbole oder andere Sonderzeichen auszugeben, dient diese Funktion.
'die Benutzerdefinierten Zeichen haben den Wert 0-7.
Public Function LcdWriteChar(ByVal LcdPort As Long, ByVal LcdChar As Byte)
OutLcd LcdPort, LcdChar, False, True
End Function
'Hier werden die benutzerdefinierten Symbole in den CG-RAM geschrieben.
'Komischerweise kann man die "LcdSymbol"-Variable nicht ByVal definieren. Dies sollte aber nicht stören.
Public Function LcdDefineChar(ByVal LcdPort As Long, ByVal SymbolNumber As Long, LcdSymbol As DspOwnSymbol)
OutLcd LcdPort, 64 + 8 * SymbolNumber, False, False
OutLcd LcdPort, ConvertBintoDez("000" & LcdSymbol.Line0), False, True
OutLcd LcdPort, ConvertBintoDez("000" & LcdSymbol.Line1), False, True
OutLcd LcdPort, ConvertBintoDez("000" & LcdSymbol.Line2), False, True
OutLcd LcdPort, ConvertBintoDez("000" & LcdSymbol.Line3), False, True
OutLcd LcdPort, ConvertBintoDez("000" & LcdSymbol.Line4), False, True
OutLcd LcdPort, ConvertBintoDez("000" & LcdSymbol.Line5), False, True
OutLcd LcdPort, ConvertBintoDez("000" & LcdSymbol.Line6), False, True
OutLcd LcdPort, ConvertBintoDez("000" & LcdSymbol.Line7), False, True
End Function
'Der Einfachheit halber kann man jetzt auch 5x8 Pixel große Bitmaps als Icons setzen.
'So entfällt einiges an Code, wenn die Zeichen schon fest vom Programm definiert wurden.
'Leider funktioniert das Ganze bis jetzt nur mit Pictureboxen.
Public Function LcdDefineCharbyPic(ByVal LcdPort As Long, ByVal SymbolNumber As Long, SymbolPic As PictureBox)
Dim LineXdata As String
SymbolPic.ScaleMode = 3 ' Pixel
OutLcd LcdPort, 64 + 8 * SymbolNumber, False, False
For y = 0 To 7
For x = 0 To 4
If GetPixel(SymbolPic.hDC, x, y) = vbBlack Then
LineXdata = LineXdata & "1"
Else
LineXdata = LineXdata & "0"
End If
Next
OutLcd LcdPort, ConvertBintoDez("000" & LineXdata), False, True
LineXdata = vbNullString
Next
End Function
'Verschiebt den Cursor nach links/rechts und auf Wunsch auch noch den Displayinhalt.
Public Function LcdMoveCursor(ByVal LcdPort As Long, Direction As CsrDir, AlsoDisplay As Boolean)
OutLcd LcdPort, ConvertBintoDez("0001" & IIf(AlsoDisplay = True, 1, 0) & Direction & "00"), False, False
End Function
'Hier kann man festlegen, ob sich der Cursor inkrementiert oder dekrementiert verhalten soll (schreibt man das so?)
'Bei Movedisplay kann der Displayinhalt ählich wie bei LcdMoveCursor verschoben werden. Ich weiß aber immernoch nicht richtig, wie das abläuft.
Public Function LcdEntrymodeset(ByVal LcdPort As Long, PointerIncrement As Boolean, MoveDisplay As Boolean)
OutLcd LcdPort, ConvertBintoDez("000001" & IIf(PointerIncrement = True, 1, 0) & IIf(MoveDisplay, 1, 0)), False, False
End Function