VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdRead 
      Caption         =   "Read"
      Height          =   315
      Left            =   540
      TabIndex        =   16
      Top             =   180
      Width           =   855
   End
   Begin VB.TextBox txtRead 
      Height          =   315
      Left            =   1440
      TabIndex        =   15
      Text            =   "Text1"
      Top             =   180
      Width           =   1875
   End
   Begin VB.CommandButton cmdRead2 
      Caption         =   "Read +2"
      Height          =   315
      Left            =   540
      TabIndex        =   14
      Top             =   1260
      Width           =   855
   End
   Begin VB.TextBox txtRead2 
      Height          =   315
      Left            =   1440
      TabIndex        =   13
      Text            =   "Text1"
      Top             =   1260
      Width           =   1875
   End
   Begin VB.CommandButton cmdSet2 
      Caption         =   "Set"
      Height          =   315
      Left            =   3360
      TabIndex        =   12
      Top             =   1260
      Width           =   495
   End
   Begin VB.CommandButton cmdRead1 
      Caption         =   "Read +1"
      Height          =   315
      Left            =   540
      TabIndex        =   11
      Top             =   900
      Width           =   855
   End
   Begin VB.TextBox txtRead1 
      Height          =   315
      Left            =   1440
      TabIndex        =   10
      Text            =   "Text1"
      Top             =   900
      Width           =   1875
   End
   Begin VB.CommandButton cmdSet1 
      Caption         =   "Set"
      Height          =   315
      Left            =   3360
      TabIndex        =   9
      Top             =   900
      Width           =   495
   End
   Begin VB.CommandButton cmdDCRGet 
      Caption         =   "Get DCR"
      Height          =   315
      Left            =   600
      TabIndex        =   8
      Top             =   2100
      Width           =   795
   End
   Begin VB.TextBox txtDCR 
      Height          =   285
      Left            =   1440
      TabIndex        =   7
      Text            =   "Text1"
      Top             =   2100
      Width           =   1875
   End
   Begin VB.CommandButton cmdDCRSet 
      Caption         =   "Set"
      Height          =   315
      Left            =   3360
      TabIndex        =   6
      Top             =   2100
      Width           =   495
   End
   Begin VB.CommandButton cmdSet0 
      Caption         =   "Set"
      Height          =   315
      Left            =   3360
      TabIndex        =   5
      Top             =   540
      Width           =   495
   End
   Begin VB.CommandButton cmdECRSet 
      Caption         =   "Set"
      Height          =   315
      Left            =   3360
      TabIndex        =   4
      Top             =   1740
      Width           =   495
   End
   Begin VB.TextBox txtECR 
      Height          =   285
      Left            =   1440
      TabIndex        =   3
      Text            =   "Text1"
      Top             =   1740
      Width           =   1875
   End
   Begin VB.CommandButton cmdECRGet 
      Caption         =   "Get ECR"
      Height          =   315
      Left            =   600
      TabIndex        =   2
      Top             =   1740
      Width           =   795
   End
   Begin VB.TextBox txtRead0 
      Height          =   315
      Left            =   1440
      TabIndex        =   1
      Text            =   "Text1"
      Top             =   540
      Width           =   1875
   End
   Begin VB.CommandButton cmdRead0 
      Caption         =   "Read +0"
      Height          =   315
      Left            =   540
      TabIndex        =   0
      Top             =   540
      Width           =   855
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function Inp Lib "inpout32.dll" Alias "Inp32" (ByVal PortAddress As Integer) As Integer
Private Declare Sub Out Lib "inpout32.dll" Alias "Out32" (ByVal PortAddress As Integer, ByVal Value As Integer)

Const base_port = &H378 ' base port for outputting.  LPT1 = 0x378


Private Sub cmdECRGet_Click()
   Dim val
   
   val = Inp(base_port + &H402)
   txtECR.Text = "0x" & Hex(val) & " = " & Binary(val)
End Sub
Private Sub cmdECRSet_Click()
   Dim cur_ecr

   cur_ecr = Inp(base_port + &H402)
   Out base_port + &H402, (cur_ecr And &H1F) Or &H20 ' 001x xxxx, set ecp port to byte (ps/2) mode
   
   cmdECRGet_Click
End Sub



Private Sub cmdDCRGet_Click()
   Dim val
   
   val = Inp(base_port + &H2)
   txtDCR.Text = "0x" & Hex(val) & " = " & Binary(val)
End Sub
Private Sub cmdDCRSet_Click()
   Dim cur_dcr

   cur_dcr = Inp(base_port + &H2)
'   Out base_port + &H2, (cur_dcr And &HFF) Or &H10 ' xxx1 xxxx, set dcr to direction=1
   Out base_port + &H2, (cur_dcr And &HDF) Or &H20 ' 11x1 1111
   
   cmdDCRGet_Click
End Sub




Private Sub cmdRead0_Click()
   Dim val
   val = Inp(base_port + 0)
   txtRead0.Text = "0x" & Hex(val) & " = " & Binary(val)
End Sub

Private Sub cmdRead1_Click()
   Dim val
   val = Inp(base_port + 1)
   txtRead1.Text = "0x" & Hex(val) & " = " & Binary(val)
End Sub

Private Sub cmdRead2_Click()
   Dim val
   val = Inp(base_port + 2)
   txtRead2.Text = "0x" & Hex(val) & " = " & Binary(val)
End Sub

Private Sub cmdRead_Click()
   Dim val, val1, val2, val3 As String
   val1 = Inp(base_port + &H1)
   val2 = Inp(base_port + &H2)
   
   val1 = val1 And &HF8 ' 1111 1000
   val2 = val2 And &H7  ' 0000 0111
   
   val3 = Binary(val1 Or val2)
   If Mid(val3, 1, 1) = "0" Then
      Mid(val3, 1, 1) = "1"
   Else
      Mid(val3, 1, 1) = "0"
   End If
   If Mid(val3, 7, 1) = "0" Then
      Mid(val3, 7, 1) = "1"
   Else
      Mid(val3, 7, 1) = "0"
   End If
   If Mid(val3, 8, 1) = "0" Then
      Mid(val3, 8, 1) = "1"
   Else
      Mid(val3, 8, 1) = "0"
   End If
         
   val = FromBinary(val3)
   
   txtRead.Text = "0x" & Hex(val) & " = " & Binary(val)

'   MsgBox "FF=" & Binary(&HFF) & "; F0=" & Binary(&HF0) & "; 0F=" & Binary(&HF)
End Sub
Private Sub cmdSet_Click()
   Out base_port + &H402, &HE0
End Sub


Private Function Binary(val)
   Dim cur
   
   Binary = ""
   cur = val
   
   If cur >= 2 ^ 7 Then
      Binary = Binary & "1"
      cur = cur - 2 ^ 7
   Else
      Binary = Binary & "0"
   End If
   If cur >= 2 ^ 6 Then
      Binary = Binary & "1"
      cur = cur - 2 ^ 6
   Else
      Binary = Binary & "0"
   End If
   If cur >= 2 ^ 5 Then
      Binary = Binary & "1"
      cur = cur - 2 ^ 5
   Else
      Binary = Binary & "0"
   End If
   If cur >= 2 ^ 4 Then
      Binary = Binary & "1"
      cur = cur - 2 ^ 4
   Else
      Binary = Binary & "0"
   End If
   If cur >= 2 ^ 3 Then
      Binary = Binary & "1"
      cur = cur - 2 ^ 3
   Else
      Binary = Binary & "0"
   End If
   If cur >= 2 ^ 2 Then
      Binary = Binary & "1"
      cur = cur - 2 ^ 2
   Else
      Binary = Binary & "0"
   End If
   If cur >= 2 ^ 1 Then
      Binary = Binary & "1"
      cur = cur - 2 ^ 1
   Else
      Binary = Binary & "0"
   End If
   
   If cur >= 2 ^ 0 Then
      Binary = Binary & "1"
   Else
      Binary = Binary & "0"
   End If
End Function


Public Function FromBinary(val As String) As Byte
   FromBinary = 0
   If Mid(val, Len(val) - 0, 1) = "1" Then
      FromBinary = FromBinary + 2 ^ 0
   End If
   If Mid(val, Len(val) - 1, 1) = "1" Then
      FromBinary = FromBinary + 2 ^ 1
   End If
   If Mid(val, Len(val) - 2, 1) = "1" Then
      FromBinary = FromBinary + 2 ^ 2
   End If
   If Mid(val, Len(val) - 3, 1) = "1" Then
      FromBinary = FromBinary + 2 ^ 3
   End If
   If Mid(val, Len(val) - 4, 1) = "1" Then
      FromBinary = FromBinary + 2 ^ 4
   End If
   If Mid(val, Len(val) - 5, 1) = "1" Then
      FromBinary = FromBinary + 2 ^ 5
   End If
   If Mid(val, Len(val) - 6, 1) = "1" Then
      FromBinary = FromBinary + 2 ^ 6
   End If
   If Mid(val, Len(val) - 7, 1) = "1" Then
      FromBinary = FromBinary + 2 ^ 7
   End If
End Function