VERSION 5.00 Begin VB.Form MainForm Caption = "USB-DIO16A Family Sample Program" ClientHeight = 7575 ClientLeft = 60 ClientTop = 345 ClientWidth = 11175 LinkTopic = "Form1" ScaleHeight = 505 ScaleMode = 3 'Pixel ScaleWidth = 745 StartUpPosition = 2 'CenterScreen Begin VB.Frame Frame1 Caption = "Frame1" Height = 2895 Left = 8400 TabIndex = 44 Top = 1440 Visible = 0 'False Width = 1935 Begin VB.Image LevelImage Height = 375 Index = 31 Left = 1440 Top = 1080 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 30 Left = 1080 Top = 1080 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 29 Left = 720 Top = 1080 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 28 Left = 360 Top = 1080 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 27 Left = 0 Top = 1080 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 23 Left = 1440 Top = 720 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 22 Left = 1080 Top = 720 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 21 Left = 720 Top = 720 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 20 Left = 360 Top = 720 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 19 Left = 0 Top = 720 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 15 Left = 1440 Top = 360 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 14 Left = 1080 Top = 360 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 13 Left = 720 Top = 360 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 12 Left = 360 Top = 360 Width = 375 End End Begin VB.Timer ReadTime Enabled = 0 'False Interval = 1 Left = 6840 Top = 0 End Begin VB.TextBox RecLenEdit Height = 315 Left = 8280 TabIndex = 38 Text = "256" Top = 960 Width = 2775 End Begin VB.Frame Frame2 Height = 2055 Left = 120 TabIndex = 13 Top = 4440 Width = 8055 Begin VB.CheckBox TristateButton Caption = "Tristate Port B, C, D, and the Fast Digital Port" Height = 375 Index = 1 Left = 3120 Style = 1 'Graphical TabIndex = 46 Top = 1560 Value = 1 'Checked Width = 4815 End Begin VB.CheckBox TristateButton Caption = "Tristate Port A" Height = 375 Index = 0 Left = 120 Style = 1 'Graphical TabIndex = 45 Top = 1560 Value = 1 'Checked Width = 2895 End Begin VB.CheckBox OutButton Caption = "Output" Height = 375 Index = 4 Left = 7080 Style = 1 'Graphical TabIndex = 43 Top = 1080 Width = 855 End Begin VB.CheckBox OutButton Caption = "Output" Height = 375 Index = 3 Left = 5880 Style = 1 'Graphical TabIndex = 42 Top = 1080 Width = 1095 End Begin VB.CheckBox OutButton Caption = "Output" Height = 375 Index = 2 Left = 4680 Style = 1 'Graphical TabIndex = 41 Top = 1080 Width = 1095 End Begin VB.CheckBox OutButton Caption = "Output" Height = 375 Index = 1 Left = 3120 Style = 1 'Graphical TabIndex = 40 Top = 1080 Width = 1455 End Begin VB.CheckBox OutButton Caption = "Output" Height = 375 Index = 0 Left = 120 Style = 1 'Graphical TabIndex = 39 Top = 1080 Width = 2895 End Begin VB.Label Label24 Caption = "Fast Port" Height = 255 Left = 7080 TabIndex = 36 Top = 120 Width = 855 End Begin VB.Label Label23 Caption = "Port D" Height = 255 Left = 5880 TabIndex = 35 Top = 120 Width = 1095 End Begin VB.Label Label22 Caption = "Port C" Height = 255 Left = 4680 TabIndex = 34 Top = 120 Width = 1095 End Begin VB.Label Label21 Caption = "Port B" Height = 255 Left = 3120 TabIndex = 33 Top = 120 Width = 1215 End Begin VB.Image LevelImage Height = 375 Index = 26 Left = 5880 Top = 600 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 25 Left = 6240 Top = 600 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 24 Left = 6600 Top = 600 Width = 375 End Begin VB.Label Label20 Alignment = 2 'Center Caption = "0" Height = 255 Left = 6600 TabIndex = 32 Top = 360 Width = 375 End Begin VB.Label Label19 Alignment = 2 'Center Caption = "1" Height = 255 Left = 6240 TabIndex = 31 Top = 360 Width = 375 End Begin VB.Label Label18 Alignment = 2 'Center Caption = "2" Height = 255 Left = 5880 TabIndex = 30 Top = 360 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 18 Left = 4680 Top = 600 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 17 Left = 5040 Top = 600 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 16 Left = 5400 Top = 600 Width = 375 End Begin VB.Label Label17 Alignment = 2 'Center Caption = "0" Height = 255 Left = 5400 TabIndex = 29 Top = 360 Width = 375 End Begin VB.Label Label16 Alignment = 2 'Center Caption = "1" Height = 255 Left = 5040 TabIndex = 28 Top = 360 Width = 375 End Begin VB.Label Label15 Alignment = 2 'Center Caption = "2" Height = 255 Left = 4680 TabIndex = 27 Top = 360 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 11 Left = 3120 Top = 600 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 10 Left = 3480 Top = 600 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 9 Left = 3840 Top = 600 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 8 Left = 4200 Top = 600 Width = 375 End Begin VB.Label Label14 Alignment = 2 'Center Caption = "0" Height = 255 Left = 4200 TabIndex = 26 Top = 360 Width = 375 End Begin VB.Label Label13 Alignment = 2 'Center Caption = "1" Height = 255 Left = 3840 TabIndex = 25 Top = 360 Width = 375 End Begin VB.Label Label12 Alignment = 2 'Center Caption = "2" Height = 255 Left = 3480 TabIndex = 24 Top = 360 Width = 375 End Begin VB.Label Label11 Alignment = 2 'Center Caption = "3" Height = 255 Left = 3120 TabIndex = 23 Top = 360 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 7 Left = 120 Top = 600 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 6 Left = 480 Top = 600 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 5 Left = 840 Top = 600 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 4 Left = 1200 Top = 600 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 3 Left = 1560 Top = 600 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 2 Left = 1920 Top = 600 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 1 Left = 2280 Top = 600 Width = 375 End Begin VB.Image LevelImage Height = 375 Index = 0 Left = 2640 Top = 600 Width = 375 End Begin VB.Label Label10 Alignment = 2 'Center Caption = "0" Height = 255 Left = 2640 TabIndex = 22 Top = 360 Width = 375 End Begin VB.Label Label9 Alignment = 2 'Center Caption = "1" Height = 255 Left = 2280 TabIndex = 21 Top = 360 Width = 375 End Begin VB.Label Label8 Alignment = 2 'Center Caption = "2" Height = 255 Left = 1920 TabIndex = 20 Top = 360 Width = 375 End Begin VB.Label Label7 Alignment = 2 'Center Caption = "3" Height = 255 Left = 1560 TabIndex = 19 Top = 360 Width = 375 End Begin VB.Label Label6 Alignment = 2 'Center Caption = "4" Height = 255 Left = 1200 TabIndex = 18 Top = 360 Width = 375 End Begin VB.Label Label5 Alignment = 2 'Center Caption = "5" Height = 255 Left = 840 TabIndex = 17 Top = 360 Width = 375 End Begin VB.Label Label4 Alignment = 2 'Center Caption = "6" Height = 255 Left = 480 TabIndex = 16 Top = 360 Width = 375 End Begin VB.Label Label3 Alignment = 2 'Center Caption = "7" Height = 255 Left = 120 TabIndex = 15 Top = 360 Width = 375 End Begin VB.Label Label2 Caption = "Port A" Height = 255 Left = 120 TabIndex = 14 Top = 120 Width = 1215 End End Begin VB.TextBox DataMemo Height = 6135 Left = 8280 MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 11 Top = 1320 Width = 2775 End Begin VB.Frame ClockPanel Caption = "Frequency Source" Height = 855 Left = 120 TabIndex = 8 Top = 6600 Width = 5175 Begin VB.HScrollBar ClockTrack Height = 255 Left = 120 Max = 8000 TabIndex = 9 Top = 240 Value = 1000 Width = 2895 End Begin VB.Label ClockLabel Alignment = 2 'Center Height = 255 Left = 3120 TabIndex = 10 Top = 240 Width = 1935 End End Begin VB.CommandButton DataMemoFillButton Caption = "Add Sample Data for Output >>" Height = 375 Left = 5400 TabIndex = 7 Top = 7080 Width = 2775 End Begin VB.CommandButton ClearDataMemoButton Caption = "Clear Data from list >>" Height = 375 Left = 5400 TabIndex = 6 Top = 6600 Width = 2775 End Begin VB.CommandButton ReceiveButton Caption = "RECEIVE" Height = 375 Left = 8280 TabIndex = 5 Top = 120 Width = 2775 End Begin VB.CommandButton ReceiveCardButton Caption = "Sample Configuration As Input" Height = 375 Left = 4200 TabIndex = 3 Top = 3960 Width = 3975 End Begin VB.CommandButton SendCardButton Caption = "Sample Configuration As Output" Height = 375 Left = 120 TabIndex = 2 Top = 3960 Width = 3975 End Begin VB.CommandButton SendButton Caption = "SEND" Height = 375 Left = 8280 TabIndex = 1 Top = 120 Width = 2775 End Begin VB.TextBox InstructionsMemo Height = 3495 Left = 120 Locked = -1 'True MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 0 Text = "MainForm.frx":0000 Top = 360 Width = 8055 End Begin VB.CheckBox InHexCheck Caption = "In Hex" Height = 255 Left = 8280 TabIndex = 12 Top = 480 Width = 2775 End Begin VB.Label DataMemoLabel Height = 255 Left = 8280 TabIndex = 37 Top = 720 Width = 2775 End Begin VB.Image HighLevel Enabled = 0 'False Height = 360 Left = 7680 Picture = "MainForm.frx":0B5E Top = 0 Visible = 0 'False Width = 360 End Begin VB.Image LowLevel Enabled = 0 'False Height = 360 Left = 7320 Picture = "MainForm.frx":102C Top = 0 Visible = 0 'False Width = 360 End Begin VB.Label InstructionsLabel Alignment = 2 'Center Caption = "Instructions" Height = 255 Left = 120 TabIndex = 4 Top = 120 Width = 8055 End End Attribute VB_Name = "MainForm" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim DeviceIndex As Long Dim DIOData As Long Dim DoUpdate As Boolean Dim FastMode As Long Const fmDI = 1 Const fmDO = 2 Const fmDIO = 3 Private Function DumpFileToString(ByVal Path As String) As String Dim Buf As String Open Path For Binary As 1 Buf = String(LOF(1), " ") Get 1, , Buf Close 1 DumpFileToString = Buf End Function Private Function StrToHex(ByVal S As String) As String Dim Buf As String Dim I As Long Buf = Space$(Len(S) * 2) For I = 1 To Len(S) Mid$(Buf, I * 2 - 1, 2) = Hex$(Asc(Mid$(S, I, 1))) Next StrToHex = Buf End Function Private Function HexToNybble(Hex As String) As Byte Select Case Hex Case "0" To "9": HexToNybble = Asc(Hex) - Asc("0") Case "A" To "F": HexToNybble = Asc(Hex) - Asc("A") + 10 Case "a" To "f": HexToNybble = Asc(Hex) - Asc("a") + 10 Case Else Err.Raise vbObjectError + 513, , "Invalid hex character " & Hex End Select End Function Private Function HexToStr(ByVal H As String) As String Dim Buf As String Dim I As Long Buf = Space$(Len(H) \ 2) For I = 1 To Len(Buf) Mid$(Buf, I, 1) = Chr$(Val("&H" & Mid$(H, I * 2 - 1, 2))) Next HexToStr = Buf End Function Private Sub Form_Load() Dim NameSize As Long, PID As Long, Status As Long Dim OutMask As Byte, TristateMask As Byte Dim NameStr As String Dim I As Long Dim ReadClockHz As Double, WriteClockHz As Double DeviceIndex = diOnly Status = QueryDeviceInfo(DeviceIndex, PID, NameSize, NameStr, 0, 0) If (Status <> 0) Or ((PID And &HFFF8&) <> &H8008&) Then DetectForm.Show vbModal, Me If DetectForm.DetectOK Then DeviceIndex = DetectForm.DeviceIndex Unload DetectForm QueryDeviceInfo DeviceIndex, PID, NameSize, NameStr, 0, 0 Else Unload DetectForm Unload Me Exit Sub End If End If DIO_ConfigurationQuery DeviceIndex, OutMask, TristateMask DIO_ReadAll DeviceIndex, DIOData For I = 0 To 2 OutButton(I).Value = Abs((OutMask And (2 ^ I)) <> 0) Next If (PID = &H8008&) Or (PID = &H800A&) Or (PID = &H800D&) Then 'Input-only boards FastMode = fmDI OutButton(4).Value = 0 ReceiveCardButton.Visible = True SendCardButton.Visible = False ElseIf (PID = &H8009&) Or (PID = &H800E&) Then 'Output-only boards FastMode = fmDO OutButton(4).Value = 1 ReceiveCardButton.Visible = False SendCardButton.Visible = True Else 'Input/output boards FastMode = fmDIO OutButton(4).Value = 0 ReceiveCardButton.Visible = True SendCardButton.Visible = True End If If OutButton(4).Value Then ClockTrack.Value = 3 ClockTrack_Scroll ReceiveButton.Visible = False SendButton.Visible = True DataMemoFillButton.Visible = True DataMemo_Change RecLenEdit.Visible = False Else ClockTrack.Value = 0 ClockTrack_Scroll ReceiveButton.Visible = True SendButton.Visible = False DataMemoFillButton.Visible = False DataMemo_Change RecLenEdit.Visible = True End If ReadClockHz = 0 'External or "off" WriteClockHz = 0 'External or "off" DIO_StreamSetClocks DeviceIndex, ReadClockHz, WriteClockHz DoConfig ReadTime.Enabled = True End Sub Private Function Bit(ByVal Index As Byte) As Long If Index = 31 Then Bit = &H80000000 Else Bit = 2 ^ Index End If End Function Private Sub ReadTime_Timer() Dim I As Long, oDIOData As Long, Changes As Long oDIOData = DIOData DIO_ReadAll DeviceIndex, DIOData Changes = DIOData Xor oDIOData If DoUpdate Then Changes = &HFFFFFFFF DoUpdate = False End If For I = 0 To 31 If Not (LevelImage(I) Is Nothing) Then If (Changes And Bit(I)) <> 0 Then If (DIOData And Bit(I)) <> 0 Then LevelImage(I).Picture = HighLevel.Picture Else LevelImage(I).Picture = LowLevel.Picture End If End If End If Next End Sub Private Sub LevelImage_Click(Index As Integer) Dim NewValue As Boolean DIOData = DIOData Xor Bit(Index) 'Toggle bit NewValue = (DIOData And Bit(Index)) <> 0 'Get new bit value DIO_Write1 DeviceIndex, Index, NewValue 'Write it to the board DoUpdate = True End Sub Sub DoConfig() Dim I As Long Dim OutMask As Byte, TristateMask As Byte OutMask = 0 For I = 0 To 3 If OutButton(I).Value Then OutMask = OutMask Or Bit(I) End If Next TristateMask = 0 For I = 0 To 1 If TristateButton(I).Value Then TristateMask = TristateMask Or Bit(I) End If Next DIO_ConfigureEx DeviceIndex, OutMask, DIOData, TristateMask DIO_StreamOpen DeviceIndex, OutButton(4).Value = 0 DIO_StreamClose DeviceIndex 'AIOUSB_ClearFIFO(DeviceIndex, 0); 'Clear newly selected FIFO DoUpdate = True End Sub Private Sub OutButton_Click(Index As Integer) 'C and D always have opposite directions, so if they change one, change the other to be opposite Select Case Index Case 0 'Set new output byte high, in case user made a mistake; ignored for inputs DIOData = DIOData Or &HFF& Case 1 DIOData = DIOData Or &HFF00& Case 2 OutButton(3).Value = 1 - OutButton(2).Value DIOData = DIOData Or &HFFFF0000 Case 3 OutButton(2).Value = 1 - OutButton(3).Value DIOData = DIOData Or &HFFFF0000 Case 4 'If the board only has one mode, then only allow that one mode Select Case FastMode Case fmDI OutButton(4).Value = 0 Case fmDO OutButton(4).Value = 1 Case fmDIO End Select If OutButton(4).Value Then ClockTrack.Value = 3 Else ClockTrack.Value = 0 End If ClockTrack_Scroll 'Show the buttons for the current direction ReceiveButton.Visible = 1 - OutButton(4).Value SendButton.Visible = OutButton(4).Value DataMemoFillButton.Visible = OutButton(4).Value DataMemo_Change RecLenEdit.Visible = 1 - OutButton(4).Value End Select DoConfig End Sub Private Sub TristateButton_Click(Index As Integer) DoConfig End Sub Private Sub SendCardButton_Click() If FastMode = fmDI Then Exit Sub OutButton(0).Value = 1 OutButton(1).Value = 1 OutButton(2).Value = 1 OutButton(3).Value = 0 OutButton(4).Value = 1 OutButton_Click 4 TristateButton(0).Value = 0 TristateButton(1).Value = 0 ClockTrack.Value = 3 ClockTrack_Scroll DoConfig End Sub Private Sub ReceiveCardButton_Click() If FastMode = fmDO Then Exit Sub OutButton(0).Value = 0 OutButton(1).Value = 0 OutButton(2).Value = 0 OutButton(3).Value = 1 OutButton(4).Value = 0 OutButton_Click 4 TristateButton(0).Value = 0 TristateButton(1).Value = 0 ClockTrack.Value = 0 ClockTrack_Scroll DoConfig End Sub Private Sub ClearDataMemoButton_Click() DataMemo.Text = "" DataMemo_Change End Sub Private Sub DataMemoFillButton_Click() Dim Buf As String Buf = DumpFileToString("sample.txt") 'You could also programmatically generate a stream of data, rather than loading it from a file. 'If you want to send more flexible data, get this data string directly in SendButton_Click() - a memo will alter non-text characters. 'However, this sample is designed to work with text, so here we put it in the memo, so a user can edit it before sending it. DataMemo.Text = Buf End Sub Private Sub SendButton_Click() Dim ReadClockHz As Double, WriteClockHz As Double Dim Buf As String Dim BytesTransferred As Long ReadClockHz = 0 'External or "off" WriteClockHz = ClockTrack.Value * 1000& DIO_StreamSetClocks DeviceIndex, ReadClockHz, WriteClockHz 'Get the data to send; here we get the data from the memo, but see DataMemoFillButton_Click() for other options. Buf = DataMemo.Text If InHexCheck.Value Then Buf = HexToStr(Buf) If (Len(Buf) And 1) <> 0 Then Buf = Buf + Chr$(0) 'Pad out the data to whole words, since the board sends a word at a time DIO_StreamOpen DeviceIndex, False DIO_StreamFrame DeviceIndex, Len(Buf) \ 2, ByVal Buf, BytesTransferred DIO_StreamClose DeviceIndex End Sub Private Sub DataMemo_Change() If OutButton(4).Value Then If InHexCheck.Value Then DataMemoLabel.Caption = "Data To Send: " & Str$((Len(DataMemo.Text) + 3) \ 4) & " Words" Else DataMemoLabel.Caption = "Data To Send: " & Str$((Len(DataMemo.Text) + 1) \ 2) & " Words" End If Else DataMemoLabel.Caption = "Data To Receive:" End If End Sub Private Sub ReceiveButton_Click() Dim ReadClockHz As Double, WriteClockHz As Double Dim Buf As String Dim ReadSize As Long, BytesTransferred As Long ReadClockHz = ClockTrack.Value * 1000 WriteClockHz = 0 'External or "off" DIO_StreamSetClocks DeviceIndex, ReadClockHz, WriteClockHz ReadSize = Val(Trim(RecLenEdit.Text)) Buf = Space$(ReadSize * 2) DIO_StreamOpen DeviceIndex, True DIO_StreamFrame DeviceIndex, ReadSize, ByVal Buf, BytesTransferred DIO_StreamClose DeviceIndex Buf = Left$(Buf, BytesTransferred) 'Rather than displaying the received data in a memo, you could save it, process it further, etc. If InHexCheck.Value Then Buf = StrToHex(Buf) DataMemo.Text = Buf DataMemoLabel.Caption = "Data Received: " & Str$(BytesTransferred \ 2) & " Words" End Sub Private Sub ClockTrack_Scroll() Dim Speed As Integer Speed = ClockTrack.Value If Speed = 0 Then ClockLabel.Caption = "external" Else ClockLabel.Caption = Str$(Speed) + " KHz" End If End Sub Private Sub InHexCheck_Click() DataMemo.Text = "" End Sub