PicoScope 7 Software
Available on Windows, Mac and Linux
Code: Select all
Declare Function pl1000OpenUnit Lib "pl1000.dll" (ByRef handle As Integer) As Integer
Declare Sub pl1000CloseUnit Lib "pl1000.dll" (ByVal handle As Integer)
Declare Function pl1000GetUnitInfo Lib "pl1000.dll" (ByVal handle As Integer, ByVal S As String, ByVal lth As Integer, ByVal line_no As Integer) As Integer
Declare Function pl1000GetValue Lib "pl1000.dll" (ByVal handle As Integer, ByVal channel As Integer, reading As Integer) As Integer
Declare Sub pl1000SetTrigger Lib "pl1000.dll" (ByVal handle As Integer, ByVal enabled As Integer, ByVal enable_auto As Integer, ByVal auto_ms As Integer, ByVal channel As Integer, ByVal falling As Integer, ByVal threshold As Integer, ByVal delay As Integer)
Declare Function pl1000SetInterval Lib "pl1000.dll" (ByVal handle As Integer, ByVal us_for_block As Long, ByVal ideal_no_of_samples As Long, channels As Integer, ByVal No_of_channels As Integer) As Long
Declare Function pl1000GetValues Lib "pl1000.dll" (ByVal handle As Integer, values As Integer, ByVal no_of_values As Long) As Long
Declare Function pl1000GetTimesAndValues Lib "pl1000.dll" (ByVal handle As Integer, ByRef times As Long, ByRef values As Integer, no_of_values As Long) As Long
Declare Function pl1000Run Lib "pl1000.dll" (ByVal handle As Integer, ByVal no_of_values As Long, ByVal method As Integer) As Integer
Declare Function pl1000Ready Lib "pl1000.dll" (ByVal handle As Integer) As Integer
Declare Function pl1000Stop Lib "pl1000.dll" (ByVal handle As Integer) As Integer
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim handle As Integer
Dim times(100) As Long
Dim values(200) As Integer
Dim channels(22) As Integer
Dim nValues As Integer
Dim ok As Integer
Dim Ready As Integer
Dim S As String * 255
Public port As Integer
Public product As Integer
Dim sleepInterval As Integer
Function adc_to_mv(value As Integer) As Integer
adc_to_mv = value / 4096 * 2500
End Function
Public Sub startReadings()
Dim stAddr As String
Dim noReadings As Integer
Dim interval As Integer
Dim i As Integer
Dim j As Integer
Dim timer
Dim start
Dim val As Integer
Dim ch1 As Integer
Dim ch2 As Integer
Dim ch3 As Integer
Dim ch4 As Integer
Dim handle As Integer
Dim ch7 As Integer 'Insertion needed for expansion
Dim ch8 As Integer 'to allow six fans to be used
Dim ch9 As Integer 'simultaneously
Dim StartTime As Date
Dim EndTime As Date
StartTime = Now
Range("S3").value = Format(StartTime, "HH:MM")
EndTime = StartTime + TimeSerial(0, 5, 0)
Range("S4").value = Format(EndTime, "HH:MM")
handle = pl1000OpenUnit() 'New USB only OpenUnit call
opened = handle <> 0
If (Not opened) Then
Call MsgBox("Unable to open USBADC11 on main input", vbCritical + vbOKOnly, "Startup Error")
Else
If MsgBox("Hit [enter] to continue, or [esc] to cancel", vbOKCancel, "Start data gather") = vbCancel Then
Exit Sub
End If
stAddr = getParam("No Runs definition cell")
noReadings = Worksheets(getSheet(stAddr)).Range(getAddress(stAddr)).value
stAddr = getParam("Run intervall cell")
interval = Worksheets(getSheet(stAddr)).Range(getAddress(stAddr)).value
start = Now
Worksheets(getParam("Output Sheet")).Range(getParam("Results range")).Clear
Worksheets("TempDpLog").Range("H3:J54").Clear
For j = 0 To noReadings - 1
'wait 1 second
Application.Wait (Now() + TimeValue("00:00:02"))
' Get a reading...
' we can call this routine repeatedly
' to get more blocks with the same settings
On Error GoTo failedLibrary
'Call UsbAdc11GetTimesAndValues(handle, times(0), values(0), 2)
'On Error GoTo 0
i = pl1000GetValue(handle, 1, ch1)
i = pl1000GetValue(handle, 2, ch2)
i = pl1000GetValue(handle, 3, ch3)
i = pl1000GetValue(handle, 4, ch4)
i = pl1000GetValue(handle, 7, ch7)
i = pl1000GetValue(handle, 8, ch8)
i = pl1000GetValue(handle, 9, ch9)
' Copy the data into the spreadsheets - first 'logger results'
timer = j 'Now() - start
i = 0
Worksheets(getParam("Output Sheet")).Range(getParam("Output Start Cell")).Offset(j, 0).value = j 'times(i)
Worksheets(getParam("Output Sheet")).Range(getParam("Output Start Cell")).Offset(j, 1).value = (adc_to_mv(ch1)) / 1000
Worksheets(getParam("Output Sheet")).Range(getParam("Output Start Cell")).Offset(j, 2).value = (adc_to_mv(ch2)) / 1000
Worksheets(getParam("Output Sheet")).Range(getParam("Output Start Cell")).Offset(j, 3).value = (adc_to_mv(ch3)) / 1000
Worksheets(getParam("Output Sheet")).Range(getParam("Output Start Cell")).Offset(j, 4).value = (adc_to_mv(ch4)) / 1000
Worksheets(getParam("Output Sheet")).Range(getParam("Output Start Cell")).Offset(j, 5).value = (adc_to_mv(ch7)) / 1000
Worksheets(getParam("Output Sheet")).Range(getParam("Output Start Cell")).Offset(j, 6).value = (adc_to_mv(ch8)) / 1000
Worksheets(getParam("Output Sheet")).Range(getParam("Output Start Cell")).Offset(j, 7).value = (adc_to_mv(ch9)) / 1000
' Then copy the data into TempDpLog
Worksheets("TempDpLog").Range("H3").Offset(j, 0).value = j
Worksheets("TempDpLog").Range("H3").Offset(j, 1).value = (adc_to_mv(ch1)) / 1000
Worksheets("TempDpLog").Range("H3").Offset(j, 2).value = (adc_to_mv(ch2)) / 1000
Worksheets("TempDpLog").Range("H3").Offset(j, 3).value = (adc_to_mv(ch3)) / 1000
Worksheets("TempDpLog").Range("H3").Offset(j, 4).value = (adc_to_mv(ch4)) / 1000
Worksheets("TempDpLog").Range("H3").Offset(j, 5).value = (adc_to_mv(ch7)) / 1000
Worksheets("TempDpLog").Range("H3").Offset(j, 6).value = (adc_to_mv(ch8)) / 1000
Worksheets("TempDpLog").Range("H3").Offset(j, 7).value = (adc_to_mv(ch9)) / 1000
Next
End If
pl1000CloseUnit (handle) 'New USB only CloseUnit call
Call getCoefficients
Exit Sub
failedLibrary:
Call MsgBox(Err.Description, vbCritical + vbOKOnly, "Critical Error:" + Str(Err.Number))
End Sub