'-----------------
Option Explicit
' This module is used to interface a BX24 with an LCD having a Hitachi
' HD44780 interface using a 74HC595 serial 8-bit shift register. It was
' specifically written for and tested using an Optrex DMC20434 20X4 LCD.
'
' Three BX-24 outputs are required. Data is set up on LCDData and clocked
' using LCDClk. When all eight bits are loaded into the shift register,
' the data is transferred to the output latch using LCDLatch. In the
' following these three leads are assigned to Pins 12, 11 and 10. However
' these may be modified to suit your application.
CONST LCDData as Byte = 12 ' modify as necessary for your application
CONST LCDClk as Byte = 11
CONST LCDLatch as Byte = 10
'
' Summary of Routines.
'
' Private Sub LCDSROut(ByVal OutBits as Byte) - Outputs OutBits to 74HC595,
' least sign bit first
'
' Public Sub LCDInit() - Initializes LCD. Sets in 4-bit mode and sets
' cursor to home.
'
' Public Sub LCDPutCmdByte(ByVal Val as Byte). Sends command byte to LCD.
' This may be used to set cursor style, turn display on and off, set
' the font and postion the cursor.
'
' Private Sub LCDPutCmdNibble(ByVal Val as Byte). Sends a command nibble.
'
' Public Sub LCDPutByte(ByVal Value As Byte). Sends one byte to the LCD.
' For example, Call LCDPutByte(Asc("A")) causes the character "A" to be
' displayed.
'
' Private Sub LCDPutDataNibble(ByVal Val as Byte). Sends a data nibble.
'
' Public Sub (ByVal LineNum as Byte) - Positions cursor at beginning
' of specified line.
'
' All of the following routines are similar to the serial port routines
' provided by NetMedia.
'
' Public Sub LCDPutB(ByVal Value As Byte)
' Public Sub LCDPutI(ByVal Value As Integer)
' Public Sub LCDPutL(ByVal Operand As Long)
' Public Sub LCDPutStr(ByRef Tx As String)
'
' Public Sub LCDPutUI(ByVal Value As UnsignedInteger)
' Public Sub LCDPutUL(ByVal Value As UnsignedLong)
'
' Public Sub LCDPutS(ByVal Value As Single)
' Public Sub LCDPutSci(ByVal Value As Single)
'
' Private Sub SplitFloat( _
' ByVal Value As Single, _
' ByRef Mantissa As Single, _
' ByRef Exponent As Integer) - Used in outputting Singles
'
' Public Sub SplitInt(ByVal a as UnsignedInteger, _
' ByRef hi as Byte, _
' ByRef lo as Byte) - Used in outputting Longs
'
' This was one weekly project in Instrumentation Control and Sensors,
' and undgraduate elective in the Dept of Electrical and Computer Eng
' at Morgan State University. This code was adapted from that written
' by David Seebold.
'
' I know that Jon Williams also posted similar code to the OneList
' BasicX Mail List site and his may well be better as he is an excellent
' programmer. However, this was a totally independednt effort.
'
' copyright, Peter H. Anderson, Baltimore, MD, Dec 18, '99
'
'------------------
Public Sub LCDInit()
' Initializes LCD. Sets in 4-bit mode and sets cursor to home
Dim N as integer
For N = 1 To 3 Step 1
Call Sleep(0.05)
Call LCDPutCmdNibble(3)
Next
Call Sleep(0.05)
Call LCDPutCmdNibble(2) ' place in 4-bit mode
Call Sleep(0.05)
Call LCDPutCmdByte(1)' home cursor
Call Sleep(0.05)
Call LCDPutCmdByte(15)
'debug.print "init ok"
End Sub
'------------------
Private Sub LCDSROut(ByVal OutBits as Byte)
' outputs OutBits to 74HC595, least sign bit first
Dim I as Integer, HibitOfByte as Byte
Call PutPin(LCDData, 0)
Call PutPin(LCDClk, 0)
Call PutPin(LCDLatch, 0)
For I = 1 to 8
HiBitOfByte = OutBits AND bx10000000 'isolates the hi bit of OutBits
If(HiBitOfByte <>0) Then
Call PutPin(LCDData, 1) ' and checks to see if it's
' Call PutB(1)
Else ' either a 1 or 0, then
Call PutPin(LCDData, 0) ' outputs that value to the SR
' Call PutB(0)
End If
Call PutPin(LCDClk, 1) ' clock
Call PutPin(LCDClk, 0)
OutBits = OutBits * 2 ' shifts all the bits up one, so that the
' next bit can be output to the shift
' register
Next
Call PutPin(LCDLatch, 1) ' latches the data in the SR
Call PutPin(LCDLatch, 0)
' Call NewLine()
End Sub
'------------------------
Public Sub LCDPutByte(ByVal Value As Byte)
' Sends one byte to the LCD.
Call LCDPutDataNibble(Value\16)
Call LCDPutDataNibble(Value AND bx00001111)
End Sub
'------------------------
Private Sub LCDPutDataNibble(ByVal Val as Byte)
Val = Val AND bx00001111
Val = Val OR bx01000000
Call LCDSROut(Val)
Val = Val OR bx10000000
Call LCDSROut(Val)
Val = Val AND bx01111111
Call LCDSROut(Val)
End Sub
'-------------------------
Public Sub LCDPutCmdByte(ByVal Val as Byte)
Call LCDPutCmdNibble(Val\16)
Call LCDPutCmdNibble(Val AND bx00001111)
End Sub
'-------------------------
Private Sub LCDPutCmdNibble(ByVal Val as Byte)
Val = Val AND bx00001111
Call LCDSROut(Val)
Val = Val OR bx10000000
Call LCDSROut(Val)
Val = Val AND bx01111111
Call LCDSROut(Val)
End Sub
'-------------------------
Public Sub LCDLine(ByVal LineNum as Byte)
' depending on which line is requested, goes to the beginning of that line
If(LineNum = 1) Then
Call LCDPutCmdByte(&H80)
ElseIf(LineNum = 2) Then
Call LCDPutCmdByte(&HC0)
ElseIf(LineNum = 3) Then
Call LCDPutCmdByte(&H90) ' change to &H94 for 20 char
ElseIf(LineNum = 4) Then
Call LCDPutCmdByte(&HD0) ' change to &HD4 for 20 char
Else
Call LCDInit()
End If
End Sub
'-------------------------
Public Sub LCDPutStr(ByRef Tx As String)
' Outputs a String type to the LCD.
Dim Length As Integer, Ch As String * 1, bCh As Byte
Dim I As Integer
Length = Len(Tx)
For I = 1 To Length
Ch = Mid(Tx, I, 1)
bCh = Asc(Ch)
Call LCDPutByte(bCh)
'debug.print "string char ok"
Next
End Sub
'-------------------------
Public Sub LCDPutL(ByVal Operand As Long)
' Outputs a Long type to the LCD.
Const NegativeLimit As Long = -2147483648
Const Base As Long = 10
' Reserve space for "2147483648"
Dim Digit(1 To 10) As Byte
Dim Tmp As Long
Dim NDigits As Integer
Dim I As Integer
' Negative limit must be handled as a special case.
If (Operand = NegativeLimit) Then
Digit(10) = 2 + 48
Digit(9) = 1 + 48
Digit(8) = 4 + 48
Digit(7) = 7 + 48
Digit(6) = 4 + 48
Digit(5) = 8 + 48
Digit(4) = 3 + 48
Digit(3) = 6 + 48
Digit(2) = 4 + 48
Digit(1) = 8 + 48
NDigits = 10
Else
NDigits = 0
Tmp = Abs(Operand)
Do
NDigits = NDigits + 1
Digit(NDigits) = CByte(Tmp Mod Base) + 48
Tmp = Tmp \ Base
If Tmp = 0 Then
Exit Do
End If
Loop
End If
If (Operand < 0) Then
Call LCDPutByte(45) ' Negative sign.
End If
' Digits are stored in reverse order of display.
For I = NDigits To 1 Step -1
Call LCDPutByte(Digit(I))
Next
End Sub
'-------------------------
Public Sub LCDPutB(ByVal Value As Byte)
' Outputs a Byte type to the LCD.
Dim L As Long
L = CLng(Value)
Call LCDPutL(L)
End Sub
'------------------------
Public Sub LCDPutI(ByVal Value As Integer)
' Outputs an Integer type to the LCD.
Dim L As Long
L = CLng(Value)
Call LCDPutL(L)
End Sub
'---------------------------
Public Sub LCDPutUI(ByVal Value As UnsignedInteger)
' Outputs an UnsignedInteger type to the serial port.
Dim L As Long, V As New UnsignedInteger
V = Value
' Clear L.
L = 0
' Copy Value into the lower two bytes of L.
Call BlockMove(2, MemAddress(V), MemAddress(L))
Call LCDPutL(L)
End Sub
'---------------------------
Public Sub LCDPutUL(ByVal Value As UnsignedLong)
' Outputs an UnsignedLong type to the LCD.
Dim UL As New UnsignedLong, L As Long, Digit As New UnsignedLong
Dim I As Integer, Temp As New UnsignedLong
' If the top bit is clear, the number is ready to go.
If ((Value And &H80000000) = 0) Then
Call LCDPutL(CLng(Value))
Exit Sub
End If
' Divide by 10 is done by a right shift followed by a divide by 5.
' First clear top bit so we can do a signed divide.
UL = Value
UL = UL And &H7FFFFFFF
' Shift to the right 1 bit.
L = CLng(UL)
L = L \ 2
' Put the top bit back, except shifted to the right 1 bit.
UL = CuLng(L)
UL = UL Or &H40000000
' The number now fits in a signed long.
L = CLng(UL)
' Divide by 5.
L = L \ 5
Call LCDPutL(L)
' Multiply by 10. Since multiply doesn't work yet for UnsignedLong, we
' have to do the equivalent addition.
Temp = CuLng(L)
UL = 0
For I = 1 To 10
UL = UL + Temp
Next
' Find the rightmost digit.
Digit = Value - UL
Call LCDPutL(CLng(Digit))
End Sub
'---------------------
Public Sub LCDPutSci(ByVal Value As Single)
' Outputs floating point number in scientific notation format. The output
' is to the serial port.
Dim Mantissa As Single, Exponent As Integer, LMant As Long
Dim D As Integer
Call SplitFloat(Value, Mantissa, Exponent)
' Sign.
If (Mantissa < 0!) Then
Call LCDPutByte(45) ' Dash.
End If
' Convert mantissa to a 7-digit integer.
LMant = FixL((Abs(Mantissa) * 1000000!) + 0.5)
' Correct for roundoff error. Mantissa can't be > 9.999999
If (LMant > 9999999) Then
LMant = 9999999
End If
' First digit of mantissa.
D = CInt(LMant \ 1000000)
Call LCDPutByte(CByte(D + 48))
' Decimal point.
Call LCDPutByte(46)
' Remaining digits of mantissa.
LMant = LMant Mod 1000000
Call LCDPutL(LMant)
' Exponent.
Call LCDPutByte(69) ' E
If (Exponent < 0) Then
Call LCDPutByte(45) ' Dash
Else
Call LCDPutByte(43) ' Plus
End If
Call LCDPutI(Abs(Exponent))
End Sub
'--------------------------
Public Sub LCDPutS(ByVal Value As Single)
' Outputs a floating point number to the LCD. If the number can be
' displayed without using scientific notation, it is. Otherwise scientific
' notation is used.
Dim X As Single, DecimalPlace As Integer, Mantissa As Single
Dim Exponent As Integer, DigitPosition As Integer, Factor As Long
Dim D As Integer, LMant As Long, DecimalHasDisplayed As Boolean
' Special case for zero.
If (Value = 0!) Then
Call LCDPutByte(48) ' Zero
Call LCDPutByte(46) ' Decimal
Call LCDPutByte(48) ' Zero
Exit Sub
End If
X = Abs(Value)
' Use scientific notation for values too big or too small.
If (X < 0.1) Or (X > 999999.9) Then
Call LCDPutSci(Value)
Exit Sub
End If
' What follows is non-exponent displays for 0.1000000 < Value < 999999.9
' Sign.
If (Value < 0!) Then
Call LCDPutByte(45) ' Dash.
End If
If (X < 1!) Then
Call LCDPutByte(48) ' Leading zero.
Call LCDPutByte(46) ' Decimal point.
DecimalPlace = 0
' Convert number to a 7-digit integer.
LMant = FixL((X * 10000000#) + 0.5)
Else
Call SplitFloat(X, Mantissa, Exponent)
DecimalPlace = Exponent + 2
' Convert mantissa to a 7-digit integer.
LMant = FixL((Abs(Mantissa) * 1000000!) + 0.5)
' Correct for roundoff error. Mantissa can't be > 9.999999
If (LMant > 9999999) Then
LMant = 9999999
End If
End If
DecimalHasDisplayed = False
Factor = 1000000
For DigitPosition = 1 To 7
If (DigitPosition = DecimalPlace) Then
Call LCDPutByte(46) ' Decimal
DecimalHasDisplayed = True
End If
D = CInt(LMant \ Factor)
Call LCDPutByte(CByte(D + 48))
LMant = LMant Mod Factor
' Stop trailing zeros, except for one immediately following the
' decimal place.
If (LMant = 0) Then
If (DecimalHasDisplayed) Then
Exit Sub
End If
End If
Factor = Factor \ 10
Next
End Sub
'-------------------------------------------------------------------------------
Private Sub SplitFloat( _
ByVal Value As Single, _
ByRef Mantissa As Single, _
ByRef Exponent As Integer)
' Splits a floating point number into mantissa and exponent. The mantissa
' range is such that 1.0 <= Abs(Mantissa) < 10.0 for nonzero numbers, and
' zero otherwise.
Dim X As Single, Factor As Single
' Zero is a special case.
If (Value = 0!) Then
Mantissa = 0!
Exponent = 0
Exit Sub
End If
X = Abs(Value)
Exponent = 0
Factor = 1!
' Multiply or divide by ten to transform number to value between 1 and 10.
Do
If (X >= 10!) Then
X = X / 10!
Factor = Factor * 10!
Exponent = Exponent + 1
ElseIf (X < 1!) Then
X = X * 10!
Factor = Factor * 10!
Exponent = Exponent - 1
Else
' If we reach this point, then 1.0 <= mantissa < 10.0.
Exit Do
End If
Loop
' Determine mantissa.
If (Exponent = 0) Then
Mantissa = Value
ElseIf (Exponent > 0) Then
Mantissa = Value / Factor
Else
Mantissa = Value * Factor
End If
End Sub
'----------------------
Public Sub SplitInt(ByVal a as UnsignedInteger, _
ByRef hi as Byte, _
ByRef lo as Byte)
' separate an integer into high and low bytes
Dim val as New UnsignedInteger
Dim RAM_Ptr as Integer
val = a ' Note that as variable a (unsigned long)
' is passed by ref, it is write protected
RAM_Ptr = MemAddress(val)
lo = RAMpeek(RAM_Ptr) ' lo byte followed by high byte
hi = RAMpeek(RAM_Ptr+1)
End Sub