VERSION 5.00 Begin VB.Form Sample0Form Caption = "Sample 0" ClientHeight = 6375 ClientLeft = 60 ClientTop = 345 ClientWidth = 5775 LinkTopic = "Form1" ScaleHeight = 425 ScaleMode = 3 'Pixel ScaleWidth = 385 StartUpPosition = 3 'Windows Default Begin VB.Frame BaseAddressBox Caption = "Base Address for ISA Card" Height = 855 Left = 120 TabIndex = 12 Top = 5400 Width = 2175 Begin VB.TextBox BaseEdit Height = 315 Left = 720 TabIndex = 13 Text = "300" Top = 360 Width = 1215 End Begin VB.Label Label2 Caption = "Hex" Height = 195 Left = 240 TabIndex = 14 Top = 400 Width = 285 End End Begin VB.CommandButton TestButton Caption = "Start test" Height = 375 Left = 2520 TabIndex = 11 Top = 5640 Width = 1455 End Begin VB.CommandButton ExitButton Caption = "E&xit Program" Height = 375 Left = 4200 TabIndex = 10 Top = 5640 Width = 1455 End Begin VB.TextBox InstructText BackColor = &H8000000F& Height = 1455 Left = 120 Locked = -1 'True MultiLine = -1 'True TabIndex = 9 Text = "sample0u.frx":0000 Top = 360 Width = 5535 End Begin VB.Frame ChannelBox Height = 3075 Left = 120 TabIndex = 0 Top = 2160 Width = 5535 Begin VB.Label ChannelLabel Caption = " Channel 0" BeginProperty Font Name = "Courier New" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 210 Index = 0 Left = 30 TabIndex = 8 Top = 240 Width = 5475 End Begin VB.Label ChannelLabel Caption = " Channel 3" BeginProperty Font Name = "Courier New" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 210 Index = 3 Left = 30 TabIndex = 7 Top = 1320 Width = 5475 End Begin VB.Label ChannelLabel Caption = " Channel 4" BeginProperty Font Name = "Courier New" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 210 Index = 4 Left = 30 TabIndex = 6 Top = 1680 Width = 5475 End Begin VB.Label ChannelLabel Caption = " Channel 5" BeginProperty Font Name = "Courier New" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 210 Index = 5 Left = 30 TabIndex = 5 Top = 2040 Width = 5475 End Begin VB.Label ChannelLabel Caption = " Channel 6" BeginProperty Font Name = "Courier New" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 210 Index = 6 Left = 30 TabIndex = 4 Top = 2400 Width = 5475 End Begin VB.Label ChannelLabel Caption = " Channel 7" BeginProperty Font Name = "Courier New" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 210 Index = 7 Left = 30 TabIndex = 3 Top = 2760 Width = 5475 End Begin VB.Label ChannelLabel Caption = " Channel 2" BeginProperty Font Name = "Courier New" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 210 Index = 2 Left = 30 TabIndex = 2 Top = 960 Width = 5475 End Begin VB.Label ChannelLabel Caption = " Channel 1" BeginProperty Font Name = "Courier New" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 210 Index = 1 Left = 30 TabIndex = 1 Top = 600 Width = 5475 End End Begin VB.Timer TestTimer Enabled = 0 'False Interval = 100 Left = 3840 Top = 0 End Begin VB.Label CardName Alignment = 2 'Center AutoSize = -1 'True Caption = "AIO-8P" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 300 Left = 2490 TabIndex = 16 Top = 0 Width = 795 End Begin VB.Label TitleLabel Alignment = 2 'Center Caption = " Channel Count Volts " BeginProperty Font Name = "Courier New" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 210 Left = 240 TabIndex = 15 Top = 1920 Width = 5250 End End Attribute VB_Name = "Sample0Form" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Private Declare Function GetTickCount Lib "kernel32" () As Long Private Declare Function InPortB Lib "ACCES32" Alias "VBInPortB" (ByVal Port As Long) As Integer Private Declare Function OutPortB Lib "ACCES32" Alias "VBOutPortB" (ByVal Port As Long, ByVal Value As Byte) As Integer Private Declare Function InPort Lib "ACCES32" Alias "VBInPort" (ByVal Port As Long) As Integer Private Sub ExitButton_Click() End 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 TestButton_Click() Dim i As Integer If TestTimer.Enabled = True Then TestTimer.Enabled = False For i = 0 To 7 ChannelLabel(i).Caption = " Channel " & Hex$(i) & " 0 0" Next TestButton.Caption = "Start Test" Else TestTimer.Enabled = True TestButton.Caption = "Abort Test" End If End Sub Private Sub TestTimer_Timer() Dim volts As Double Dim counts As Integer base = "&H" + BaseEdit.Text For channel = 0 To 7 Call OutPortB(base + 2, channel) ' Set channel For i = 0 To 32000 Next ' Wait for settle count, this is an empty loop Call OutPortB(base + 1, 0) ' Start A/D conversion j = 0 ' Wait for EOC or timeout Do While (((InPortB(base + 2) And &H80) >= &H80) And (j < 32000)) j = j + 1 Loop ' end do while If j >= 32000 Then ChannelLabel(channel).Caption = " Timeout on channel " & Hex$(channel) End If counts = (InPort(base) \ 16) And &HFFF ' Read count data ' Scaling 5v range on 12 bit device = 0.00244v/count volts = (counts - 2048#) * 0.00244 ' Display results } ChannelLabel(channel).Caption = " Channel " & Hex$(channel) & " " & Format(counts, "###0") & " " & Format(volts, "###0.000") Next ' end for End Sub