VERSION 5.00
Begin VB.Form Sample8254Form 
   Caption         =   "8254 Counter Sample"
   ClientHeight    =   5445
   ClientLeft      =   7005
   ClientTop       =   5520
   ClientWidth     =   4830
   LinkTopic       =   "Form1"
   ScaleHeight     =   363
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   322
   Begin VB.Timer PulseWidthTimer 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   3480
      Top             =   2040
   End
   Begin VB.Timer FreqInTimer 
      Enabled         =   0   'False
      Interval        =   100
      Left            =   2520
      Top             =   2040
   End
   Begin VB.Frame FeaturesGroup 
      Caption         =   "Features"
      Height          =   690
      Left            =   120
      TabIndex        =   12
      Top             =   60
      Width           =   4590
      Begin VB.OptionButton Features 
         Caption         =   "Pulse Width Measurement"
         Height          =   195
         Index           =   3
         Left            =   2385
         TabIndex        =   16
         Top             =   420
         Width           =   2175
      End
      Begin VB.OptionButton Features 
         Caption         =   "Event Counting"
         Height          =   195
         Index           =   2
         Left            =   2385
         TabIndex        =   15
         Top             =   180
         Width           =   1815
      End
      Begin VB.OptionButton Features 
         Caption         =   "Frequency Generation"
         Height          =   195
         Index           =   1
         Left            =   120
         TabIndex        =   14
         Top             =   420
         Width           =   2055
      End
      Begin VB.OptionButton Features 
         Caption         =   "Frequency Measurement"
         Height          =   195
         Index           =   0
         Left            =   120
         TabIndex        =   13
         Top             =   180
         Width           =   2055
      End
   End
   Begin VB.TextBox Instructions 
      Height          =   2445
      Left            =   120
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   11
      Text            =   "Sample8254Form.frx":0000
      Top             =   2925
      Width           =   4575
   End
   Begin VB.CommandButton ExitButton 
      Caption         =   "E&xit Program"
      Height          =   300
      Left            =   3600
      TabIndex        =   10
      Top             =   2340
      Width           =   1080
   End
   Begin VB.CommandButton StartButton 
      Caption         =   "&Start Test"
      Enabled         =   0   'False
      Height          =   300
      Left            =   2400
      TabIndex        =   9
      Top             =   2340
      Width           =   1080
   End
   Begin VB.Frame BaseGroup 
      Caption         =   "Base Address of 8254 Chip"
      Height          =   810
      Left            =   120
      TabIndex        =   6
      Top             =   2025
      Width           =   2145
      Begin VB.TextBox BaseEdit 
         Height          =   285
         Left            =   960
         TabIndex        =   8
         Text            =   "E010"
         Top             =   360
         Width           =   855
      End
      Begin VB.Label HexLabel 
         Caption         =   "Hex:"
         Height          =   255
         Left            =   360
         TabIndex        =   7
         Top             =   360
         Width           =   495
      End
   End
   Begin VB.Frame FeaturePanels 
      Height          =   1170
      Index           =   2
      Left            =   120
      TabIndex        =   0
      Top             =   780
      Visible         =   0   'False
      Width           =   4590
      Begin VB.TextBox EventCountEdit 
         Height          =   315
         Left            =   2400
         Locked          =   -1  'True
         TabIndex        =   4
         Top             =   240
         Width           =   1965
      End
      Begin VB.CommandButton SinceLastButton 
         Caption         =   "Since &Last"
         Height          =   315
         Left            =   3240
         TabIndex        =   3
         Top             =   720
         Width           =   1080
      End
      Begin VB.CommandButton SinceFirstButton 
         Caption         =   "Since &First"
         Height          =   315
         Left            =   1740
         TabIndex        =   2
         Top             =   720
         Width           =   1080
      End
      Begin VB.CommandButton EventTestButton 
         Caption         =   "Stop && &Reset"
         Height          =   315
         Left            =   240
         TabIndex        =   1
         Top             =   720
         Width           =   1080
      End
      Begin VB.Label EventCountLabel 
         Caption         =   "Event Counts:"
         Height          =   315
         Left            =   240
         TabIndex        =   5
         Top             =   240
         Width           =   1950
      End
   End
   Begin VB.Frame FeaturePanels 
      Height          =   1170
      Index           =   0
      Left            =   120
      TabIndex        =   19
      Top             =   780
      Width           =   4590
      Begin VB.TextBox FreqInEdit 
         Height          =   315
         Left            =   2340
         Locked          =   -1  'True
         TabIndex        =   21
         Top             =   480
         Width           =   1965
      End
      Begin VB.Label FreqInLabel 
         Caption         =   "Measured Frequency (Hz):"
         Height          =   195
         Left            =   300
         TabIndex        =   20
         Top             =   540
         Width           =   1950
      End
   End
   Begin VB.Frame FeaturePanels 
      Height          =   1170
      Index           =   3
      Left            =   120
      TabIndex        =   18
      Top             =   780
      Visible         =   0   'False
      Width           =   4590
      Begin VB.TextBox PulseEdit 
         Height          =   315
         Left            =   2340
         Locked          =   -1  'True
         TabIndex        =   27
         Top             =   480
         Width           =   1965
      End
      Begin VB.Label PulseWidthLabel 
         Caption         =   "Pulse Width (µsec): "
         Height          =   195
         Left            =   300
         TabIndex        =   26
         Top             =   540
         Width           =   1950
      End
   End
   Begin VB.Frame FeaturePanels 
      Height          =   1170
      Index           =   1
      Left            =   120
      TabIndex        =   17
      Top             =   780
      Visible         =   0   'False
      Width           =   4590
      Begin VB.TextBox RealEdit 
         Height          =   315
         Left            =   2400
         Locked          =   -1  'True
         TabIndex        =   25
         Top             =   750
         Width           =   1965
      End
      Begin VB.TextBox FreqOutEdit 
         Height          =   315
         Left            =   2400
         TabIndex        =   24
         Text            =   "150000"
         Top             =   240
         Width           =   1965
      End
      Begin VB.Label OutFreqLabel 
         Caption         =   "Actual Output Frequency (Hz):"
         Height          =   195
         Left            =   210
         TabIndex        =   23
         Top             =   810
         Width           =   2160
      End
      Begin VB.Label FreqOutLabel 
         Caption         =   "Frequency for Output (Hz):"
         Height          =   195
         Left            =   210
         TabIndex        =   22
         Top             =   300
         Width           =   2160
      End
   End
End
Attribute VB_Name = "Sample8254Form"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function OutPortB Lib "ACCES32.dll" Alias "VBOutPortB" (ByVal Port As Long, ByVal value As Byte) As Integer
Private Declare Function InPortB Lib "ACCES32.dll" Alias "VBInPortB" (ByVal Port As Long) As Integer
Private Const INITIALIZE = 1      ' initialize the counter
Private Const START = 2           ' start counting
Private Const SINCESTART = 4      ' how many since starting
Private Const SINCELAST = 8       ' how many since last check
Private Const CtrSTOP = 16        ' stop counting
Private Const RESET = 32          ' reset counter to 65535
Public BaseAddress As Long

Private Sub CtrMode(Base As Long, Counter As Byte, Mode As Byte)
   Dim Ctrl As Byte

   Ctrl = (Counter * 64) Or &H30 Or (Mode * 2)
   Call OutPortB(Base + 3, Ctrl)
End Sub

Private Sub CtrLoad(Base As Long, Counter As Byte, Val As Long)
   Call OutPortB(Base + Counter, Val And &HFF)
   Call OutPortB(Base + Counter, (Val \ 256) And &HFF)
End Sub

' NOTE: CtrRead isn't used in this sample, but it is here for reference
Private Function CtrRead(Base As Long, Counter As Byte) As Long
   Call OutPortB(Base + 3, Counter * 64)
   CtrRead = InPortB(Base + Counter) + (InPortB(Base + Counter) * 256)
End Function

Private Function ReadStatus(Base As Long) As Long
   Dim Result
   
   Call OutPortB(Base + 3, &HE4)      ' 1110 0100 ReadBack for ctr1
   Result = InPortB(Base + 1)         ' ctr1 output
   ReadStatus = Result * 128
End Function

Private Sub InitCounter(Base As Long)
   Call CtrMode(Base, 0, 0)           ' 0011 0000 ctr0 LSB/MSB mode 0
   Call CtrLoad(Base, 0, 65535)       ' load 65535 into ctr0
End Sub

Private Function ReadCounter0(Base As Long) As Long
   Dim LSB As Long
   Dim MSB As Long

   Call OutPortB(Base + 3, &HD2)      ' 1101 0010 RB ctr0 latch
   LSB = InPortB(Base)                ' LSB of ctr0
   MSB = InPortB(Base)                ' MSB of ctr0

   ReadCounter0 = (MSB * 256) + LSB       ' values at ctr1 = 0
End Function

Private Function ReadCounter1(Base As Long) As Long
   Dim LSB As Long
   Dim MSB As Long

   Call OutPortB(Base + 3, &HD4)      ' 1101 0100 Read Back counts ctr1
   LSB = InPortB(Base + 1)            ' ctr1 counts LSB
   MSB = InPortB(Base + 1)            ' ctr1 counts MSB

   ReadCounter1 = (MSB * 256) + LSB
End Function

Private Function ReadCounter2(Base As Long) As Long
   Dim LSB As Long
   Dim MSB As Long

   Call OutPortB(Base + 3, &HD8)      ' 1101 1000 Read Back counts ctr2
   LSB = InPortB(Base + 2)            ' ctr1 counts LSB
   MSB = InPortB(Base + 2)            ' ctr1 counts MSB

   ReadCounter2 = (MSB * 256) + LSB
End Function

Private Sub Features_Click(Index As Integer)
   StartButton.Enabled = True
   FreqInTimer.Enabled = False
   PulseWidthTimer.Enabled = False
   If Features(0).value Then
      StartButton.Caption = "Start Input"
      FeaturePanels(0).Visible = True
      FeaturePanels(1).Visible = False
      FeaturePanels(2).Visible = False
      FeaturePanels(3).Visible = False
      Instructions.SelStart = 161
      Instructions.SelLength = 1000
      Instructions.SelText = "Frequency Measurement requires CTR0 Gate controlled by CTR1 Output and a 1MHz clock input to CTR1. Bring the the frequency you want to measure into Counter 0 input." + _
         vbCrLf + "Click the ""Start Measure"" button to demonstrate the frequency measuring feature. The measured frequency will be displayed in the text box."
   ElseIf Features(1).value Then
      StartButton.Caption = "Start Output"
      FeaturePanels(0).Visible = False
      FeaturePanels(1).Visible = True
      FeaturePanels(2).Visible = False
      FeaturePanels(3).Visible = False
      Instructions.SelStart = 161
      Instructions.SelLength = 1000
      Instructions.SelText = "Frequency Generation requires a 1MHz input to CTR1, and CTR1 Output connected to CTR2 Clock, as well as both CTR1 & CTR2 Gates enabled. The frequency will be generated from Counter 2 output." + _
         vbCrLf + "To demonstrate the frequency output feature, enter the desired output frequency in the text box, then click the ""Start Output""" + _
         vbCrLf + "The actual output frequency will be also be displayed."
   ElseIf Features(2).value Then
       StartButton.Caption = "Start Counts"
      FeaturePanels(0).Visible = False
      FeaturePanels(1).Visible = False
      FeaturePanels(2).Visible = True
      FeaturePanels(3).Visible = False
      Instructions.SelStart = 161
      Instructions.SelLength = 1000
      Instructions.SelText = "Event Counting requires CTR0 Gate enabled, or connected to CTR1. Bring your pulse train in on Counter 0 input." + _
         vbCrLf + "Click the ""Start Counting"" button to demonstrate the event counting feature. Use the ""Since First"" and ""Since Last"" buttons to display the event counts since starting the demo, and since the last reading, respectively." + _
         vbCrLf + "Use the ""Stop & Reset"" button to stop the demo, and reset the count."
   ElseIf Features(3).value Then
      StartButton.Caption = "Start Pulse"
      FeaturePanels(0).Visible = False
      FeaturePanels(1).Visible = False
      FeaturePanels(2).Visible = False
      FeaturePanels(3).Visible = True
      Instructions.SelStart = 161
      Instructions.SelLength = 1000
      Instructions.SelText = "Pulse Width Measurement requires a 1MHz input to CTR1. Bring the the signal you want to measure into Gate 1." + _
         vbCrLf + "Click the ""Start Measure"" button to demonstrate the pulse width measuring feature. The measured pulse width will be displayed in the text box."
   End If
End Sub

Private Sub Form_Load()
   If (InPortB(&H61) = &HAA55) Then
      Call MsgBox("ACCESNT.SYS not detected. Please copy ACCESNT.SYS into [NT]/system32/drivers and re-run this sample.", 0, "Warning")
   End If
End Sub

Private Sub FreqInTimer_Timer()
   Dim SecondCount As Long
   Dim Timeout As Long

   Timeout = 65535
   Call CtrMode(BaseAddress, 1, 3)            ' 0111 0110 ctr1 mode3, LSB/MSB
   Call CtrLoad(BaseAddress, 1, 65534)        ' load LSB and MSB values into ctr1 to make slow input to gate 0

   Do While (ReadStatus(BaseAddress) = 1) And (Timeout <> 0)
      Timeout = Timeout - 1               ' out ctr1 = 1
   Loop
   Timeout = 65535
   Call CtrMode(BaseAddress, 0, 2)            ' 0011 0100 ctr0 mode 2 L/M
   Call CtrLoad(BaseAddress, 0, 65535)        ' load 65535 into ctr 0
   Do While (ReadStatus(BaseAddress) = 0) And (Timeout <> 0)
      Timeout = Timeout - 1                   ' ctr1 still 0
   Loop
   Timeout = 65535
   Do While (ReadStatus(BaseAddress) = 1) And (Timeout <> 0)
      Timeout = Timeout - 1                   ' ctr1 = 1
   Loop
   SecondCount = ReadCounter0(BaseAddress)    ' read value of counter
   FreqInEdit.Text = Round((65535 - SecondCount) / 0.032767) ' convert from counts to f
End Sub

Private Function FreqOutTest(Base As Long, Frequency As Long) As Double
   Dim countsA As Long
   Dim countsB As Long
   Dim Temp As Long
   Dim trash As Double
   Dim x As Long

   x = 2
   FreqOutTest = 0
   If ((Frequency > 250000) Or (Frequency < 1)) Then
      End                             ' return if freq is too low/high
   End If

   trash = Frequency                  ' convert to float for division
   trash = 1000000 / trash            ' calculate the number of counts
   Temp = Round(trash)                ' round to the nearest count

   Do                                 ' try to divide the counts
      countsA = x                     ' evenly between the two counters
      x = x + 1
   Loop Until Not (((Temp Mod countsA) <> 0) And (countsA < Temp) And (countsA < 65535))     ' exit if counts too high

   If ((countsA >= Temp) And (Temp < 131070)) Then  ' went through all vals
      countsA = 2                     ' counter can only hold 65535
      countsB = Temp \ 2
   Else
      If (Temp >= 131070) Then        ' counts too high to fit in counter
         countsA = 20                 ' divide to make fit
         countsB = Temp \ 20
      Else
         countsB = Temp \ countsA     ' if found divisor use it
      End If
   End If
   Call CtrMode(Base, 2, 3)        ' 1011 1110 ctr2 mode3
   Call CtrLoad(Base, 2, countsA)

   Call CtrMode(Base, 1, 2)        ' 0111 0100 ctr1 mode2
   Call CtrLoad(Base, 1, countsB)
   FreqOutTest = 1000000 / (countsA * countsB)
End Function

Private Function EventCountTest(Base As Long, feature As Integer) As Long
   Static PreviousMeasure As Long
   Dim CurrentMeasure As Long
   Dim ReturnValue As Long
   Dim Flag As Boolean

   Flag = False
   ReturnValue = 0
   CurrentMeasure = 0
   If (INITIALIZE And feature) <> 0 Then             ' 1
      InitCounter (Base)                 ' init counter0 to count in mode 0
   End If

   If (START And feature) <> 0 Then                  ' 2
      Call CtrMode(Base, 1, 1)            ' 0111 0010 ctr1 LSB/MSB mode 1
   End If                                 ' to hold gate of ctr0 high

   If (SINCESTART And feature) <> 0 Then             ' 4
      If Not (Flag) Then                  ' counts down from 65535
         CurrentMeasure = 65535 - ReadCounter0(Base)
         Flag = True                      ' flag read counter
      End If
      ReturnValue = CurrentMeasure        ' set value to return
   End If

   If (SINCELAST And feature) <> 0 Then              ' 8
      If Not (Flag) Then                  ' calculate counts
         CurrentMeasure = 65535 - ReadCounter0(Base)
         Flag = True
      End If                              ' calculate since last
      ReturnValue = CurrentMeasure - PreviousMeasure
   End If

   If (CtrSTOP And feature) <> 0 Then                ' 16
      Call CtrMode(Base, 1, 0)            ' 0111 0000 ctr1 mode0 out=0
   End If

   If (RESET And feature) <> 0 Then                  ' 32
      InitCounter (Base)                 ' init counter to 65535
      PreviousMeasure = 0                 ' no previous counts
   End If

   If (Flag) Then                         ' set previous measure if counter read
      PreviousMeasure = CurrentMeasure
      EventCountTest = ReturnValue        ' if counter read return value
   Else
      EventCountTest = 0                  ' return 0 if counter not read
   End If
End Function

Private Sub SinceFirstButton_Click()
   EventCountEdit.Text = EventCountTest(BaseAddress, SINCESTART)
End Sub

Private Sub SinceLastButton_Click()
   EventCountEdit.Text = EventCountTest(BaseAddress, SINCELAST)
End Sub

Private Sub EventTestButton_Click()
   Call EventCountTest(BaseAddress, CtrSTOP + RESET)
End Sub

Private Sub PulseWidthTimer_Timer()
   Const TIMEOUTVAL = 150000
   Dim Temp As Long
   Dim SecondCount As Long
   Dim PreviousCount As Long
   Dim Timeout As Long
   Dim one As Long
   Dim two As Long

   Call CtrMode(BaseAddress, 2, 2)       ' ctr2 mode2
   Call CtrLoad(BaseAddress, 2, 65535)   ' write 65535 to counter 2
   Call CtrMode(BaseAddress, 1, 2)       ' ctr1 mode2
   Call CtrLoad(BaseAddress, 1, 65535)   ' write 65535 to counter 1

   Temp = ReadCounter1(BaseAddress)      ' read the counter
   Timeout = 0

   'the following two repeat-until loops ensure a high transition has happened
   '(a high on gate input reloads the counter)
   Do
      PreviousCount = Temp
      Temp = ReadCounter1(BaseAddress)
      Timeout = Timeout + 1
   Loop Until ((Temp = PreviousCount) Or (Timeout >= TIMEOUTVAL))
   
   one = ReadCounter2(BaseAddress)
   If (Timeout < TIMEOUTVAL) Then Timeout = 0

   Do
      SecondCount = ReadCounter1(BaseAddress)
      Timeout = Timeout + 1
   Loop Until ((Temp <> SecondCount) Or (Timeout >= TIMEOUTVAL))
   If (Timeout < TIMEOUTVAL) Then Timeout = 0

' wait until the counts stop (low on the gate again)
   Do
      PreviousCount = SecondCount
      SecondCount = ReadCounter1(BaseAddress)
      Timeout = Timeout + 1
   Loop Until ((SecondCount = PreviousCount) Or (Timeout >= TIMEOUTVAL))

   two = ReadCounter2(BaseAddress)
   If (Timeout < TIMEOUTVAL) Then
      PulseEdit.Text = (one - two) * 65536 + (65535 - SecondCount) ' return the counts for the pulse
   Else
      PulseEdit.Text = 0
   End If
End Sub

Private Sub StartButton_Click()
   Dim Frequency As Long
   
   BaseAddress = "&H" + BaseEdit.Text

   If FeaturePanels(0).Visible Then
      If FreqInTimer.Enabled = False Then
         FreqInTimer.Tag = BaseAddress
         StartButton.Caption = "Stop Input"
         FreqInTimer.Enabled = True
      Else
         StartButton.Caption = "Start Input"
         FreqInTimer.Enabled = False
      End If
   ElseIf FeaturePanels(1).Visible Then
      Frequency = FreqOutEdit.Text
      RealEdit.Text = FreqOutTest(BaseAddress, Frequency)
   ElseIf FeaturePanels(2).Visible Then
      Call EventCountTest(BaseAddress, INITIALIZE + START)
   ElseIf FeaturePanels(3).Visible Then
      If Not PulseWidthTimer.Enabled Then
         PulseWidthTimer.Tag = BaseAddress
         StartButton.Caption = "Stop Pulse"
         PulseWidthTimer.Enabled = True
      Else
         StartButton.Caption = "Start Pulse"
         PulseWidthTimer.Enabled = False
      End If
   End If
End Sub

Private Sub ExitButton_Click()
   End
End Sub