390 lines
10 KiB
Plaintext
390 lines
10 KiB
Plaintext
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ä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ä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ä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ä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ät.Clear
|
|
cmbParität.AddItem "o"
|
|
cmbParität.AddItem "e"
|
|
cmbParität.AddItem "n"
|
|
cmbParitä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
|