Option Explicit 'force explicit variable declaration
Public Const sheet1 As String = "Visu"
Public Const sheet2 As String = "Data"
Public Const config As String = "Configuration"
Declare Function OPENCOM Lib "port.dll" (ByVal a$) As Integer
Declare Function INITCOMPULAB Lib "port.dll" (ByVal COM%) As Integer
Declare Function FINDHARD Lib "port.dll" (ByVal Meldung%) As Integer
Declare Sub CLOSECOM Lib "port.dll" ()
Declare Sub SENDBYTE Lib "port.dll" (ByVal b%)
Declare Function READBYTE Lib "port.dll" () As Integer
Declare Sub DOUT Lib "port.dll" (ByVal Wert%)
Declare Function DIN Lib "port.dll" () As Integer
Declare Function AIN Lib "port.dll" (ByVal Eingang%) As Integer
Declare Sub DELAY Lib "port.dll" (ByVal b%)
Declare Sub TIMEINIT Lib "port.dll" ()
Declare Function TIMEREAD Lib "port.dll" () As Long
Private Const sheet1 As String = "Visu"
Private Const sheet2 As String = "Data"
Private Const FrameHeader As String = "T" '10 'was "A" ' "TX"
Private Const FrameTail As String = "C"
Private Const FrameLength As Byte = 15 ' was 6
Dim s1 As Variant, s2 As Variant
Dim sortie As Integer
Dim dr As Integer
Dim s3 As Variant
Sub StartScope()
Dim ix As Byte, ComPort As String
Dim port As Byte, baudrate As Long, parity As String, databits As Byte, stopbit As Byte
Dim duration As Long, interval As Long
Set s3 = ThisWorkbook.Sheets(config)
'get data acquisition configuration:
With s3
ix = .Cells(3, 2).value 'get number of index selected
duration = .Cells(3 + ix, 1).value * 1000 'get index
ix = .Cells(3, 4).value
interval = .Cells(3 + ix, 3).value * 1000
'get RS232 configuration:
ix = .Cells(3, 6).value
port = .Cells(3 + ix, 5).value
ix = .Cells(3, 8).value
baudrate = .Cells(3 + ix, 7).value
ix = .Cells(3, 10).value
parity = .Cells(3 + ix, 9).value
ix = .Cells(3, 12).value
databits = .Cells(3 + ix, 11).value
ix = .Cells(3, 14).value
stopbit = .Cells(3 + ix, 13).value
End With
ComPort = "COM" & port & ":" & baudrate & "," & parity & "," & stopbit
' ComPort = "COM" & port & ":" & baudrate & "," & parity & "," & databits & "," & stopbit
Call Data_Fetch.GetData(ComPort, duration, interval)
End Sub
Sub GetData(ComPort, duration, interval)
Dim RecString As String, ErrorString As String
Dim HI As Long, LO As Byte, value As Double
Dim row As Integer, n As Integer, time As Long
Dim succ As Integer, I, dummy As Integer
Set s1 = ThisWorkbook.Sheets(sheet1)
Set s2 = ThisWorkbook.Sheets(sheet2)
s2.Activate 'activate data sheet
s2.Columns("A:B").Select 'select data
Selection.ClearContents 'erase data columns
Range("C1").Select
s1.Activate 'activate scope
Range("C5").Select
s1.FrameHeaderBox.Text = FrameHeader 'display framing information
s1.FrameTailBox.Text = FrameTail
succ = 1
sortie = 0
succ = OPENCOM(ComPort) 'open serial communication port (DTR=1, RTS=0)
If (succ = 0) Then
dummy = MsgBox("RS232 connection failed: " & ComPort, vbCritical, "PORT.DLL")
Else
RecString = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
row = 1 'row counter
time = interval 'reset time
ActiveSheet.DrawingObjects("BarBack").Width = 100
'configure X/Y-axis of chart:
With s1.ChartObjects(1).Chart.Axes(xlCategory)
.MinimumScale = 0 'x-axis
.MaximumScaleIsAuto = True
.MajorUnitIsAuto = True 'y-axis
.MinorUnitIsAuto = True
End With
'************** Outer Loop *************
TIMEINIT
n = 0
While TIMEREAD <= (duration + interval)
value = 0
dr = 0
RecString = ""
'************** Inner Loop *************
Do
' Do
K% = READBYTE
If K% > 0 Then
a$ = Chr(K%)
' Debug.Print a$, dr
If ((a$ = FrameHeader) Or (dr = 1)) Then
dr = 1
RecString = RecString + a$
If ((a$ = FrameTail) And (dr = 1)) Then
' If ((a$ = Chr(10)) And (dr = 1)) Then ' <- bug ?
I = Len(RecString)
'Debug.Print "len="; I
s1.TextBox1.Text = RecString
s1.HiByteBox.Text = Left$(RecString, 5)
s1.LoByteBox.Text = Right$(RecString, 4)
s1.Measure.Text = Mid$(RecString, 7, 6)
value = Val(s1.Measure.Text)
RecString = ""
dr = 0
a$ = ""
n = n + 1
DoEvents
End If
End If
End If
' Loop Until (dr = 0)
' n = n + 1
Loop Until ((TIMEREAD > time) Or (sortie = 1)) 'timeslice finished
'************** End Inner Loop *************
If sortie = 1 Then End 'break
' Application.Calculation = xlCalculationManual
s2.Cells(row, 2).value = value
s2.Cells(row, 1).value = (time - interval) / 1000
ActiveSheet.DrawingObjects("BarBack").Width = (time - interval) / duration * 100
' Application.Calculation = xlCalculationAutomatic
s1.TextBox2.Text = row
row = row + 1 'next row
time = time + interval 'next timeslice
'Debug.Print time
Wend
'************** End Outer Loop *************
CLOSECOM
'configure X-axis of chart to full range:
Application.Calculation = xlCalculationManual
With s1.ChartObjects(1).Chart.Axes(xlCategory)
.MinimumScale = 0 'x-axis
.MaximumScale = duration / 1000
.MajorUnitIsAuto = True 'y-axis
.MinorUnitIsAuto = True
End With
Application.Calculation = xlCalculationAutomatic
s1.TextBox1.Text = "Appuyer sur START"
End If
End Sub