LCDInfo.com

Public Declare Function DlPortReadPortUchar Lib "dlportio.dll" (ByVal Port As Long) As Byte
Public Declare Function DlPortReadPortUshort Lib "dlportio.dll" (ByVal Port As Long) As Integer
Public Declare Function DlPortReadPortUlong Lib "dlportio.dll" (ByVal Port As Long) As Long

Public Declare Sub DlPortReadPortBufferUchar Lib "dlportio.dll" (ByVal Port As Long, Buffer As Any, ByVal Count As Long)
Public Declare Sub DlPortReadPortBufferUshort Lib "dlportio.dll" (ByVal Port As Long, Buffer As Any, ByVal Count As Long)
Public Declare Sub DlPortReadPortBufferUlong Lib "dlportio.dll" (ByVal Port As Long, Buffer As Any, ByVal Count As Long)

Public Declare Sub DlPortWritePortUchar Lib "dlportio.dll" (ByVal Port As Long, ByVal Value As Byte)
Public Declare Sub DlPortWritePortUshort Lib "dlportio.dll" (ByVal Port As Long, ByVal Value As Integer)
Public Declare Sub DlPortWritePortUlong Lib "dlportio.dll" (ByVal Port As Long, ByVal Value As Long)

Public Declare Sub DlPortWritePortBufferUchar Lib "dlportio.dll" (ByVal Port As Long, Buffer As Any, ByVal Count As Long)
Public Declare Sub DlPortWritePortBufferUshort Lib "dlportio.dll" (ByVal Port As Long, Buffer As Any, ByVal Count As Long)
Public Declare Sub DlPortWritePortBufferUlong Lib "dlportio.dll" (ByVal Port As Long, Buffer As Any, ByVal Count As Long)

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function GetTickCount Lib "kernel32" () As Long

Private LCD_Control_Address As Long
Private LCD_Data_Address As Long
Private LCD_LPT_Port As Long

Private LCD_Graphic_Address As Long
Private LCD_Text_Address As Long
Private LCD_Bytes_Per_Row As Integer

Private OnBits(0 To 31) As Long

Public Function LShiftLong(ByVal Value As Long, ByVal Shift As Integer) As Long
    MakeOnBits
 
    If (Value And (2 ^ (31 - Shift))) Then GoTo OverFlow
    LShiftLong = ((Value And OnBits(31 - Shift)) * (2 ^ Shift))
 
    Exit Function

OverFlow:
 
    LShiftLong = ((Value And OnBits(31 - (Shift + 1))) * (2 ^ (Shift))) Or &H80000000
End Function

Public Function RShiftLong(ByVal Value As Long, ByVal Shift As Integer) As Long
Dim lngHi As Long

    MakeOnBits
    If (Value And &H80000000) Then lngHi = &H40000000
 
    RShiftLong = (Value And &H7FFFFFFE) \ (2 ^ Shift)
    RShiftLong = (RShiftLong Or (lngHi \ (2 ^ (Shift - 1))))
End Function
 
Private Sub MakeOnBits()
Dim intJ As Integer, intV As Long
 
    For intJ = 0 To 30
 
        intV = intV + (2 ^ intJ)
        OnBits(intJ) = intV
 
    Next intJ
 
    OnBits(intJ) = intV + &H80000000
End Sub

Public Function LCDInit(lcdSpecs As lcdInfo, Optional lngLPTAddress As Long = &H378) As Boolean
'On Error GoTo Error

    LCD_LPT_Port = lngLPTAddress
    LCD_Data_Address = LCD_LPT_Port + 0
    LCD_Control_Address = LCD_LPT_Port + 2
    LCD_Graphic_Address = &H300
    LCD_Text_Address = &H0
   
    LCD_Width = lcdSpecs.lcdWidth
    LCD_Height = lcdSpecs.lcdHeight
    LCD_FontHeight = lcdSpecs.lcdFontHeight
    LCD_FontWidth = lcdSpecs.lcdFontWidth
    'LCD_Bytes_Per_Row = lcdSpecs.lcdWidth \ lcdSpecs.lcdFontWidth
    LCD_Bytes_Per_Row = 40
   
    LCDInit = LCDDriver

    Exit Function
Error:
    LCDInit = False
End Function

Public Function LCDDriver() As Boolean
'On Error GoTo Error

    LCDWriteData LCD_Text_Address And &HFF ' Text Address
    LCDWriteData RShiftLong(LCD_Text_Address, 8)
    LCDWriteControl &H40
   
    LCDWriteData LCD_Bytes_Per_Row ' Bytes per Row
    LCDWriteData &H0
    LCDWriteControl &H41
   
    LCDWriteData LCD_Graphic_Address And &HFF  ' Graphics Address
    LCDWriteData RShiftLong(LCD_Graphic_Address, 8)
    LCDWriteControl &H42
   
    LCDWriteData LCD_Bytes_Per_Row ' Bytes per Row
    LCDWriteData &H0
    LCDWriteControl &H43
   
    LCDWriteControl &H80 ' Internal CG-Rom and Or Mode
   
    LCDWriteControl &HA7 ' 8 Line Cursor
    LCDWriteData &H0
    LCDWriteData &H0
    LCDWriteControl &H21 ' Cursor at 0,0 (x,y)
   
    LCDWriteControl &H9D ' Display Ready
   
    LCDDriver = True
   
    Exit Function
Error:
    LCDDriver = False
End Function

Public Function LCDWriteControl(lngData As Integer) As Boolean
'On Error GoTo Error

   
    Call DlPortWritePortUshort(LCD_Data_Address, lngData)
    Call DlPortWritePortUshort(LCD_Control_Address, 0) 'CDHI
    Call DlPortWritePortUshort(LCD_Control_Address, 0) 'CDHI | WRLO | RDHI
    Call DlPortWritePortUshort(LCD_Control_Address, 1) 'CDHI | WRLO | RDHI | CELO
    Call DlPortWritePortUshort(LCD_Control_Address, 0) 'CDHI | WRLO | RDHI | CEHI
    Call DlPortWritePortUshort(LCD_Control_Address, 8) 'CDLO

   
    LCDWriteControl = True

    Exit Function
Error:
    LCDWriteControl = False
End Function

Public Function LCDWriteData(lngData As Integer) As Boolean
'On Error GoTo Error
   
    Call DlPortWritePortUshort(LCD_Data_Address, lngData)
    Call DlPortWritePortUshort(LCD_Control_Address, 8)  'CDLO
    Call DlPortWritePortUshort(LCD_Control_Address, 8) 'CDLO | WRLO | RDHI
    Call DlPortWritePortUshort(LCD_Control_Address, 9)  'CDLO | WRLO | RDHI | CELO
    Call DlPortWritePortUshort(LCD_Control_Address, 8)  'CDLO | WRLO | RDHI | CEHI
    Call DlPortWritePortUshort(LCD_Control_Address, 8) 'CDLO
   
   
    LCDWriteData = True
   
    Exit Function
Error:
    LCDWriteData = False
End Function

Public Function LCDSetPixel(intX As Integer, intY As Integer) As Boolean
'On Error GoTo Error
Dim intAddress As Long

    intAddress = LCD_Graphic_Address + (intY * LCD_Bytes_Per_Row) + (intX / 6)
    LCDWriteData intAddress And &HFF
    LCDWriteData RShiftLong(intAddress, 8)
    LCDWriteControl &H24
    LCDWriteControl (&HF8 Or (5 - (intX Mod 6)))
   
    LCDSetPixel = True

    Exit Function
Error:
    LCDSetPixel = False
End Function

Private Sub Form_Load()
Dim lcdSpec As lcdInfo
Dim intTemp As Integer

    With lcdSpec
        .lcdWidth = 128
        .lcdHeight = 64
        .lcdFontHeight = 8
        .lcdFontWidth = 6
    End With
   
    LCDInit lcdSpec, &H378

    For intTemp = 10 To 100
        LCDSetPixel intTemp, 10
    Next intTemp
End Sub