Attribute VB_Name = "Modul1"

' ============================================================
' RSAPI.FREIE — RSAPI.DLL-Unabhängige COM-Port Schnittstelle
' ============================================================
' Verwendet Windows API (kernel32.dll) statt RSAPI.DLL
' Funktioniert mit allen modernen Excel-Versionen (32 & 64-bit)

#If VBA7 Then
    Private Declare PtrSafe Function CreateFile Lib "kernel32.dll" _
        (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _
        ByVal dwShareMode As Long, lpSecurityAttributes As Any, _
        ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _
        ByVal hTemplateFile As Long) As Long
    
    Private Declare PtrSafe Function WriteFile Lib "kernel32.dll" _
        (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, _
        lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
    
    Private Declare PtrSafe Function ReadFile Lib "kernel32.dll" _
        (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, _
        lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
    
    Private Declare PtrSafe Function CloseHandle Lib "kernel32.dll" _
        (ByVal hObject As Long) As Long
    
    Private Declare PtrSafe Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
    
    Private Declare PtrSafe Function SetCommTimeouts Lib "kernel32.dll" _
        (ByVal hFile As Long, lpCommTimeouts As Any) As Long
    
    Private Declare PtrSafe Function GetCommTimeouts Lib "kernel32.dll" _
        (ByVal hFile As Long, lpCommTimeouts As Any) As Long
    
    Private Declare PtrSafe Function SetupComm Lib "kernel32.dll" _
        (ByVal hFile As Long, ByVal dwInQueue As Long, ByVal dwOutQueue As Long) As Long

    ' DCB Struktur für Baudrate etc.
    Private Type DCB
        DCBlength As Long
        BaudRate As Long
        fBinary As Long
        fParity As Long
        fOutxCtsFlow As Long
        fOutxDsrFlow As Long
        fDtrControl As Long
        fDsrSensitivity As Long
        fTXContinueOnXoff As Long
        fOutX As Long
        fInX As Long
        fErrorChar As Long
        fNull As Long
        fRtsControl As Long
        fAbortOnError As Long
        fDummy2 As Long
        wReserved As Integer
        XonLim As Integer
        XoffLim As Integer
        ByteSize As Byte
        Parity As Byte
        StopBits As Byte
        XonChar As Byte
        XoffChar As Byte
        ErrorChar As Byte
        EofChar As Byte
        EvtChar As Byte
    End Type
    
    Private Declare PtrSafe Function BuildCommDCB Lib "kernel32.dll" Alias _
        "BuildCommDCBA" (ByVal lpDef As String, lpDCB As DCB) As Long
    
    Private Declare PtrSafe Function SetCommState Lib "kernel32.dll" _
        (ByVal hFile As Long, lpDCB As DCB) As Long
    
    Private Type OVERLAPPED
        Internal As Long
        InternalHigh As Long
        Offset As Long
        OffsetHigh As Long
        hEvent As Long
    End Type
    
    Private Type COMMTIMEOUTS
        ReadIntervalTimeout As Long
        ReadTotalTimeoutMultiplier As Long
        ReadTotalTimeoutConstant As Long
        WriteTotalTimeoutMultiplier As Long
        WriteTotalTimeoutConstant As Long
    End Type

#Else
    ' 32-bit Kompilierung (Legacy Excel)
    Private Declare Function CreateFile Lib "kernel32" _
        (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _
        ByVal dwShareMode As Long, lpSecurityAttributes As Any, _
        ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _
        ByVal hTemplateFile As Long) As Long
    
    Private Declare Function WriteFile Lib "kernel32" _
        (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, _
        lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
    
    Private Declare Function ReadFile Lib "kernel32" _
        (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, _
        lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
    
    Private Declare Function CloseHandle Lib "kernel32" _
        (ByVal hObject As Long) As Long
    
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    
    Private Declare Function SetCommTimeouts Lib "kernel32" _
        (ByVal hFile As Long, lpCommTimeouts As Any) As Long
    
    Private Declare Function GetCommTimeouts Lib "kernel32" _
        (ByVal hFile As Long, lpCommTimeouts As Any) As Long
    
    Private Declare Function SetupComm Lib "kernel32" _
        (ByVal hFile As Long, ByVal dwInQueue As Long, ByVal dwOutQueue As Long) As Long

    Private Type DCB
        DCBlength As Long
        BaudRate As Long
        fBinary As Long
        fParity As Long
        fOutxCtsFlow As Long
        fOutxDsrFlow As Long
        fDtrControl As Long
        fDsrSensitivity As Long
        fTXContinueOnXoff As Long
        fOutX As Long
        fInX As Long
        fErrorChar As Long
        fNull As Long
        fRtsControl As Long
        fAbortOnError As Long
        fDummy2 As Long
        wReserved As Integer
        XonLim As Integer
        XoffLim As Integer
        ByteSize As Byte
        Parity As Byte
        StopBits As Byte
        XonChar As Byte
        XoffChar As Byte
        ErrorChar As Byte
        EofChar As Byte
        EvtChar As Byte
    End Type
    
    Private Declare Function BuildCommDCB Lib "kernel32" Alias _
        "BuildCommDCBA" (ByVal lpDef As String, lpDCB As DCB) As Long
    
    Private Declare Function SetCommState Lib "kernel32" _
        (ByVal hFile As Long, lpDCB As DCB) As Long
    
    Private Type OVERLAPPED
        Internal As Long
        InternalHigh As Long
        Offset As Long
        OffsetHigh As Long
        hEvent As Long
    End Type
    
    Private Type COMMTIMEOUTS
        ReadIntervalTimeout As Long
        ReadTotalTimeoutMultiplier As Long
        ReadTotalTimeoutConstant As Long
        WriteTotalTimeoutMultiplier As Long
        WriteTotalTimeoutConstant As Long
    End Type
#End If

' API Konstanten
Private Const GENERIC_READ As Long = &H80000000
Private Const GENERIC_WRITE As Long = &H40000000
Private Const OPEN_EXISTING As Long = 3
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const COMM_CONFIG_SIZE As Long = 128

' RSAPI-kompatible öffentliche Schnittstelle
' Diese Sub/Function-Namen decken die original RSAPI-DLL API ab.

Public hComPort As Long
Dim m_ComBuffer As String
Dim m_ReadTimeoutSet As Boolean

' --- RSAPI-Kompatible Wrapper ---

' OPENCOM "COM1:9600,N,8,1" oder einfach "COM1:57600,N,8,1"
Sub OPENCOM(ByVal ComParameter As String)
    Dim comPort As String
    Dim baudRate As Long
    Dim parity As String
    Dim dataBits As Integer
    Dim stopBits As String
    
    ' Parsing: z.B. "COM1:9600,N,8,1" oder "COM3:57600,N,8,1"
    If InStr(ComParameter, ":") > 0 Then
        comPort = Left$(ComParameter, InStr(ComParameter, ":") - 1)
        Dim settings As String
        settings = Mid$(ComParameter, InStr(ComParameter, ":") + 1)
        
        ' Parsing der Baudraten-Settings
        Dim parts() As String
        parts = Split(settings, ",")
        If UBound(parts) >= 3 Then
            baudRate = CLng(Trim$(parts(0)))
            parity = Trim$(parts(1))
            dataBits = CInt(Trim$(parts(2)))
            stopBits = Trim$(parts(3))
        Else
            ' Nur Baudrate angegeben: "COM1:57600"
            baudRate = CLng(Trim$(settings))
            parity = "N"
            dataBits = 8
            stopBits = "1"
        End If
    Else
        ' Nur Port-Name ohne Baudrate — Default verwenden
        comPort = ComParameter
        baudRate = 9600
        parity = "N"
        dataBits = 8
        stopBits = "1"
    End If
    
    ' COM-Port Pfad konstruieren (\\.\COMx für moderne Windows)
    Dim portName As String
    portName = "\\.\\" & comPort
    
    ' DCB Struktur aufbauen
    Dim dcb As DCB
    Dim dcbDef As String
    dcbDef = comPort & ":" & CStr(baudRate) & "," & parity & "," & CStr(dataBits) & "," & stopBits
    
    If BuildCommDCB(dcbDef, dcb) = 0 Then
        Err.Raise vbObjectError + 1, , "BuildCommDCB failed for " & dcbDef
        Exit Sub
    End If
    
    ' Port öffnen
    hComPort = CreateFile(portName, GENERIC_READ Or GENERIC_WRITE, _
        0, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
    
    If hComPort < 0 Then
        Err.Raise vbObjectError + 2, , "CreateFile failed for " & portName & ". Port existiert nicht oder ist in Benutzung."
        Exit Sub
    End If
    
    ' COM-Port konfigurieren
    If SetCommState(hComPort, dcb) = 0 Then
        CloseHandle hComPort
        hComPort = -1
        Err.Raise vbObjectError + 3, , "SetCommState failed"
        Exit Sub
    End If
    
    ' Buffers setzen
    SetupComm hComPort, COMM_CONFIG_SIZE, COMM_CONFIG_SIZE
    
    ' Timeouts konfigurieren (non-blocking read)
    Dim timeouts As COMMTIMEOUTS
    Dim result As Long
    result = GetCommTimeouts(hComPort, timeouts)
    
    ' Non-blocking Modus: sofort zurück wenn kein Data da
    timeouts.ReadIntervalTimeout = &HFFFF&      ' MAXULONG
    timeouts.ReadTotalTimeoutMultiplier = 0
    timeouts.ReadTotalTimeoutConstant = 0
    timeouts.WriteTotalTimeoutMultiplier = 500   ' 0.5s write timeout
    timeouts.WriteTotalTimeoutConstant = 1000    ' 1s absolute write timeout
    
    SetCommTimeouts hComPort, timeouts
    
    m_ReadTimeoutSet = True
    m_ComBuffer = ""
End Sub

' CLOSECOM — COM-Port schließen
Sub CLOSECOM()
    If hComPort > 0 Then
        CloseHandle hComPort
        hComPort = -1
        m_ComBuffer = ""
    End If
End Sub

' TIMEINIT — Initialisiert Timeout-Mechanismus (hier implizit durch Timeouts)
Sub TIMEINIT()
    ' In RSAPI.DLL aktiv; hier ist der Non-Blocking Modus bereits in OPENCOM gesetzt
    m_ReadTimeoutSet = True
End Sub

' TIMEOUT ms% — Setzt Timeout für READSTRING
Function TIMEOUT(ByVal ms As Long) As Long
    Dim timeouts As COMMTIMEOUTS
    Dim result As Long
    
    If hComPort > 0 Then
        result = GetCommTimeouts(hComPort, timeouts)
        
        ' Total timeout setzen (ms/1000 als Sekunden)
        timeouts.ReadIntervalTimeout = 0
        timeouts.ReadTotalTimeoutMultiplier = 0
        timeouts.ReadTotalTimeoutConstant = ms
        timeouts.WriteTotalTimeoutMultiplier = 500
        timeouts.WriteTotalTimeoutConstant = 1000
        
        SetCommTimeouts hComPort, timeouts
    End If
    
    TIMEOUT = 1 ' Erfolg
End Function

' TIMEREAD — Gibt verbleibende Zeit zurück (vereinfacht)
Function TIMEREAD() As Long
    TIMEREAD = 0 ' In moderner Implementierung nicht benötigt
End Function

' SENDBYTE B% — Sendet ein einzelnes Byte
Sub SENDBYTE(ByVal B As Integer)
    Dim buf(0 To 3) As Byte
    buf(0) = CByte(B And &HFF)
    
    Dim bytesWritten As Long
    WriteFile hComPort, buf(0), 1, bytesWritten, ByVal 0&
End Sub

' SENDSTRING S — Sendet einen String (ASCII)
Sub SENDSTRING(ByVal S As String)
    Dim i As Integer
    For i = 1 To Len(S)
        SENDBYTE Asc(Mid$(S, i, 1))
    Next i
End Sub

' READSTRING Display$ — Liest eine Zeile bis CR (0x0D) oder LF (0x0A) zurück
' Gibt die Anzahl gelesener Zeichen zurück
Function READSTRING(ByVal Display As String) As Integer
    Dim result As Integer
    result = RSAPI_READLINE(Display)
    READSTRING = result
    
    ' Aufräumen: Buffer wenn komplett gelesen
    If result <= 0 Then m_ComBuffer = ""
End Function

' READBYTE — Liest ein einzelnes Byte zurück (als Integer -1 bei Timeout)
Function READBYTE() As Integer
    Dim buf(0 To 255) As Byte
    Dim bytesRead As Long
    
    Dim result As Long
    result = ReadFile(hComPort, buf(0), 1, bytesRead, ByVal 0&)
    
    If result <> 0 And bytesRead > 0 Then
        READBYTE = buf(0) ' Wert als Integer zurück
    Else
        READBYTE = -1     ' Error/Timeout
    End If
End Function

' STRLENGTH B% — Setzt Puffer-Größe (in der RSAPI für Display-Puffer; hier implizit)
Sub STRLENGTH(ByVal B As Integer)
    ' In dieser Implementierung nicht nötig, da dynamisch
End Sub

' DELAY ms% — Wartet ms Millisekunden (ersetzt Sleep)
Sub DELAY(ByVal ms As Integer)
    Sleep ms
End Function

' ============================================================
' Interner Lese-Mechanismus — liest zeilenweise vom COM-Port
' ============================================================
Private Function RSAPI_READLINE(ByRef OutputString As String) As Integer
    Dim buf(0 To 255) As Byte
    Dim bytesRead As Long
    Dim readResult As Long
    Dim ch As Byte
    Dim lineBuffer As String
    
    lineBuffer = ""
    
    Do
        readResult = ReadFile(hComPort, buf(0), 1, bytesRead, ByVal 0&)
        
        If readResult = 0 Or bytesRead = 0 Then
            ' Timeout oder Fehler — gib was da ist zurück (oder leer)
            RSAPI_READLINE = Len(lineBuffer)
            If Len(lineBuffer) > 0 Then OutputString = lineBuffer Else OutputString = ""
            Exit Function
        End If
        
        ch = buf(0)
        
        ' Zeilenende: CR oder LF erkennen
        If ch = &H0D Or ch = &HA Then
            RSAPI_READLINE = Len(lineBuffer)
            OutputString = lineBuffer
            Exit Function
        End If
        
        ' Buffer overflow Schutz
        If Len(lineBuffer) > 254 Then
            RSAPI_READLINE = Len(lineBuffer)
            OutputString = lineBuffer
            Exit Function
        End If
        
        lineBuffer = lineBuffer & Chr$(ch)
        
    Loop
End Function

' ============================================================
' Originaler Code (mit minimalen Anpassungen)
' ============================================================

Public Label_Start, Label_Stop, Label_Trig, Label_FmaxChange, Label_FPeak
Public Title, Title_Distance, Title_F, Title_Speed, Title_Fmax, Title_Date, Title_Time
Public Rec_F, Rec_Fmax, Rec_Ftrig, Rec_Distance, Rel_Distance, Dir_Bit, Sensor_Factor, Rec_Speed, Rec_Fpeak, Baudrate
Public Temp_Speed, Years%, Months%, Days%, Hours%, Minutes%, Seconds%, Rec_Type, ADC_Offset, Stype_Def, Metric%, Time_Format%, Language%
Public Distance_Factor, Graph_F_$, Graph_Distance_$, Graph_V_$, Graph_Fmax_$, Graph_Date_$, Graph_Time_$, Speed_Factor
Public Blatt$, Password
Public PortNumber

Dim Sensor_Type(32)
Dim Ftrigger_$(0 To 11)
Dim Fpeak_$(0 To 11)
Dim Fchange_$(0 To 11)
Dim sheetcounter As Integer

' Private Function Fileishere(fname) As Boolean
' Returns TRUE if the file exists
Private Function Fileishere(fname As String) As Boolean
    Dim x As String
    x = Dir(fname)
    If x <> "" Then Fileishere = True Else Fileishere = False
End Function

Sub Set_Date()
    Set_Com_Port
    Open_Com
    
    DateStr$ = Mid$(Date$, 4, 2) + Mid$(Date$, 1, 2) + Mid$(Date$, 9, 2)
    TimeStr$ = Mid$(Time$, 1, 2) + Mid$(Time$, 4, 2) + Mid$(Time$, 7, 2)
    Time_Str$ = DateStr$ + TimeStr$
    
    SENDSTRING ("D")
    For i = 1 To 10
        c_Char = (Mid$(Time_Str$, i, 1))
        SENDSTRING (c_Char)
    Next i
    SENDSTRING (Chr(13))
    
    CLOSECOM
End Sub

Sub Clear_Memory()
    Dim Msg, Style, Title, Response, MyString
    Msg = "Clear MP 30?"
    Style = vbYesNo + vbCritical + vbDefaultButton2
    Title = "Clear MP 30"
    
    Response = MsgBox(Msg, Style, Title)
    If Response = vbYes Then
        Set_Com_Port
        Backlight_On
        DELAY (500)
        Backlight_Off
        Open_Com
        SENDSTRING ("$&" + Chr(13))
        CLOSECOM
    End If
End Sub

Sub Dump()
    Set_Com_Port
    conf$ = "COM " + Chr$(Asc(PortNumber))
    
    Ftrigger_$(0) = "Fmax Stop"
    Ftrigger_$(1) = "Fmax Stop"
    Ftrigger_$(2) = "Fmax Stop"
    Ftrigger_$(3) = "Fmax Stop"
    Ftrigger_$(4) = "Fmax Stop"
    Ftrigger_$(5) = "Fmax Stop"
    Ftrigger_$(6) = "Fmax Stop"
    Ftrigger_$(7) = "Fmax Stop"
    Ftrigger_$(8) = "Fmax Stop"
    Ftrigger_$(9) = "Fmax Stop"
    Ftrigger_$(10) = "Fmax Stop"
    Ftrigger_$(11) = "Fmax Stop"
   
    Fpeak_$(0) = "Peak Value"
    Fpeak_$(1) = "Spitzenwert"
    Fpeak_$(2) = "Valeur de crête"
    Fpeak_$(3) = "Valor de cresta"
    Fpeak_$(4) = "Valor massimo"
    Fpeak_$(5) = "max. tazna F"
    Fpeak_$(6) = "Peak Value"
    Fpeak_$(7) = "Valore massima"
    Fpeak_$(8) = "Spets värde"
    Fpeak_$(9) = "Topp verdi"
    Fpeak_$(10) = "Peak Value"
    Fpeak_$(11) = "Peak Value"
    
    Fchange_$(0) = "Fmax Change"
    Fchange_$(1) = "Fmax änderung"
    Fchange_$(2) = "Changement Fmax"
    Fchange_$(3) = "Cambio Fmax"
    Fchange_$(4) = "Mudonça de Fmax"
    Fchange_$(5) = "zmena max. F"
    Fchange_$(6) = "Fmax Change"
    Fchange_$(7) = "Cambiamento di Fmax"
    Fchange_$(8) = "ända max last"
    Fchange_$(9) = "Forendering max last"
    Fchange_$(10) = "Fmax Change"
    Fchange_$(11) = "Fmax Change"
    
    TempFile = TempDir$ + "\mp30_xxx.txt"
    
    Blatt$ = "MP30 Start"
    
    ThisWorkbook.Sheets(Blatt$).Activate
    Password = "pw002"
    ActiveSheet.Unprotect Password
    
    Worksheets("MP30 Start").Range("a9:H11000").ClearContents
    
    Cells(20, 4) = "Port: " + conf$
    Cells(21, 4) = "Software Release Ver. 2.4"
    
    NumOfVal = 0
    ReDim Sensor_Type(32)
    Timeout_Interval = 10000
    
    Open_Com
    Number_Of_Records = 9600
    STRLENGTH 15
    Display$ = "000000000000000"
    EOF_Str$ = "012"
    EOF_Rec = 12
    Zeile = 3
    col_offset = 12
    Col_Dist_Abs = col_offset
    Col_Dist_Rel = col_offset + 1
    Col_F = col_offset + 2
    Col_Speed = col_offset + 3
    Col_Fmax = col_offset + 4
    Col_Date = col_offset + 5
    Col_Time = col_offset + 6
    Col_Ftrig = col_offset + 7
    Col_Fpeak = col_offset + 8
    Col_Start = col_offset + 9
    Col_End = col_offset + 10
    Title = 10
    
    Graph_Comment = 1
    Graph_F = 3
    Graph_distance = 2
    Graph_V = 4
    Graph_Dir = 8
    Graph_Fmax = 5
    Graph_Date = 6
    Graph_Time = 7
    Graph_Temp = 8
    
    Cells(Title, Graph_F) = "F [daN]"
    Cells(Title, Graph_distance) = "L [m]"
    Cells(Title, Graph_V) = "V [m/min]"
    Cells(Title, Graph_Fmax) = "Fmax [daN]"
    Cells(Title, Graph_Date) = "Date"
    Cells(Title, Graph_Time) = "Time"
  
    Sensor_Factor = 8394 / 1024
    Speed_Factor = 1
    Dist_metric_Factor = 0.04
    Distance_Factor = 1
    Store_Interval = 125
    ADC_Offset = 150
    Rec_Type = 0
    
    Data_Rec = 0
    Start_Rec = 1
    Fmax_Rec = 5
    Ftrig_Rec = 6
    End_Rec = 9
    Fmax_alt_Rec = 11
    Data_at_Zero = 13
    
    Total_Distance = 0
    Graph_Line = 3
    Rel_Distance = 0
    Abs_Distance = 0
    Years% = 0
    Months% = 0
    Days% = 0
    Hours% = 0
    Minutes% = 0
    Seconds% = 0
    
    sheetcounter = 0
    DeleteNewSheets
    
    Open TempFile For Output As #1
    TIMEINIT
    
    Xmit$ = "?" + Chr(13)
    SENDSTRING (Xmit$)
    
    TIMEOUT 500
    EOF_Flag = 0
    receive_ok = 1
    While (NumOfVal < Number_Of_Records) And (EOF_Flag = 0)
        READSTRING (Display$)
        If Left$(Display$, 6) = "Fehler" Or Display$ = "000000000000000" Then
            EOF_Flag = 1
            receive_ok = 0
        Else
            Print #1, Display$;
        End If
        NumOfVal = NumOfVal + 1
        TestStr$ = Left$(Display$, 3)
        If TestStr$ = EOF_Str$ Then EOF_Flag = 1
    Wend
    Close #1
    
    If receive_ok = 1 Then
        NumOfVal = 0
        Open TempFile For Input As #1
        
        While (NumOfVal < Number_Of_Records) And (Rec_Type <> EOF_Rec)
            Rec_Type = Read_Record
            If Rec_Type = Start_Rec Then
                Graph_Line = 11
                ActiveSheet.Protect Password
                NewSheet_add
                start_flag = 1
                
                loc_rec = Read_Record ' ADC Offset and Sensor type Definition
                If Metric% = 0 Then
                    Speed_Factor = 3.2808
                    Distance_Factor = 3.28084
                Else
                    Speed_Factor = 1
                    Distance_Factor = 1
                End If
                loc_rec = Read_Record ' read F
                loc_rec = Read_DateTime ' date & time
                loc_rec = Read_Record
                loc_rec = Read_Record ' read Fmax
                loc_rec = Read_Record ' read distance
                
                Abs_Distance = Rec_Distance * Dist_metric_Factor
                Rel_Distance = CInt(Rec_Distance / Store_Interval - 0.5) * Store_Interval
                
                Date_Str$ = Str$(Years%) + "-" + Str$(Months%) + "-" + Str$(Days%)
                Time_Str$ = Str$(Hours%) + ":" + Str$(Minutes) + ":" + Str$(Seconds%)
                
                Cells(Graph_Line, Graph_Comment) = "Start"
                Cells(Graph_Line, Graph_distance) = Abs_Distance * Distance_Factor
                Cells(Graph_Line, Graph_distance).HorizontalAlignment = xlHAlignRight
                Cells(Graph_Line, Graph_F) = Int(Rec_F)
                Cells(Graph_Line, Graph_V) = Int(Rec_Speed)
                Cells(Graph_Line, Graph_Fmax) = Int(Rec_Fmax)
                Cells(Graph_Line, Graph_Date) = Date_Str$
                Cells(Graph_Line, Graph_Time) = Time_Str$
                
                Graph_Line = Graph_Line + 1
            End If
            
            If Rec_Type = End_Rec Then
                loc_rec = Read_Record ' read F
                loc_rec = Read_DateTime ' date & time
                loc_rec = Read_Record
                loc_rec = Read_Record
                loc_rec = Read_Record ' read stop distance
                
                Abs_Distance = Rec_Distance * Dist_metric_Factor
                Rel_Distance = CInt(Rec_Distance / Store_Interval - 0.5) * Store_Interval
                If Dir_Bit = 0 Then Rel_Distance = Rel_Distance + Store_Interval
                
                Date_Str$ = Str$(Years%) + "-" + Str$(Months%) + "-" + Str$(Days%)
                Time_Str$ = Str$(Hours%) + ":" + Str$(Minutes) + ":" + Str$(Seconds%)
                
                Cells(Graph_Line, Graph_Comment) = "Stop"
                Cells(Graph_Line, Graph_distance) = Abs_Distance * Distance_Factor
                Cells(Graph_Line, Graph_distance).HorizontalAlignment = xlHAlignRight
                Cells(Graph_Line, Graph_F) = Int(Rec_F)
                Cells(Graph_Line, Graph_V) = Int(Rec_Speed)
                Cells(Graph_Line, Graph_Date) = Date_Str$
                Cells(Graph_Line, Graph_Time) = Time_Str$
                
                Graph_Line = Graph_Line + 1
                
                loc_rec = Read_Record ' read Fpeak
                loc_rec = Read_Record ' read distance
                
                Abs_Distance = Rec_Distance * Dist_metric_Factor
                Cells(Graph_Line, Graph_Comment) = Fpeak_$(Language)
                Cells(Graph_Line, Graph_distance) = Abs_Distance * Distance_Factor
                Cells(Graph_Line, Graph_distance).HorizontalAlignment = xlHAlignRight
                Cells(Graph_Line, Graph_F) = Int(Rec_Fpeak)
            End If
            
            If Rec_Type = Ftrig_Rec Then
                loc_rec = Read_Record ' read Distance
                Abs_Distance = Rec_Distance * Dist_metric_Factor
                Cells(Graph_Line, Graph_Comment) = Ftrigger_$(Language)
                Cells(Graph_Line, Graph_distance) = Abs_Distance * Distance_Factor
                Cells(Graph_Line, Graph_distance).HorizontalAlignment = xlHAlignRight
                Cells(Graph_Line, Graph_F) = Int(Rec_Ftrig)
                Graph_Line = Graph_Line + 1
            End If
            
            If Rec_Type = Fmax_alt_Rec Then
                loc_rec = Read_Record ' read Distance
                Abs_Distance = Rec_Distance * Dist_metric_Factor
                Cells(Graph_Line, Graph_Fmax) = Int(Rec_Fmax)
                Cells(Graph_Line, Graph_Comment) = Fchange_$(Language)
                Cells(Graph_Line, Graph_distance) = Abs_Distance * Distance_Factor
                Cells(Graph_Line, Graph_distance).HorizontalAlignment = xlHAlignRight
                Graph_Line = Graph_Line + 1
            End If
            
            If (Rec_Type = Data_Rec) Or (Rec_Type = Data_at_Zero) Then
                If start_flag = 1 Then
                    If Dir_Bit = 1 Then Rel_Distance = Rel_Distance + Store_Interval
                    start_flag = 0
                End If
                If Dir_Bit = 0 Then
                    Rel_Distance = Rel_Distance + Store_Interval
                Else
                    Rel_Distance = Rel_Distance - Store_Interval
                End If
                If Rec_Type = Data_at_Zero Then Rel_Distance = 0
                
                Abs_Distance = Rel_Distance * Dist_metric_Factor
                Cells(Graph_Line, Graph_F) = Int(Rec_F)
                Cells(Graph_Line, Graph_V) = Int(Rec_Speed)
                Temp_Dist = Abs_Distance * Distance_Factor
                Cells(Graph_Line, Graph_distance) = Temp_Dist
                Cells(Graph_Line, Graph_distance).HorizontalAlignment = xlHAlignRight
                Graph_Line = Graph_Line + 1
            End If
            
            If Rec_Type = Offset_Rec Then
                If Metric% = 0 Then
                    Cells(Title, Graph_F) = "F [lbs]"
                    Cells(Title, Graph_distance) = "L [ft]"
                    Cells(Title, Graph_V) = "V [ft/min]"
                    Cells(Title, Graph_Fmax) = "Fmax [lbs]"
                    Cells(Title, Graph_Date) = "Date"
                    Cells(Title, Graph_Time) = "Time"
                End If
            End If
            
            NumOfVal = NumOfVal + 1
        Wend
        
        Close #1
    End If
    
    ActiveSheet.Protect Password
    Kill TempFile
    CLOSECOM
    Write_Unlocked_Cells
    
    Worksheets("MP30 Start").Unprotect Password
    Worksheets("MP30 Start").Protect Password
End Sub

Public Function Read_Record() As Integer
    Input #1, Instring1$
    Rec_Type = Val(Instring1$)
    
    Input #1, Instring2$
    Temp_ADC = Int(Val(Instring2$)) And 1023
    
    Input #1, Instring3$
    Temp_Speed = Val(Instring3$)
  
    If Rec_Type = 0 Then ' data record
        If Int(Val(Instring2$)) >= 2048 Then
            Dir_Bit = 1
        Else
            Dir_Bit = 0
        End If
        Rec_ADC = Temp_ADC - ADC_Offset
        If Rec_ADC < 0 Then Rec_ADC = 0
        Rec_Speed = Temp_Speed * Speed_Factor
        Rec_F = Rec_ADC * Sensor_Factor
        If Rec_F > 0 Then Rec_F = Rec_F - 0.5
    End If
    
    If Rec_Type = 1 Then Language = Temp_ADC
    If Rec_Type = 2 Then ' date record
        Years% = (Int(Temp_ADC / 16) * 10) + (Temp_ADC Mod 16) + 2000
        Months% = (Int(Temp_Speed / 16) * 10) + (Temp_Speed Mod 16)
    End If
    
    If Rec_Type = 3 Then ' date record - day/time
        Days% = (Int(Temp_ADC / 16) * 10) + (Temp_ADC Mod 16)
        Hours% = (Int(Temp_Speed / 16) * 10) + (Temp_Speed Mod 16)
        If Time_Format Then
            If Hours% = 0 Then Hours% = 12
            If Hours% > 12 Then Hours% = Hours - 12
        End If
    End If
    
    If Rec_Type = 4 Then ' seconds
        Minutes% = (Int(Temp_ADC / 16) * 10) + (Temp_ADC Mod 16)
        Seconds% = (Int(Temp_Speed / 16) * 10) + (Temp_Speed Mod 16)
    End If
    
    If Rec_Type = 5 Then ' Fmax record
        Rec_ADC = (Temp_ADC - ADC_Offset) * Sensor_Factor
        If Rec_ADC < 0 Then Rec_ADC = 0
        Rec_Fmax = Rec_ADC
        If Rec_Fmax > 0 Then Rec_Fmax = Rec_Fmax - 0.5
    End If
    
    If Rec_Type = 6 Then ' Ftrigger record
        Rec_ADC = Temp_ADC - ADC_Offset
        If Rec_ADC < 0 Then Rec_ADC = 0
        Rec_Speed = Temp_Speed
        Rec_Ftrig = Rec_ADC * Sensor_Factor
        If Rec_Ftrig > 0 Then Rec_Ftrig = Rec_Ftrig - 0.5
    End If
      
    If Rec_Type = 7 Then ' distance record
        Rec_Distance = Temp_ADC * 256 + Temp_Speed
    End If
    
    If Rec_Type = 8 Then ' Fpeak record
        Rec_ADC = Temp_ADC - ADC_Offset
        If Rec_ADC < 0 Then Rec_ADC = 0
        Rec_Speed = Temp_Speed
        Rec_Fpeak = Rec_ADC * Sensor_Factor
        If Rec_Fpeak > 0 Then Rec_Fpeak = Rec_Fpeak - 0.5
    End If
    
    If Rec_Type = 10 Then ' F record
        Rec_ADC = Temp_ADC - ADC_Offset
        If Rec_ADC < 0 Then Rec_ADC = 0
        Rec_Speed = Temp_Speed * Speed_Factor
        Rec_F = Rec_ADC * Sensor_Factor
        If Rec_F > 0 Then Rec_F = Rec_F - 0.5
    End If
    
    If Rec_Type = 11 Then ' Fmax altered record
        Feff = (Temp_ADC - ADC_Offset) * Sensor_Factor
        Rec_Fmax = Feff
        If Rec_Fmax > 0 Then Rec_Fmax = Rec_Fmax - 0.5
    End If
    
    If Rec_Type = 12 Then ' EOF record
        Rec_ADC = Temp_ADC
    End If
    
    If Rec_Type = 13 Then ' zero crossing record
        Rec_ADC = Temp_ADC - ADC_Offset
        If Rec_ADC < 0 Then Rec_ADC = 0
        Rec_Speed = Temp_Speed * Speed_Factor
        Rec_F = Rec_ADC * Sensor_Factor
        If Rec_F > 0 Then Rec_F = Rec_F - 0.5
        Rel_Distance = 0
    End If
    
    If Rec_Type = 14 Then ' ADC Offset and Sensor Type
        Sensor_Type(0) = 1343 '/*0, 40 bar, 50mm, metric,  500 daN*/
        Sensor_Type(1) = 2015 '/*1, 60 bar, 50mm, metric, 750 daN */
        Sensor_Type(2) = 3358 '/*2, 100 bar, 50mm, metric, 1500 daN */
        Sensor_Type(3) = 5372 '/*3, 160 bar, 50mm, metric, 2300 daN */
        Sensor_Type(4) = 8394 '/*4, 250 bar, 50mm, metric, 3300 daN */
        Sensor_Type(5) = 8394 '/*5, 250 bar, 50mm, metric, 4300 daN */
        Sensor_Type(6) = 13430 '/*6, 400 bar, 50mm, metric, 7500 daN */
        Sensor_Type(7) = 21489 '/*7, 160 bar, 100mm, metric, 10 kdaN */
        Sensor_Type(8) = 33576 '/*8, 250 bar, 100mm, metric, 15 kdaN*/
        Sensor_Type(9) = 53721 '/*9, 400 bar, 100mm, metric, 20..30 kdaN*/
        Sensor_Type(10) = 53721 '/*10, 400 bar, 100mm, metric, 20..30 daN*/
        Sensor_Type(11) = 53721 '/*11, 400 bar, 100mm, metric, 20..30 daN */
        Sensor_Type(12) = 5372 '/*3, 160 bar, 50mm, metric, 2300 daN */
        Sensor_Type(13) = 0 '/*13, reserve metric */
        Sensor_Type(14) = 0 '/*14, reserve metric */
        Sensor_Type(15) = 0 '/*15, reserve metric */
                    '/* resolution 1 lbs */
        Sensor_Type(16) = 3019 '/*0, 40 bar, 50mm, lbs,  500 daN*/
        Sensor_Type(17) = 4529 '/*1, 60 bar, 50mm, lbs, 750 daN */
        Sensor_Type(18) = 7548 '/*2, 100 bar, 50mm, lbs, 1500 daN */
        Sensor_Type(19) = 12077 '/*3, 160 bar, 50mm, lbs, 2300 daN */
        Sensor_Type(20) = 18870 '/*4, 250 bar, 50mm, lbs, 3300 & 4300 daN */
        Sensor_Type(21) = 18870 '/*5, 400 bar, 50mm, lbs, 7500 daN */
        Sensor_Type(22) = 30193 '/*6, 160 bar, 100mm, lbs, 10 kdaN */
                    '/* mult factor is 256 here */
        Sensor_Type(23) = 48308 '/*7, 250 bar, 100mm, lbs, 15 kdaN */
        Sensor_Type(24) = 18870 '/*8, 400 bar, 100mm, lbs, 20..30 daN */
        Sensor_Type(25) = 30193 '/*9, 400 bar, 100mm, lbs, 20 daN */
        Sensor_Type(26) = 30193 '/*10, 400 bar, 100mm, lbs, 25 daN */
        Sensor_Type(27) = 30193 '/*11, 400 bar, 100mm, lbs, 30 daN */
        Sensor_Type(28) = 12077 '/*3, 160 bar, 50mm, lbs, 2300 daN */
        Sensor_Type(29) = 0 '/*13, reserve  */
        Sensor_Type(30) = 0 '/*14, reserve  */
        Sensor_Type(31) = 0 '/*15, reserve  */
    
        ADC_Offset = Temp_ADC
        Stype_Def = Temp_Speed And 31
        If (Temp_Speed And 32) <> 0 Then
            Metric% = 0
            Speed_Factor = 3.2808
        Else
            Metric% = 1
            Speedfactor = 1
        End If
        
        If (Temp_Speed And 64) <> 0 Then Time_Format% = 1 Else Time_Format% = 0
        testvar = Sensor_Type(Stype_Def)
        
        If (Stype_Def < 24) Or (Stype_Def = 28) Then
            Sensor_Factor = Sensor_Type(Stype_Def) / 1024
        Else
            Sensor_Factor = Sensor_Type(Stype_Def) / 256
        End If
    End If
    
    Read_Record = Rec_Type
End Function

' Neue Hilfsfunktion zum Lesen von Datum/Zeit Records (Typ 3 und 4 zusammen)
Private Sub Read_DateTime()
    ' Liest zwei Record-Typen hintereinander aus dem File
    Dim tempType As Integer
    Input #1, Instring1$
    Rec_Type = Val(Instring1$)
    
    If Rec_Type = 3 Then ' Day/Hours
        Days% = (Int(Temp_ADC / 16) * 10) + (Temp_ADC Mod 16)
        Hours% = (Int(Temp_Speed / 16) * 10) + (Temp_Speed Mod 16)
    ElseIf Rec_Type = 4 Then ' Minutes/Seconds
        Minutes% = (Int(Temp_ADC / 16) * 10) + (Temp_ADC Mod 16)
        Seconds% = (Int(Temp_Speed / 16) * 10) + (Temp_Speed Mod 16)
    End If
    
    ' Speichere Typ für späteren Vergleich in Dump()
    Read_Record = Rec_Type
End Sub

Public Sub ADjust_Offset()
    Open_Com
    SENDSTRING ("O%" + Chr(13))
    CLOSECOM
End Sub

Public Sub Backlight_On()
    Open_Com
    SENDSTRING ("B1" + Chr(13))
    CLOSECOM
End Sub

Public Sub Backlight_Off()
    Open_Com
    SENDSTRING ("B0" + Chr(13))
    CLOSECOM
End Sub

Public Sub Welcome_Screen()
    Dim Welcome(4) As String
    
    Open_Com
    
    Welcome(0) = Left(Cells(2, 7), 20) & "                     "
    Welcome(1) = Left(Cells(3, 7), 20) & "                     "
    Welcome(2) = Left(Cells(4, 7), 20) & "                     "
    Welcome(3) = Left(Cells(5, 7), 20) & "                     "
    Delay_Var = 100
    
    SENDSTRING ("W" & Chr(238) & Chr(13))
    DELAY (Delay_Var)
    
    For i = 0 To 3
        SENDSTRING ("W" & Left$(Welcome(i), 5) & Chr(13))
        DELAY (Delay_Var)
        
        SENDSTRING ("W" & Mid$(Welcome(i), 6, 5) & Chr(13))
        DELAY (Delay_Var)
        
        SENDSTRING ("W" & Mid$(Welcome(i), 11, 5) & Chr(13))
        DELAY (Delay_Var)
        
        SENDSTRING ("W" & Mid$(Welcome(i), 16, 5) & Chr(13))
        DELAY (Delay_Var)
    Next i
    
    CLOSECOM
End Sub

Public Sub Open_Com()
    If Baudrate = 0 Then
        If PortNumber = 1 Then OPENCOM "COM1:9600,N,8,1"
        If PortNumber = 2 Then OPENCOM "COM2:9600,N,8,1"
        If PortNumber = 3 Then OPENCOM "COM3:9600,N,8,1"
        If PortNumber = 4 Then OPENCOM "COM4:9600,N,8,1"
        If PortNumber = 5 Then OPENCOM "COM5:9600,N,8,1"
        If PortNumber = 6 Then OPENCOM "COM6:9600,N,8,1"
        If PortNumber = 7 Then OPENCOM "COM7:9600,N,8,1"
        If PortNumber = 8 Then OPENCOM "COM8:9600,N,8,1"
    Else
        OPENCOM "COM1:57600,N,8,1"
        Baudrate = 1
    End If
End Sub

Public Sub Set_Com_Port()
    Dim TempDir$ As String
    Dim ConfigFile As String
    Dim conf$ As String
    TempDir$ = Environ("temp")
    ConfigFile = TempDir$ + "\MP30_Config.txt"
    
    If Fileishere(ConfigFile) Then
        Open ConfigFile For Input As #2
        Input #2, conf$
        PortNumber = Val(Right$(conf$, 1))
        Close #2
        
        If PortNumber < 1 Or PortNumber > 8 Then
            PortNumber = 1
        End If
    Else
        PortNumber = 1
    End If
End Sub

Public Sub Baud_9600()
    OPENCOM "COM1:57600,N,8,1"
    SENDSTRING ("U#" + Chr(13))
    CLOSECOM
    DELAY (100)
    OPENCOM "COM1:9600,N,8,1"
    SENDSTRING (Chr(13) + "U%" + Chr(13))
    CLOSECOM
    DELAY (100)
    Baudrate = 0
End Sub

Public Sub Baud_57600()
    OPENCOM "COM1:9600,N,8,1"
    SENDSTRING ("U%" + Chr(13))
    CLOSECOM
    DELAY (100)
    OPENCOM "COM1:57600,N,8,1"
    SENDSTRING (Chr(13) + "U#" + Chr(13))
    CLOSECOM
    DELAY (100)
    Baudrate = 1
End Sub

Sub NewSheet_add()
    Dim ws As Worksheet
    
    sheetcounter = sheetcounter + 1
    Set NewSheet = Worksheets.Add
    NewSheet.Name = "MP 30_" & CStr(sheetcounter)
    NewSheet.Move after:=Sheets(sheetcounter)
    Worksheets("MP30 Start").Unprotect Password
    Worksheets("MP30 Start").Range("A1:G11").Copy _
        Destination:=Worksheets(NewSheet.Name).Range("A1:G11")
    Worksheets(NewSheet.Name).Columns(1).Font.Bold = True
    
    SetColumnWidthMM 1, 30
    SetRowHeightMM 1, 25
    SetColumnWidthMM 2, 20
    SetColumnWidthMM 3, 20
    SetColumnWidthMM 4, 20
    SetColumnWidthMM 5, 25
    SetColumnWidthMM 6, 20
    SetColumnWidthMM 7, 18
    
    FormatColumn
    Worksheets(NewSheet.Name).PageSetup.CenterHeader = "&16&B&A"
    With Worksheets(NewSheet.Name).PageSetup
        .PrintTitleRows = ("$A1:$G10")
        .LeftMargin = Application.InchesToPoints(1)
    End With
    
    With Worksheets(NewSheet.Name)
        .Rows(11).Select
        .Application.ActiveWindow.FreezePanes = True
    End With
End Sub

Sub Write_Unlocked_Cells()
    Dim Sh As Worksheet
    SheetName = "MP 30_"
    
    For Each Sh In ThisWorkbook.Worksheets
        If Left$(Sh.Name, 12) = SheetName Or Sh.Name = "MP30 Start" Then
            Sh.Unprotect Password
            Sh.Select
            Sh.Protect userinterfaceonly:=True
            Sh.EnableSelection = xlUnlockedCells
            Sh.Protect Password
        End If
    Next
End Sub

Sub DeleteNewSheets()
    Dim ws As Worksheet
    Dim SheetName As String
    SheetName = "MP 30_"
    
    For Each ws In Worksheets
        If Left$(ws.Name, 6) = SheetName Then
            ThisWorkbook.Sheets(ws.Name).Activate
            Application.DisplayAlerts = False
            ActiveSheet.Delete
            Application.DisplayAlerts = True
        End If
    Next
End Sub

Sub SetColumnWidthMM(ColNo As Long, mmWidth As Integer)
    Dim w As Single
    If ColNo < 1 Or ColNo > 255 Then Exit Sub
    Application.ScreenUpdating = False
    w = Application.CentimetersToPoints(mmWidth / 10)
    
    While Columns(ColNo + 1).Left - Columns(ColNo).Left - 0.1 > w
        Columns(ColNo).ColumnWidth = Columns(ColNo).ColumnWidth - 0.1
    Wend
    
    While Columns(ColNo + 1).Left - Columns(ColNo).Left + 0.1 < w
        Columns(ColNo).ColumnWidth = Columns(ColNo).ColumnWidth + 0.1
    Wend
End Sub

Sub SetRowHeightMM(RowNo As Long, mmHeight As Integer)
    If RowNo < 1 Or RowNo > 65536 Then Exit Sub
    Rows(RowNo).RowHeight = Application.CentimetersToPoints(mmHeight / 10)
End Sub

Sub set_port1()
    OpenCom_Str$ = "COM1:9600,N,8,1"
    PortNumber = 1
    write_conf
End Sub

Sub set_port2()
    OpenCom_Str$ = "COM2:9600,N,8,1"
    PortNumber = 2
    write_conf
End Sub

Sub set_port3()
    OpenCom_Str$ = "COM3:9600,N,8,1"
    PortNumber = 3
    write_conf
End Sub

Sub set_port4()
    OpenCom_Str$ = "COM4:9600,N,8,1"
    PortNumber = 4
    write_conf
End Sub

Sub set_port5()
    OpenCom_Str$ = "COM5:9600,N,8,1"
    PortNumber = 5
    write_conf
End Sub

Sub set_port6()
    OpenCom_Str$ = "COM6:9600,N,8,1"
    PortNumber = 6
    write_conf
End Sub

Sub set_port7()
    OpenCom_Str$ = "COM7:9600,N,8,1"
    PortNumber = 7
    write_conf
End Sub

Sub set_port8()
    OpenCom_Str$ = "COM8:9600,N,8,1"
    PortNumber = 8
    write_conf
End Sub

Sub write_conf()
    TempDir$ = Environ("temp")
    
    ConfigFile = TempDir$ + "\MP30_Config.txt"
    Kill ConfigFile
    Open ConfigFile For Output As #2
    conf$ = "COM " & Chr$(Asc(PortNumber))
    Print #2, conf$
    Close #2
    
    Password = "pw002"
    Worksheets("MP30 Start").Unprotect Password
    Worksheets("MP30 Start").Cells(20, 4) = "Port: " & conf$
    Worksheets("MP30 Start").Protect Password
End Sub

Sub FormatColumn()
    Columns("B:B").Select
    Selection.NumberFormat = "0.0"
End Sub