laatzen/Pruef2000/source/frmFM85BusTerminal.frm
2021-10-01 11:11:04 +02:00

390 lines
10 KiB
Plaintext
Raw Blame History

VERSION 5.00
Begin VB.Form frmFM85BusTerminal
Caption = "Pruef2000"
ClientHeight = 5595
ClientLeft = 60
ClientTop = 345
ClientWidth = 8445
LinkTopic = "Form1"
ScaleHeight = 5595
ScaleWidth = 8445
StartUpPosition = 3 'Windows-Standard
Begin VB.CommandButton cmdOK
Caption = "Ende"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 120
TabIndex = 3
Top = 0
Width = 1455
End
Begin VB.Frame FrMain
Height = 4515
Left = 750
TabIndex = 0
Top = 720
Width = 7425
Begin VB.CommandButton cmdReset
Caption = "Reset alle"
Height = 315
Left = 6300
TabIndex = 21
Top = 3660
Width = 915
End
Begin VB.ComboBox cmbCOMPortNr
Height = 315
Left = 4920
TabIndex = 13
Text = "cmbCOMPortNr"
Top = 1260
Width = 1095
End
Begin VB.Frame Frame1
Caption = "Settings"
Height = 2415
Left = 4020
TabIndex = 9
Top = 1020
Width = 3315
Begin VB.CommandButton cmdCloseCOM
Caption = "Close COM"
Height = 315
Left = 1740
TabIndex = 17
Top = 1620
Width = 1095
End
Begin VB.CommandButton cmdOpenCom
Caption = "Open COM"
Height = 315
Left = 360
TabIndex = 16
Top = 1620
Width = 1095
End
Begin VB.CommandButton cmdAendern
Caption = "Aendern"
Height = 315
Left = 2400
TabIndex = 15
Top = 1200
Width = 795
End
Begin VB.ComboBox cmbStopBits
Height = 315
Left = 1620
TabIndex = 14
Text = "Stop"
Top = 1200
Width = 630
End
Begin VB.ComboBox cmbParit<69>t
Height = 315
Left = 960
TabIndex = 12
Text = "Par"
Top = 1200
Width = 555
End
Begin VB.ComboBox cmbDatenBits
Height = 315
Left = 120
TabIndex = 11
Text = "Daten"
Top = 1200
Width = 735
End
Begin VB.ComboBox cmbBaud
Height = 315
Left = 900
TabIndex = 10
Text = "cmbBaud"
Top = 660
Width = 1095
End
Begin VB.Label lblSettingsCOM
BorderStyle = 1 'Fest Einfach
Height = 315
Left = 60
TabIndex = 20
Top = 2040
Width = 3195
End
Begin VB.Label Label4
Caption = "Baud"
Height = 255
Left = 240
TabIndex = 19
Top = 720
Width = 435
End
Begin VB.Label Label3
Caption = "COM "
Height = 255
Left = 240
TabIndex = 18
Top = 300
Width = 555
End
End
Begin VB.CommandButton cmdSenden
Caption = "Senden"
Height = 495
Left = 5040
TabIndex = 7
Top = 3660
Width = 915
End
Begin VB.TextBox txtCtrl
Height = 285
Left = 4140
TabIndex = 4
Top = 3840
Width = 735
End
Begin VB.TextBox txtAnzeige
Height = 3615
Left = 180
MultiLine = -1 'True
TabIndex = 2
Top = 210
Width = 3735
End
Begin VB.TextBox txtEingabe
Height = 525
Left = 180
MultiLine = -1 'True
TabIndex = 1
Top = 3870
Width = 3735
End
Begin VB.Label lblTime
Caption = "Label3"
Height = 285
Left = 4380
TabIndex = 8
Top = 300
Width = 1875
End
Begin VB.Label Label2
Caption = "- - - - - - - - - "
Height = 375
Left = 4380
TabIndex = 6
Top = 660
Width = 2295
End
Begin VB.Label Label1
Caption = "Ascii"
Height = 315
Left = 4140
TabIndex = 5
Top = 3480
Width = 735
End
End
End
Attribute VB_Name = "frmFM85BusTerminal"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private m_FMBus As CFMBus
' Private Member
' --------------
Private m_nRet As Integer
'------------------------------------------------------------------------------
' Private Funktionalit<69>t
'------------------------------------------------------------------------------
' Dialog beenden
'
' @param nRet Returncode des Dialogs
'
Private Sub endDialog(nRet As Integer)
m_nRet = nRet
Unload Me
End Sub
'------------------------------------------------------------------------------
' Event-Handling
'------------------------------------------------------------------------------
Private Sub cmdOk_Click()
Call endDialog(IDOK)
End Sub
Private Sub cmdCancel_Click()
Call endDialog(IDCANCEL)
End Sub
' @return Code, mit dem endDialog aufgerufen wurde
'
Public Function getExitCode() As Integer
getExitCode = m_nRet
End Function
Private Sub cmdOpenCom_Click()
On Error Resume Next
If m_FMBus.GetMSComm.PortOpen = False Then
m_FMBus.GetMSComm.PortOpen = True
End If
Anzeigen
End Sub
Private Sub cmdCloseCOM_Click()
If m_FMBus.GetMSComm.PortOpen = True Then
m_FMBus.GetMSComm.PortOpen = False
End If
Anzeigen
End Sub
Private Sub cmdAendern_Click()
m_FMBus.GetMSComm.Settings = cmbBaud.text & "," & cmbParit<69>t.text & "," & cmbDatenBits.text & "," & cmbStopBits.text
Anzeigen
End Sub
Private Sub Anzeigen()
lblSettingsCOM.Caption = "COM " & m_FMBus.GetMSComm.CommPort & ": " & m_FMBus.GetMSComm.Settings & " " & IIf(m_FMBus.GetMSComm.PortOpen, "open", "closed")
End Sub
Private Sub cmdReset_Click()
m_FMBus.send "**0@"
Sleep 100
m_FMBus.send "R"
End Sub
Private Sub cmdSenden_Click()
Dim sTmp As String
Dim lngTime As Long
lngTime = GetTickCount()
m_FMBus.send (txtEingabe.text)
sTmp = m_FMBus.receive(500)
If Len(sTmp) > 0 Then
End If
Print2Screen sTmp
txtEingabe.text = ""
lblTime.Caption = GetTickCount - lngTime
Anzeigen
End Sub
'------------------------------------------------------------------------------
' Private Funktionalit<69>t
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' Event-Handling
'------------------------------------------------------------------------------
Private Sub Form_Load()
Call setupStdDlg(Me)
Set m_FMBus = g_App.getFMBus
InitAuswahl
Anzeigen
End Sub
Private Sub InitAuswahl()
cmbBaud.Clear
cmbBaud.AddItem 1200
cmbBaud.AddItem 2400
cmbBaud.AddItem 4800
cmbBaud.AddItem 9600
cmbBaud.AddItem 19200
cmbBaud.AddItem 57600
cmbBaud.AddItem 115200
cmbBaud.text = Split(m_FMBus.GetMSComm.Settings, ",")(0)
cmbCOMPortNr.text = m_FMBus.GetMSComm.CommPort
cmbParit<69>t.Clear
cmbParit<69>t.AddItem "o"
cmbParit<69>t.AddItem "e"
cmbParit<69>t.AddItem "n"
cmbParit<69>t.text = Split(m_FMBus.GetMSComm.Settings, ",")(1)
cmbDatenBits.Clear
cmbDatenBits.AddItem 7
cmbDatenBits.AddItem 8
cmbDatenBits.text = Split(m_FMBus.GetMSComm.Settings, ",")(2)
cmbStopBits.Clear
cmbStopBits.AddItem 1
cmbStopBits.text = Split(m_FMBus.GetMSComm.Settings, ",")(3)
End Sub
Private Sub txtCtrl_KeyPress(KeyAscii As Integer)
Dim sTmp As String
If KeyAscii = 13 Then
m_FMBus.send (Chr(Val(txtEingabe.text))) & vbCrLf
sTmp = m_FMBus.receive(500)
If Len(sTmp) > 0 Then
Print2Screen sTmp
End If
txtEingabe.text = ""
KeyAscii = 0
End If
End Sub
Private Function txt2Hex(sString As String) As String
Dim i As Integer
Dim C As Integer
For i = 1 To Len(sString)
C = Asc(Mid$(sString, i, 1))
'If c < 33 Or c > 90 Then
txt2Hex = txt2Hex & "[" & Str$(C) & "]"
'Else
' txt2Hex = txt2Hex & Chr$(c)
'End If
Next
End Function
Private Function Print2Screen(sString As String)
txtAnzeige.text = txtAnzeige.text & sString & " -> '" & txt2Hex(sString) & "'" & vbCrLf
txtAnzeige.SelStart = Len(txtAnzeige.text)
DebugMsg sString
Label2.Caption = Len(sString) & " Zeichen feedback"
End Function