valky

Dim nRun As Boolean
Dim nOffset As Integer
Dim aBuff(32) As Byte
Dim strBuf As String
Dim nAcquired As Double
Dim bAcquired As Boolean
    
    ' excel app
    Dim RangeX1, RangeY1, RangeX2, RangeY2 As Integer
    Dim IterateX, IterateY As Integer
    Dim bAutocall As Boolean
    

Private Sub CommandButton1_Click()
    SPort.Open (Port.Value)
    SPort.InitString ("2400,N,7,1")
    SPort.DTR = True
    SPort.RTS = False
    
    nRun = True
    bAutocall = False
    nOffset = 0
End Sub

Private Sub CommandButton3_Click()
    Dim sel As Variant
    Dim width, height As Integer
    If Selection.Count > 1 Then
        sel = Selection.Cells
    
        width = UBound(sel, 2)
        height = UBound(sel, 1)
    
        RangeX1 = Selection.Column
        RangeY1 = Selection.Row
        RangeX2 = RangeX1 + width
        RangeY2 = RangeY1 + height
        IterateX = RangeX1
        IterateY = RangeY1
        
        bAutocall = True
        Handler
    Else
        If Acquired Then
            ActiveCell.Value = Acquire()
            ActiveCell.Offset(1, 0).Select
        End If
    End If
End Sub

Private Sub Handler()
    If Not Acquired() Then Exit Sub
    
    'ActiveCell.Offset(IterateY - RangeY1, IterateX - RangeX1).Select
    ActiveCell.Value = Acquire()
    ActiveCell.Offset(1, 0).Select
    'ActiveCell.Offset(-IterateY + RangeY1, -IterateX + RangeX1).Select
    IterateY = IterateY + 1
    If IterateY >= RangeY2 Then
        ActiveCell.Offset(-(RangeY2 - RangeY1), 1).Select
        IterateY = RangeY1
        IterateX = IterateX + 1
        If IterateX >= RangeX2 Then
          ActiveCell.Offset(0, -(RangeX2 - RangeX1)).Select
          IterateX = RangeX1
        End If
    End If
End Sub

Private Sub SPort_OnRxChar(ByVal Count As Long)
    Dim Buff() As Byte
    ReDim Buff(1 To Count)
    Dim i As Integer
    Dim Received As Long
    Dim ch As Byte
    
    Received = SPort.Read(Buff(1), Count)
    For i = 1 To Count
      ch = Buff(i) And 127
      If ch > 30 Then strBuf = strBuf & Chr(ch) Else strBuf = strBuf & "?"
      If ch = 13 Or ch = 10 Then
        If (nOffset > 0) Then ParseData
        nOffset = -1
      Else
        If (nOffset >= 0) Then aBuff(nOffset) = ch
      End If
      If nOffset < 32 Then nOffset = nOffset + 1
    Next i
    strBuf = Right(strBuf, 32)
    TextBox2.Text = strBuf
End Sub

Private Sub CommandButton2_Click()
    nRun = False
    SPort.Close
End Sub

Private Sub ParseData()
  Dim str As String
  For i = 0 To nOffset - 1
    str = str & Chr(aBuff(i))
  Next
  TextBox1.Text = str & " (" & nOffset & ")"
  
  If nOffset <> 9 Then Exit Sub
  
  '
  Dim sJedn As String
  Dim sProp As String
  Dim sUnits As String
  Dim bAuto As Boolean
  Dim bNegative As Boolean
  Dim nNumber As Integer
  Dim nDiv As Integer
  Dim sForm As String
  Dim bOverflow As Boolean
  Dim sRange As String
  Dim nStatus As Integer
  Dim bBeep As Boolean
  Dim fMul As Double
  
  
  bBeep = False
  bAuto = False
  nDiv = 1
  fMul = 1
  nStatus = aBuff(6) - &H30
  bNegative = nStatus And 4
  bOverflow = nStatus And 1

  
  Select Case Chr(aBuff(5))
    Case ";":
      sJedn = "U"
      Select Case Chr(aBuff(8))
        Case ":":
          bAuto = True
          sProp = "DC"
        Case "8":
          bAuto = False
          sProp = "DC"
        Case "6":
          bAuto = True
          sProp = "AC"
        Case "4":
          bAuto = False
          sProp = "AC"
      End Select
            
      Select Case Chr(aBuff(0))
        Case "0":
          nDiv = 10
          sUnits = "mV"
          sForm = "###.#"
          sRange = "400"
          fMul = 0.001
        Case "1":
          nDiv = 1000
          sUnits = "V"
          sForm = "#.###"
          sRange = "4"
          fMul = 1
        Case "2":
          nDiv = 100
          sUnits = "V"
          sForm = "##.##"
          sRange = "40"
          fMul = 1
        Case "3":
          nDiv = 10
          sUnits = "V"
          sForm = "###.#"
          sRange = "400"
          fMul = 1
        Case "4":
          nDiv = 1
          sUnits = "V"
          sForm = "####"
          If sProp = "DC" Then
            sRange = "1000"
          Else
            sRange = "750"
          End If
          fMul = 1
      End Select
    
    Case "3":
      sJedn = "R"
      sProp = ""
            
      Select Case Chr(aBuff(0))
        Case "0":
          nDiv = 10
          sUnits = "O"
          sForm = "###.#"
          sRange = "400"
          fMul = 1
        Case "1":
          nDiv = 1000
          sUnits = "kO"
          sForm = "#.###"
          sRange = "4"
          fMul = 1000
        Case "2":
          nDiv = 100
          sUnits = "kO"
          sForm = "##.##"
          sRange = "40"
          fMul = 1000
        Case "3":
          nDiv = 10
          sUnits = "kO"
          sForm = "###.#"
          sRange = "400"
          fMul = 1000
        Case "4":
          nDiv = 1000
          sUnits = "MO"
          sForm = "#.###"
          sRange = 4
          fMul = 1000000
        Case "5":
          nDiv = 100
          sUnits = "MO"
          sForm = "##.##"
          sRange = 40
          fMul = 1000000
      End Select
      nStatus = aBuff(8) - &H30
      bAuto = nStatus And 2

    Case "5":
      sJedn = "R"
      sProp = "beep"
      bAuto = False
            
      Select Case Chr(aBuff(0))
        Case "0":
          nDiv = 10
          sUnits = "O"
          sForm = "###.#" 'µ__°µ°"
          sRange = "400"
          fMul = 1
      End Select
      nStatus = aBuff(6) - &H30
      bBeep = (nStatus And 1)
      bBeep = Not bBeep
      'bBeep = False
  End Select
  
  nNumber = 0
  nNumber = nNumber + (aBuff(1) - &H30) * 1000
  nNumber = nNumber + (aBuff(2) - &H30) * 100
  nNumber = nNumber + (aBuff(3) - &H30) * 10
  nNumber = nNumber + (aBuff(4) - &H30) * 1
  
  If sJedn = "" Then
    Display.Text = nNumber
    DispProp.Text = "?"
    DispOpt.Text = ""
    DispRange.Text = ""
    Exit Sub
  End If
  
  If bNegative Then nNumber = -nNumber
  If bBeep And nNumber / nDiv > 40 Then
    bBeep = False
  End If
  
  If bOverflow Then
    If sJedn = "R" Then
      Display.Text = "Inf"
      bAcquired = False
    Else
      Display.Text = "!!!"
      bAcquired = False
    End If
  Else
    Display.Text = (nNumber / nDiv) & " " & sUnits
    bAcquired = True
    nAcquired = (nNumber / nDiv) * fMul
  End If
  
  DispProp.Text = sProp
  If bAuto Then
    DispOpt.Text = "Auto"
  ElseIf bBeep Then
    DispOpt.Text = "Beep"
  Else
    DispOpt.Text = ""
  End If
  
  If sProp <> "" Then
    DispRange.Text = "max : " & sRange & " " & sUnits & " (" & sProp & ")"
  Else
    DispRange.Text = "max : " & sRange & " " & sUnits
  End If
  If bAcquired And bAutocall Then Handler
  
End Sub

Function Acquired() As Boolean
  Acquired = bAcquired
End Function

Function Acquire() As Double
  Acquire = nAcquired
  bAcquired = False
End Function