Option Explicit
'gLCD-Ansteuerung von Christof Rueß, www.hobby-elektronik.de.vu
'Die Verwendung dieses Moduls ist kostenfrei, solange diese Zeilen erhalten bleiben.
'Fragen, Kritik und Anregungen an: hobbyelektronik@gmx.net
'Anschlussbelegung des Displays am ParallelPort:
'SI (Data Input) = D0
'SCL (Data Clock) = D1
'cA0 (Control) = D2
'CS (Chip sel.) = D3
'/CS (Chip sel.) = D4
'/RES (Reset) = D5
'Die restliche Beschaltung muss aus dem Datenblatt entnommen werden.
'Deklaration für die Portansteuerung (auch für Win2k & WinXP)
Public 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
'Falls QueryPerformance* nicht verfügbar ist, wird das normale Sleep verwendet.
Public 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.
Public Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal Y As Long) As Long
Public Declare Function SetPixel Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal Y As Long, ByVal crColor As Long) As Long
'Zum Testen der Übertragungsgeschwindigkeit notwendig)
Public Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
Public Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long
Private LcdPort As Long
Private LcdContrast As Long
Private Charset(0 To 255) As String
'Hiermit wird der Port, an dem das LCD angschlossen ist festgelegt
Property Let Port(NewPort As Long)
LcdPort = NewPort
End Property
'Damit der Port auch gelesen werden kann, ist dies hier notwendig:
Property Get Port() As Long
Port = LcdPort
End Property
'Setzen des Display-Kontrasts. Der Wert muss zwischen 0 und 31 liegen. Alles andere wird ignoriert
Property Let Contrast(NewContrast As Long)
If NewContrast <= 31 And NewContrast >= 0 Then
LcdContrast = NewContrast
OutLcd 128 + LcdContrast, True
Else
LcdContrast = 15
End If
End Property
Property Get Contrast() As Long
Contrast = LcdContrast
End Property
'Diese Funktion zwei Funktionen stammen (leider) nicht von mir.
'Sie sind aber sehr nützlich...
'Hier werden Binäre Zahlen zu Dezimalen umgewandelt...
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.
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
Public Function OutLcd(ByVal LcdData As Long, ByVal LcdControl As Boolean)
Dim x&
Dim LcdDataStr As String
Dim LcdControlLong As Long
LcdDataStr = ConvertDeztoBin(LcdData)
LcdControlLong = IIf(LcdControl = True, 0, 4)
For x = 1 To 8
If Mid(LcdDataStr, x, 1) = 1 Then
PortOut32 LcdPort, 41 + LcdControlLong
PortOut32 LcdPort, 43 + LcdControlLong
PortOut32 LcdPort, 41 + LcdControlLong
Else
PortOut32 LcdPort, 40 + LcdControlLong
PortOut32 LcdPort, 42 + LcdControlLong
PortOut32 LcdPort, 40 + LcdControlLong '0 + 8 + 32
End If
'PortOut32 LcdPort, td + cCS + cRES + IIf(Displayout = True, cA0, 0)
'PortOut32 LcdPort, td + cCS + cRES + cSCL + IIf(Displayout = True, cA0, 0)
'PortOut32 LcdPort, td + cCS + cRES + IIf(Displayout = True, cA0, 0)
Next
PortOut32 LcdPort, 48
End Function
'Initialisieren des Displays
Public Function Init()
PortOut32 LcdPort, 0 '/RES auf low
PortOut32 LcdPort, 32 '/RES auf high - jetzt ist das Display bereit, Daten aufzunehmen!
InitDisplayLine 0 'Startzeile des Displays festlegen
OutLcd 161, True 'ADC-Select - normale Richtung
OutLcd 163, True 'Bias Ratio auf 1/6
OutLcd 192, True 'Output State Select
OutLcd 47, True 'Spannungserzeugung/-regelung komplett anschalten
DisplayPower True 'Das Display anschalten
StaticIndicator False 'Standby-Modus aus
End Function
' Schaltet das Display an bzw. aus
Function DisplayPower(ByVal DisplayOn As Boolean)
OutLcd 174 + IIf(DisplayOn = True, 1, 0), True
End Function
'Momentan ist mir nichts näheres über diese Funktion bekannt
Function StaticIndicator(ByVal Indicator As Boolean)
OutLcd 172 + IIf(Indicator = True, 1, 0), True
End Function
'Schaltet das gesamte Display an/aus
Function EntireDisplayPower(ByVal Provide As Boolean)
OutLcd 164 + IIf(Provide = True, 0, 1), True
End Function
'Versetzt das Display in den Standby-Modus.
'Das Display lässt sich nur mit Init aufwecken.
Function Standbydisplay()
DisplayPower False
EntireDisplayPower False
End Function
'Legt die Startzeile des Displays fest. Standart ist bei dem Display 0.
Function InitDisplayLine(ByVal StartAddress As Long)
OutLcd 64 + ConvertBintoDez("00" & Right(ConvertDeztoBin(StartAddress), 6)), True
End Function
'Bewegt den Cursor auf die angegebene Seiten-Adresse
'Zeile 1: Page = 1
'Zeile 2: Page = 0
'Zeile 3: Page = 2
'Zeile 4: Page = 3
Function SetPageAddress(ByVal Address As Long)
Dim Temp As Long
Temp = Address
If Temp > 32 Then Temp = Temp - 32
If Temp > 64 Then Temp = Temp - 64
If Temp > 128 Then Temp = Temp - 128
OutLcd 176 + Temp, True
End Function
'Bewegt den Cursor auf die angegebene Spalte.
'Bei diesem Display beginnt die Anzeigefläche bei dem Wert 18.
Function SetColumnAddress(ByVal Address As Long)
Dim Temp As String
Temp = ConvertDeztoBin(Address)
OutLcd ConvertBintoDez("0001" & Left(Temp, 4)), True
OutLcd ConvertBintoDez("0000" & Right(Temp, 4)), True
End Function
'Initialisiert die benutzerdefinierte Schriftart. Momentan beträgt die maximale Zeichenhöhe 8 Pixel. Die Breite ist beliebig.
'Das Dateiformat ist sehr Simpel aufgebaut:
'Die ersten drei Zahlen stehen für den ASCII-Code des Zeichens. Für A wäre dies 065.
'Die nachfolgenden Nummern beschreiben das Symbol. Jede dreier-Gruppe beschreibt eine des Symbols. Vorhergehende Nullstellen müssen als 0 geschrieben werden (32 -> 032)
'Die erste Spalte für A wäre 01111110 -> 126, die zweite 10010000 -> 144, ...
'Der gesamte Buchstabe "A" sieht wie folgt aus:
'065126144144144126
' A 0 1 1 1 0
' 1 0 0 0 1
' 1 0 0 0 1
' 1 1 1 1 1
' 1 0 0 0 1
' 1 0 0 0 1
' 1 0 0 0 1
' 0 0 0 0 0
Function InitFont(ByVal FontFile As String) As Boolean
On Error GoTo Fehler
Dim FHandle As Long
Dim Temp As String
FHandle = FreeFile
Open FontFile For Input As FHandle
Do While EOF(FHandle) = False
Input #FHandle, Temp
Charset(Mid(Temp, 1, 3)) = Right(Temp, Len(Temp) - 3)
Loop
Close FHandle
InitFont = True
Exit Function
Fehler:
InitFont = False
End Function
'Den angegebenen Text der initialisierten Schriftart auf eine PictureBox mit hDc schreiben.
Function WriteText(ByVal DstPicture As PictureBox, ByVal LcdText As String, ByVal StartX As Long, ByVal StartY As Long, Optional ByVal FontTransparent As Boolean = False, Optional ByVal FontNegative As Boolean = False) As Boolean
On Error GoTo Fehler
Dim x, Y, TxtPos, ChrPos, clrActive, clrInactive As Long
Dim CurrChar, CurrCharCol As String
Dim OldScaleMode As ScaleModeConstants
OldScaleMode = DstPicture.ScaleMode 'Scalemode merken
DstPicture.ScaleMode = 3 'Scalemode auf Pixel stellen
x = StartX
If FontNegative = False Then 'Wenn die Schrift nicht negativ sein soll, ...
clrActive = 0 '... soll die dunkle Farbe Schwarz sein...
clrInactive = 16777215 '... und die helle Farbe weiß
Else 'andernfalls
clrActive = 16777215 'umgekehrt!
clrInactive = 0
End If
For TxtPos = 1 To Len(LcdText) 'den ganzen Text "abklappern"
CurrChar = Charset(Asc(Mid(LcdText, TxtPos, 1))) 'aktuelles Zeichen in die Variable setzen (Übersichtlicher/spart Zeit)
For ChrPos = 1 To Fix(Len(CurrChar) / 3) 'jede Spalte ist 3 Zeichen lang
CurrCharCol = ConvertDeztoBin(Mid(CurrChar, ChrPos * 3 - 2, 3)) 'die noch als dezimale Spalte in Binärwert umwandeln
For Y = 1 To 8 'die einzelnen Bits abfragen
If Mid(CurrCharCol, Y, 1) = "1" Then 'wenn das Bit 1 ist, soll...
SetPixel DstPicture.hDC, x, StartY - 1 + Y, clrActive 'die das Bit aktiv dargestellt werden
Else 'andernfalls...
If FontTransparent = False Then '... und wenn die Schrift _nicht_ transpartent dargestellt werden soll, ...
SetPixel DstPicture.hDC, x, StartY - 1 + Y, clrInactive '...soll das Bit inaktiv dargestellt werden
End If
End If
Next Y
x = x + 1 'die X-Koordinate 1 weiter nach rechts setzen
If FontTransparent = False And TxtPos < Len(LcdText) Then 'Wenn die Schrift _nicht_ transpartent dargestellt werden soll, ...
For Y = 1 To 8
SetPixel DstPicture.hDC, x, StartY - 1 + Y, clrInactive 'soll eine ganze Spalte mit der inaktiven Farbe eingefügt werden
Next Y
End If
Next ChrPos
x = x + 1 'die X-Koordinate 1 weiter nach rechts setzen (Platz zwischen den Buchstaben)
Next TxtPos
DstPicture.ScaleMode = OldScaleMode 'Scalemode zurücksetzen
DstPicture.Refresh
WriteText = True
Exit Function
Fehler:
DstPicture.ScaleMode = OldScaleMode 'Scalemode zurücksetzen
WriteText = False
End Function
'Berechnen der Textlänge in Pixeln anhand der geladenen Schriftart und dem gewünschten Text
Function TextLength(ByVal LcdText As String) As Long
Dim x, TxtLen
TxtLen = 0
For x = 1 To Len(LcdText)
TxtLen = TxtLen + Fix(Len(Charset(Asc(Mid(LcdText, x, 1)))) / 3) ' + 1
Next
TxtLen = TxtLen + Len(LcdText) - 1
If TxtLen = -1 Then TxtLen = 0
TextLength = TxtLen
End Function
'Die angegebene Picturebox auf das Display übertragen
Function WritePic(ByVal LcdPicture As PictureBox)
Dim x, currPage
Dim StrRev As Boolean
Dim OldScaleMode As ScaleModeConstants
OldScaleMode = LcdPicture.ScaleMode 'Scalemode merken
LcdPicture.ScaleMode = 3 'Scalemode auf Pixel stellen
For x = 0 To 3
Select Case x 'Anpassen der Page und ob die Zeilen gespiegelt werden müssen
Case 0: currPage = 1: StrRev = False
Case 1: currPage = 0: StrRev = False
Case 2: currPage = 2: StrRev = True
Case 3: currPage = 3: StrRev = True
End Select
SetColumnAddress 18 'Startspalte setzen
SetPageAddress currPage 'Page setzen
WritePicLine LcdPicture, x * 8, StrRev 'Zeile x an das Display ausgeben
Next
LcdPicture.ScaleMode = OldScaleMode 'Scalemode zurücksetzen
End Function
'Zeichnen der angegeben Zeile des Displays (nur intern)
Private Function WritePicLine(ByVal LcdPicture As PictureBox, ByVal Ystart As Long, Optional Reverse As Boolean = False)
Dim Temp As String
Dim Xval, Yval
For Xval = 0 To 96
Temp = ""
For Yval = Ystart To (Ystart + 7)
If GetPixel(LcdPicture.hDC, Xval, Yval) = 0 Then
Temp = Temp & "1"
Else
Temp = Temp & "0"
End If
Next Yval
If Reverse = False Then
OutLcd ConvertBintoDez(Temp), False
Else
OutLcd ConvertBintoDez(StrReverse(Temp)), False
End If
Next Xval
End Function
'Da der Controller über keine Funktion verfügt, den Displayinhalt zu löschen, muss dies manuell gemacht werden
Function ClearDisplay()
Dim x, Y
For Y = 0 To 3
SetPageAddress Y
SetColumnAddress 18
For x = 0 To 96
OutLcd 0, False
Next x
Next Y
End Function
'Zufälliges Rauschen auf das Display übertragen.
Function ShowNoise()
Dim x, Y
Randomize
For Y = 0 To 3
SetPageAddress Y
SetColumnAddress 18
For x = 0 To 96
OutLcd Rnd() * 255, False
Next x
Next Y
End Function
'Initial Display Line, Spaltenadresse, Seitenadresse und Output Status Selector resetten
'Der Inhalt des Displays wird hiermit _nicht_ gelöscht.
Function Reset()
OutLcd 226, True
End Function
'Hiermit kann man festlegen, ob der Inhalt des Displays normal oder invertiert ausgegeben werden soll
Function ReverseDisplay(ByVal Inverted As Boolean)
OutLcd 166 + IIf(Inverted = True, 1, 0), True
End Function
'Testet die Übertragungsgeschwindigkeit eines kompletten Displayinhaltes an das Display
'Die Ausgabe erfolgt in ms
Function TestLcdSpeed() As Currency
Dim PerfFrequ As Currency
Dim PerfCntA As Currency
Dim PerfCntB As Currency
Dim PerfCntC As Currency
Dim PerfCntAvl As Long
PerfCntAvl = QueryPerformanceFrequency(PerfFrequ) '"Kalibriert" die Uhr
QueryPerformanceCounter PerfCntA 'den Startwert für den Counter in PerfCntA schreiben
ShowNoise 'Zum Testen der Geschwindigkeit wird das Display "verrauscht"
QueryPerformanceCounter PerfCntB 'den Endwert für den Counter in PerfCntB schreiben
TestLcdSpeed = CDbl((PerfCntB - PerfCntA) / PerfFrequ) * 1000
End Function