clslptio.cls

Some mathematical functions

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsLPTIO"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Description = "Object of a parallel port."
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'Enums for different data types
Public Enum ppRegBits
    ppbit0 = 0
    ppBit1 = 1
    ppBit2 = 2
    ppBit3 = 3
    ppBit4 = 4
    ppBit5 = 5
    ppBit6 = 6
    ppBit7 = 7
End Enum

'Output Register specifiers
Public Enum ppOutputRegs
    ppDataRegister = 0
    ppControlRegister = 2
End Enum

'Input register specifiers
Public Enum ppInputRegs
    ppStatusRegister = 1
End Enum

'All register specifiers
Public Enum ppAllRegs
    ppaDataRegister = 0
    ppaStatusRegister = 1
    ppaControlRegister = 2
End Enum

'Buffers that holds the values last send and received from the LPT Port
Private ppRegs(0 To 2) As Integer
Private ppBitVals(0 To 7) As Integer

Public Sub SetBitVal(ByVal Reg As ppOutputRegs, ByVal Bit As ppRegBits, ByVal Value As Integer)
    If Value <> 0 Then
        'Set the bit
        ppRegs(Reg) = ppRegs(Reg) Or ppBitVals(Bit)
    Else
        'Clear the bit
        ppRegs(Reg) = ppRegs(Reg) And Not ppBitVals(Bit)
    End If
End Sub

Public Function GetBitVal(ByVal Reg As ppAllRegs, ByVal Bit As ppRegBits) As Integer
    'Test the bit
    If ppRegs(Reg) And ppBitVals(Bit) Then
        'If a one the return 1
        GetBitVal = 1
    Else
        'If a zero then return 0
        GetBitVal = 0
    End If
End Function

'Returns the current value of the specified register buffer
Public Function GetRegVal(ByVal Reg As ppAllRegs) As Integer
    'Return the requested information
    GetRegVal = ppRegs(Reg)
End Function

'Sets the register value specifed by RegVal
Public Sub SetRegVal(ByVal OutReg As ppOutputRegs, ByVal RegVal As Integer)
    'Set the register value
    ppRegs(OutReg) = RegVal
End Sub

'Read from the port and store the register value
Public Function ReadPort(ByVal InputRegs As ppInputRegs) As Integer
    'Read the current value at the port
    ReadPort = frmLPTSelect.LptInput(InputRegs)
    'Store the value in the regsiter buffer
    ppRegs(InputRegs) = ReadPort
End Function

'Write to the port and store the value written in the register buffer
Public Sub WritePort(ByVal OutReg As ppOutputRegs, Optional ByVal OutVal As Variant)
    If IsMissing(OutVal) Then
        'Outval is missing so just send the register buffer value
        frmLPTSelect.LptOutput OutReg, ppRegs(OutReg)
    Else
        'Set the value in the register buffer
        ppRegs(OutReg) = OutVal
        'Write the value to the specified LPT Port Register
        frmLPTSelect.LptOutput OutReg, OutVal
    End If
End Sub

Public Sub StrobeLine(ByVal OutReg As ppOutputRegs, ByVal eLine As ppRegBits)
Attribute StrobeLine.VB_Description = "Strobes the specified line high then low again."
    'Check the current bitval of the line
'    If GetBitVal(OutReg, eLine) Then
    
    'Set the line low
    SetBitVal OutReg, eLine, 0
    'If the line is high then take it low
    WritePort OutReg, ppRegs(OutReg)
    'Set the line high
    SetBitVal OutReg, eLine, 1
    'Take the line high again
    WritePort OutReg, ppRegs(OutReg)

'    Else
'        'Set the line high
'        SetBitVal OutReg, eLine, 1
'        'If the line is low then take it high
'        WritePort OutReg, ppRegs(OutReg)
'        'Set the line low
'        SetBitVal OutReg, eLine, 1
'        'Take the line low again
'        WritePort OutReg, ppRegs(OutReg)
'    End If
End Sub

Private Sub Class_Initialize()
    Dim cntr As Integer
    
    'Initialize the bit values
    For cntr = 0 To 7
        ppBitVals(cntr) = 2 ^ cntr
    Next cntr
End Sub