Public Class Form1
' Das Delegat muss die selbe Signature haben
Delegate Sub TextBoxCallback(ByVal text As String)
Private WithEvents myComPort As IO.Ports.SerialPort
' Bei den meisten Geräten ist ein Abschlußzeichen erforderlich, meistens
' wird ChrW(13) oder ChrW(10) oder beide benötigt
' - Wählt was eure Gegenstelle benötigt:
Private EndOfCommand As String = Constants.vbCr.ToString
' Private EndOfCommand As String = Constants.vbLf.ToString
' Private EndOfCommand As String = Constants.vbCrLf.ToString
Private Sub Form1_Load(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles MyBase.Load
' Mal nachschauen, ob es hier SerialPorts gibt
Dim str() As String = IO.Ports.SerialPort.GetPortNames()
' Wenn nein, dann beenden:
If str.Length = 0 Then
MsgBox("No Serialport available!", MsgBoxStyle.Critical)
Me.Close()
End If
' Eine Instance von SerialPort erstellen
' Im Normalfall ist das COM1:
Me.myComPort = New IO.Ports.SerialPort(str(0))
' Die folgenden vier Einstellungen müssen denen der
' Gegenstelle entsprechen
Me.myComPort.BaudRate = 9600
Me.myComPort.DataBits = 8
Me.myComPort.StopBits = IO.Ports.StopBits.One
Me.myComPort.Parity = IO.Ports.Parity.None
' Wichtig! Hier wird eingestellt nach wieviel Bytes im Eingangspuffer
' das DataReceived Event gefeuert wird
Me.myComPort.ReceivedBytesThreshold = 1
' Und nun öffnen wir den Port
Me.myComPort.Open()
End Sub
''' <summary>
''' Wird ausgelöst wenn die Comm die in ReceivedBytesThreshold eingestellte
''' Anzahl Bytes empfangen hat
''' </summary>
Private Sub myComPort_DataReceived( _
ByVal sender As Object, _
ByVal e As System.IO.Ports.SerialDataReceivedEventArgs) _
Handles myComPort.DataReceived
Select Case e.EventType
Case IO.Ports.SerialData.Chars
' Ein Zeichen wurde empfangen und im Eingabepuffer platziert.
Case IO.Ports.SerialData.Eof
' Das Dateiendezeichen wurde empfangen und im
' Eingabepuffer platziert.
End Select
Dim msg As String = Me.myComPort.ReadExisting
Me.ShowText(msg)
End Sub
''' <summary>
''' Wird ausgelöst wenn sich die Steuerleitungen geändert haben
''' </summary>
Private Sub myComPort_PinChanged(ByVal sender As Object, ByVal e As _
System.IO.Ports.SerialPinChangedEventArgs) Handles myComPort.PinChanged
Select Case e.EventType
Case IO.Ports.SerialPinChange.Break
' Bei der Eingabe wurde ein "break" erkannt.
Case IO.Ports.SerialPinChange.CDChanged
' Der Zustand des CD-Signals (Carrier Detect) hat sich geändert.
' Mit diesem Signal wird angezeigt, ob ein Modem mit einer
' Telefonleitung verbunden ist und ein Datenträgersignal
' erkannt wurde.
Case IO.Ports.SerialPinChange.CtsChanged
' Der Zustand des CTS-Signals (Clear to Send) hat sich geändert.
' Mit diesem Signal wird angegeben, ob Daten über den seriellen
' Anschluss gesendet werden können.
Case IO.Ports.SerialPinChange.DsrChanged
' Zustand des DSR-Signals (Data Set Ready) hat sich geändert.
' Mit diesem Signal wird angezeigt, ob das Gerät am seriellen
' Anschluss betriebsbereit ist.
Case IO.Ports.SerialPinChange.Ring
'Ein Ringindikator wurde erkannt.
End Select
End Sub
''' <summary>
''' Wird ausgelöst wenn ein Fehler in der Übertragung endeckt wurde
''' </summary>
Private Sub myComPort_ErrorReceived( _
ByVal sender As Object, _
ByVal e As System.IO.Ports.SerialErrorReceivedEventArgs) _
Handles myComPort.ErrorReceived
Select Case e.EventType
Case IO.Ports.SerialError.Frame
' Die Hardware hat einen Rahmenfehler erkannt.
Case IO.Ports.SerialError.Overrun
' Ein Zeichenpufferüberlauf ist aufgetreten. Das nächste
' Zeichen geht verloren.
Case IO.Ports.SerialError.RXOver
' Ein Eingabepufferüberlauf ist aufgetreten.
' Die Kapazität des Eingabepuffers ist erschöpft,
' oder es wurde ein Zeichen nach dem Dateiendezeichen
' (EOF, end-of-file) empfangen.
Case IO.Ports.SerialError.RXParity
' Die Hardware hat einen Paritätsfehler erkannt.
Case IO.Ports.SerialError.TXFull
' Die Anwendung hat versucht, ein Zeichen zu übertragen, aber
' die Kapazität des Ausgabepuffers war erschöpft.
End Select
Me.ShowText("ERROR" & vbCrLf)
End Sub
''' <summary>
''' Da die Daten aus einem anderem Thread kommen müssen wir die Ausgabe
''' über Invoke machen
''' </summary>
Private Sub ShowText(ByVal text As String)
If Me.TxtMesswert.InvokeRequired Then
Dim d As New TextBoxCallback(AddressOf ShowText)
Me.Invoke(d, New Object() {text})
Else
Me.TxtMesswert.Text = Me.TxtMesswert.Text & text
End If
End Sub
''' <summary>
''' Hier wird der Command zusammengesetzt und versendet
''' </summary>
''' <param name="command"></param>
''' <remarks></remarks>
Private Sub Send(ByVal command As String)
Me.myComPort.Write(command & Me.EndOfCommand)
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles BtnStart.Click
'Messung starten
TxtMesswert.Clear()
Me.Send("M")
End Sub
Private Sub BtnBeenden_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnBeenden.Click
'Messung beenden
Me.myComPort.Close()
Me.Close()
End Sub
End Class
