PicoScope 7 Software
Available on Windows, Mac and Linux
Code: Select all
Declare Function UsbDrDaqOpenUnit Lib "USBDrDAQ.dll" (ByRef handle As Integer) As Long
Declare Function UsbDrDaqCloseUnit Lib "USBDrDAQ.dll" (ByVal handle As Integer) As Long
Declare Function UsbDrDaqSetInterval Lib "USBDrDAQ.dll" (ByVal handle As Integer, ByRef us_for_block As Long, ByVal ideal_no_of_samples As Long, ByRef channels As Long, ByVal no_of_channels As Integer) As Long
Declare Function UsbDrDaqRun Lib "USBDrDAQ.dll" (ByVal handle As Integer, ByVal no_of_values As Long, ByVal method As Long) As Long
Declare Function UsbDrDaqGetValues Lib "USBDrDAQ.dll" (ByVal handle As Integer, ByRef values As Integer, ByRef noOfValues As Long, ByRef overflow As Integer, ByRef triggerIndex As Long) As Long
Declare Function UsbDrDaqReady Lib "USBDrDAQ.dll" (ByVal handle As Integer, ByRef ready As Integer) As Long
Declare Function UsbDrDaqGetUnitInfo Lib "USBDrDAQ.dll" (ByVal handle As Integer, ByVal S As String, ByVal stringLength As Integer, ByRef requiredSize As Integer, ByVal info As Long) As Long
Declare Function UsbDrDaqSetDO Lib "USBDrDAQ.dll" (ByVal handle As Integer, ByVal IOChannel As Long, ByVal value As Integer) As Long
Sub GetData()
Dim handle As Integer
Dim status As Long
Dim channels(10) As Long
Dim ready As Integer
Dim overflow As Integer
Dim triggerIndex As Long
Dim nValues As Long
Dim values(1000) As Integer
Dim i As Integer
Dim Row As Integer
Dim requiredSize As Integer
Dim S As String * 255
Range("A1:Z65536").Clear
status = UsbDrDaqOpenUnit(handle)
If status <> 0 Then
MsgBox "Unit not opened", vbOKOnly, "Error Message"
Cells(11, "L").value = "DrDAQ not opened"
Exit Sub
End If
' Get the unit information
Cells(10, "L").value = "Unit opened"
SLegnth = UsbDrDaqGetUnitInfo(handle, S, 255, requiredSize, 3)
Cells(11, "L").value = S
SLegnth = UsbDrDaqGetUnitInfo(handle, S, 255, requiredSize, 4)
Cells(12, "L").value = "Serial number:"
Cells(12, "M").value = S
SLegnth = UsbDrDaqGetUnitInfo(handle, S, 255, requiredSize, 0)
Cells(13, "L").value = "Driver version:"
Cells(13, "M").value = S
'Set Digital output
status = UsbDrDaqSetDO(handle, 1, 1)
status = UsbDrDaqSetDO(handle, 1, 0)
'Collect a 1 second block containing 100 samples on all channels
channels(0) = 1
channels(1) = 2
channels(2) = 3
channels(3) = 4
channels(4) = 5
channels(5) = 6
channels(6) = 7
channels(7) = 8
channels(8) = 9
channels(9) = 10
status = UsbDrDaqSetInterval(handle, 1000000, 100, channels(0), 10)
If status <> 0 Then
MsgBox "Settings error", vbOKOnly, "Error Message"
Call UsbDrDaqCloseUnit(handle)
Exit Sub
End If
ready = 0
status = UsbDrDaqRun(handle, 100, 0)
If status <> 0 Then
MsgBox "Run error", vbOKOnly, "Error Message"
Call UsbDrDaqCloseUnit(handle)
Exit Sub
End If
Do While ready = 0
status = UsbDrDaqReady(handle, ready)
Loop
nValues = 100
Call UsbDrDaqGetValues(handle, values(0), nValues, overflow, triggerIndex)
Call UsbDrDaqCloseUnit(handle)
'Display values
Cells(1, "A").value = "Ext. 1"
Cells(1, "B").value = "Ext. 2"
Cells(1, "C").value = "Ext. 3"
Cells(1, "D").value = "Scope"
Cells(1, "E").value = "PH"
Cells(1, "F").value = "Resistance"
Cells(1, "G").value = "Light"
Cells(1, "H").value = "Thermistor"
Cells(1, "I").value = "Mic. wavform"
Cells(1, "J").value = "Mic. Level"
i = 0
For Row = 2 To nValues + 1
Cells(Row, "A").value = values(i)
Cells(Row, "B").value = values(i + 1)
Cells(Row, "C").value = values(i + 2)
Cells(Row, "D").value = values(i + 3)
Cells(Row, "E").value = values(i + 4)
Cells(Row, "F").value = values(i + 5)
Cells(Row, "G").value = values(i + 6)
Cells(Row, "H").value = values(i + 7)
Cells(Row, "I").value = values(i + 8)
Cells(Row, "J").value = values(i + 9)
i = i + 10
Next Row
End Sub
Code: Select all
Declare Function UsbDrDaqOpenUnit Lib "USBDrDAQ.dll" (ByRef handle As Integer) As Long
Declare Function UsbDrDaqCloseUnit Lib "USBDrDAQ.dll" (ByVal handle As Integer) As Long
Declare Function UsbDrDaqGetUnitInfo Lib "USBDrDAQ.dll" (ByVal handle As Integer, ByVal S As String, ByVal stringLength As Integer, ByRef requiredSize As Integer, ByVal info As Long) As Long
Dim handle As Integer
Dim status As Long
Dim S As String * 255
status = UsbDrDaqOpenUnit(handle)
If status <> 0 Then
MsgBox "Unit not opened", vbOKOnly, "Error Message"
Cells(11, "L").value = "DrDAQ not opened"
Exit Sub
End If
' Get the unit information
Cells(10, "L").value = "Unit opened"
SLegnth = UsbDrDaqGetUnitInfo(handle, S, 255, requiredSize, 3)
Cells(11, "L").value = S
SLegnth = UsbDrDaqGetUnitInfo(handle, S, 255, requiredSize, 4)
Cells(12, "L").value = "Serial number:"
Cells(12, "M").value = S
SLegnth = UsbDrDaqGetUnitInfo(handle, S, 255, requiredSize, 0)
Cells(13, "L").value = "Driver version:"
Cells(13, "M").value = S
Code: Select all
Cells(11, "L").value = S
Code: Select all
TextField1.Text = S