1212 lines
38 KiB
VB.net
1212 lines
38 KiB
VB.net
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
|