449 lines
12 KiB
OpenEdge ABL
449 lines
12 KiB
OpenEdge ABL
VERSION 1.0 CLASS
|
||
BEGIN
|
||
MultiUse = -1 'True
|
||
Persistable = 0 'NotPersistable
|
||
DataBindingBehavior = 0 'vbNone
|
||
DataSourceBehavior = 0 'vbNone
|
||
MTSTransactionMode = 0 'NotAnMTSObject
|
||
END
|
||
Attribute VB_Name = "CEAKIT"
|
||
Attribute VB_GlobalNameSpace = False
|
||
Attribute VB_Creatable = True
|
||
Attribute VB_PredeclaredId = False
|
||
Attribute VB_Exposed = False
|
||
Option Explicit
|
||
|
||
Private WithEvents m_objMscomm As MSComm
|
||
Attribute m_objMscomm.VB_VarHelpID = -1
|
||
|
||
Public Event DaempfungChange(ByVal bytadresse As Byte, ByVal intDaempfung As Integer)
|
||
Public Event TasteGedrueckt(ByVal bytadresse As Byte, ByVal strText As String)
|
||
|
||
Private intDaempfungMax As Integer
|
||
Private m_intPuls As Integer
|
||
Private intDaempfung(10) As Integer
|
||
Public intAktivesDisplay As Integer
|
||
Public blnTaste As Boolean
|
||
|
||
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
|
||
|
||
Const ESC = "" ' chr(27)
|
||
Const SKALAX = 20
|
||
Const SKALAY = 72
|
||
|
||
|
||
Public Sub initMSComm(objMscomm As MSComm, bComport As Byte, Optional strSettings As Variant)
|
||
On Error Resume Next
|
||
|
||
Set m_objMscomm = objMscomm
|
||
|
||
If m_objMscomm.PortOpen = True Then
|
||
m_objMscomm.PortOpen = False
|
||
End If
|
||
|
||
Debug.Print "Display COM Port: " & bComport
|
||
|
||
|
||
m_objMscomm.RTSEnable = True ' Damit Display weis, daß es jetzt Daten senden darf und nicht wartet
|
||
m_objMscomm.RThreshold = 1 ' Event feuern, sobald 1 Zeichen empfangen wird
|
||
'm_objMscomm.Handshaking = comRTSXOnXOff
|
||
m_objMscomm.Handshaking = comRTS
|
||
|
||
If Not IsMissing(strSettings) Then
|
||
m_objMscomm.Settings = strSettings
|
||
End If
|
||
|
||
m_objMscomm.CommPort = bComport
|
||
m_objMscomm.PortOpen = True
|
||
|
||
|
||
Debug.Print "im Puffer noch drin: " & m_objMscomm.Input
|
||
|
||
End Sub
|
||
|
||
|
||
Public Sub SelectEAKit(Nr As Byte)
|
||
EaKitOutput ESC & "KS" & Chr(Nr)
|
||
End Sub
|
||
|
||
Public Sub DeSelectEAKit(Nr As Byte)
|
||
EaKitOutput ESC & "KD" & Chr(Nr)
|
||
End Sub
|
||
|
||
Public Sub AdresseZuweisen(Nr As Byte)
|
||
Debug.Print "Den angeschlossenen EAKits wurde die Adresse " & Nr & "zugewiesen"
|
||
EaKitOutput ESC & "KA" & Chr(Nr)
|
||
End Sub
|
||
|
||
Public Sub Adressierung(Nr As Integer)
|
||
Debug.Print "Adressiere Display " & Nr
|
||
|
||
' alle EAKits deselectieren
|
||
EaKitOutput ESC & "KD" & Chr(255)
|
||
' EAKits auswählen
|
||
EaKitOutput ESC & "KS" & Chr(Nr)
|
||
End Sub
|
||
|
||
Public Sub ClrScreen()
|
||
EaKitOutput Chr(12)
|
||
Debug.Print "Bildschirm gelöscht"
|
||
End Sub
|
||
|
||
|
||
|
||
Public Sub PlaceKeineWdh()
|
||
EaKitOutput Chr(27) & "RL" & Chr(10) & Chr(40) & Chr(160) & Chr(50)
|
||
' sleep 50
|
||
EaKitOutput Chr(27) & "ZL" & Chr(10) & Chr(42) & " keine Wdh erforderlich!" & Chr(0)
|
||
' sleep 50
|
||
EaKitOutput Chr(27) & "RI" & Chr(10) & Chr(40) & Chr(160) & Chr(50)
|
||
' sleep 50
|
||
End Sub
|
||
|
||
Public Sub EaKitOutput(strText As String)
|
||
m_objMscomm.Output = strText
|
||
Debug.Print "sende an Display " & strText
|
||
Sleep 100
|
||
End Sub
|
||
|
||
Public Sub beep(zentelsec As Byte)
|
||
EaKitOutput ESC & "J" & Chr(zentelsec)
|
||
End Sub
|
||
|
||
|
||
Sub Linie(x1 As Byte, y1 As Byte, x2 As Byte, y2 As Byte)
|
||
EaKitOutput ESC & "P" & Chr(x1) & Chr(y1)
|
||
EaKitOutput ESC & "W" & Chr(x2) & Chr(y2)
|
||
|
||
Debug.Print "#P," & x1 & "," & y1
|
||
Debug.Print "#W," & x2 & "," & y2
|
||
End Sub
|
||
|
||
Public Sub EAKit_Init()
|
||
Dim i As Byte
|
||
|
||
' alle Auswählen
|
||
EaKitOutput ESC & "KS" & Chr(255)
|
||
|
||
Licht 1
|
||
' löschen
|
||
ClrScreen
|
||
EaKitOutput ESC & "V" & Chr(1)
|
||
|
||
EaKitOutput ESC & "QC" & Chr(0)
|
||
|
||
PlaceText "Einbauplatz : ", 10, 10
|
||
PlaceText "Seriennummer: ", 10, 20
|
||
PlaceText "Typ: ", 10, 30
|
||
PlaceText "NW: ", 90, 30
|
||
PlaceText "Pulsinfo: ", 10, 40
|
||
PlaceText "Daempfung", 50, 90
|
||
|
||
' Linie 0/50 - 160/50
|
||
Linie 0, 50, 160, 50
|
||
|
||
PlaceText " -3 -2 -1 0 +1 +2 +3 %", 0, 60
|
||
|
||
Linie 20, 72, 140, 72
|
||
|
||
For i = 20 To 140 Step 2
|
||
If (i \ 5 = i / 5) Then
|
||
Linie i, 70, i, 71
|
||
Else
|
||
Linie i, 71, i, 71
|
||
End If
|
||
Next
|
||
|
||
Linie 20, 69, 20, 72
|
||
Linie 40, 69, 40, 72
|
||
Linie 60, 69, 60, 72
|
||
Linie 80, 69, 80, 72
|
||
Linie 100, 69, 100, 72
|
||
Linie 120, 69, 120, 72
|
||
Linie 140, 69, 140, 72
|
||
|
||
|
||
|
||
'EaKitOutput ESC & "ZL" & Chr(10) & Chr(100) & "Daempfung:" & Chr(0)
|
||
|
||
' Bildbereich sichern
|
||
EaKitOutput ESC & "CS" & Chr(0) & Chr(65) & Chr(160) & Chr(85)
|
||
|
||
' Pfeil-Zeichen definieren
|
||
EaKitOutput ESC & "E" & Chr(1) & Chr(32) & Chr(32) & Chr(32) & Chr(32) & Chr(112) & Chr(112) & Chr(248) & Chr(248)
|
||
|
||
Licht 0
|
||
End Sub
|
||
|
||
Public Sub Invert(x1 As Byte, y1 As Byte, x2 As Byte, y2 As Byte)
|
||
EaKitOutput ESC & "RI" & Chr(x1) & Chr(y1) & Chr(x2) & Chr(y2)
|
||
End Sub
|
||
|
||
|
||
Public Sub PlaceEinbauplatz(strEinbauplatz As String)
|
||
PlaceAusgabe "Einbauplatz: " & strEinbauplatz, 10, 10, 140, 19
|
||
End Sub
|
||
|
||
Public Sub PlaceSeriennr(strSerNr As String)
|
||
PlaceAusgabe "Seriennummer: " & strSerNr, 10, 20, 140, 29
|
||
End Sub
|
||
|
||
Public Sub PlaceTyp(strTyp As String)
|
||
PlaceAusgabe "Typ: " & strTyp, 10, 30, 80, 39
|
||
End Sub
|
||
|
||
Public Sub PlaceNW(strTyp As String)
|
||
PlaceAusgabe "NW: " & strTyp, 90, 30, 160, 40
|
||
End Sub
|
||
|
||
Public Sub PlacePuls()
|
||
Dim strZeichen As String
|
||
|
||
m_intPuls = m_intPuls + 1
|
||
If m_intPuls > 4 Then m_intPuls = 1
|
||
|
||
PlaceAusgabe Mid("-\I/", m_intPuls, 1), 70, 40, 80, 50
|
||
End Sub
|
||
|
||
|
||
|
||
Public Sub SetMeter(Wert As Double)
|
||
|
||
Dim x As Byte
|
||
Dim strWert As String
|
||
|
||
Debug.Print Wert
|
||
|
||
strWert = IIf(Wert < 0, "-", "+") & Format(Abs(Wert), "0.00")
|
||
' Bereich setzen
|
||
|
||
' Rechteck für Zeiger
|
||
LoescheRechteck SKALAX - 10, SKALAY + 1, SKALAX + 130, SKALAY + 10
|
||
|
||
If Wert > 3 Then Wert = 3.2
|
||
If Wert < -3 Then Wert = -3.2
|
||
|
||
x = SKALAX + 120 / 2 + Wert * 20 - 2
|
||
' Bildbereich restaurieren
|
||
'EaKitOutput ESC & "CR"
|
||
|
||
'Inverse Modus
|
||
EaKitOutput ESC & "L" & Chr(3) & Chr(1)
|
||
' Zeiger setzen
|
||
EaKitOutput ESC & "ZL" & Chr(x) & Chr(SKALAY + 1) & Chr(1) & Chr(0)
|
||
|
||
|
||
' Oder Modus
|
||
EaKitOutput ESC & "L" & Chr(1) & Chr(1)
|
||
|
||
' Rechteck für Digital Wert Anzeige
|
||
EaKitOutput ESC & "RL" & Chr(65) & Chr(85) & Chr(105) & Chr(95)
|
||
|
||
EaKitOutput ESC & "ZL" & Chr(65) & Chr(85) & strWert & Chr(0)
|
||
|
||
|
||
End Sub
|
||
|
||
Private Sub Class_Initialize()
|
||
Dim i As Integer
|
||
For i = 1 To 10
|
||
intDaempfung(i) = 7
|
||
Next
|
||
intDaempfungMax = 9
|
||
End Sub
|
||
|
||
Private Sub m_objMscomm_OnComm()
|
||
Dim s As String
|
||
Dim i As Integer
|
||
|
||
Debug.Print "OnComm Event:" & m_objMscomm.CommEvent
|
||
Select Case m_objMscomm.CommEvent
|
||
Case comEventBreak ' A Break was received.
|
||
Case comEventCDTO ' CD (RLSD) Timeout.
|
||
Case comEventCTSTO ' CTS Timeout.
|
||
Case comEventDSRTO ' DSR Timeout.
|
||
Case comEventFrame ' Framing Error
|
||
Case comEventOverrun ' Data Lost.
|
||
' FEHLER: empfangspuffer läuft über :-(
|
||
Debug.Print "MSComm Event: empfangspuffer läuft über "
|
||
Case comEventRxOver ' Receive buffer overflow.
|
||
Case comEventRxParity ' Parity Error.
|
||
Case comEventTxFull ' Transmit buffer full.
|
||
Case comEventDCB ' Unexpected error retrieving DCB]
|
||
Case comEvCD ' Change in the CD line.
|
||
Case comEvCTS ' Change in the CTS line.
|
||
Debug.Print "CTS change"
|
||
Case comEvDSR ' Change in the DSR line.
|
||
Debug.Print "DSR change"
|
||
Case comEvRing ' Change in the Ring Indicator.
|
||
Debug.Print "ring"
|
||
Case comEvSend ' There are SThreshold number of
|
||
' characters in the transmit
|
||
' buffer.
|
||
Debug.Print "Threshold"
|
||
Case comEvEOF ' An EOF charater was found in ' the input stream
|
||
Debug.Print "EOF found"
|
||
Case comEvSend
|
||
Debug.Print "MSComm Event: Sendepuffer leer"
|
||
Case comEvReceive ' Received RThreshold # of chars
|
||
s = m_objMscomm.Input
|
||
Debug.Print "MSComm Event: " & Len(s) & " Zeichen empfangen: " & s
|
||
Tastendruck s
|
||
Case comEventRxOver
|
||
Case Else
|
||
Debug.Print "MSComm Event: " & m_objMscomm.CommEvent
|
||
End Select
|
||
End Sub
|
||
|
||
|
||
|
||
Public Sub CallMakro(Nr As Byte)
|
||
EaKitOutput ESC & "MN" & Chr(Nr)
|
||
' sleep 200
|
||
End Sub
|
||
|
||
|
||
Public Sub DefineButton(f1 As Byte, f2 As Byte, ret As Byte, text As String)
|
||
' touch taste definieren
|
||
EaKitOutput Chr(27) & "TH" & Chr(f1) & Chr(f2) & Chr(ret) & Chr(2) & text & Chr(0)
|
||
Debug.Print "#TH" & f1 & "," & f2 & "," & ret & ",2,""" & text & """"
|
||
End Sub
|
||
|
||
Public Sub DefineAllButtons()
|
||
'Touchfelder reset
|
||
EaKitOutput Chr(27) & "TR"
|
||
|
||
DefineButton 41, 50, 1, "-"
|
||
DefineButton 47, 56, 2, "+"
|
||
|
||
'Touchtaste automatsiches Invertieren
|
||
EaKitOutput Chr(27) & "TI" & Chr(1)
|
||
'Touchtaste kein Signalton
|
||
EaKitOutput Chr(27) & "TS" & Chr(0)
|
||
|
||
' Touchtasten Abfrage aktiv
|
||
EaKitOutput Chr(27) & "TA" & Chr(2)
|
||
End Sub
|
||
|
||
Public Sub PlaceText(strText As String, x As Byte, y As Byte)
|
||
EaKitOutput ESC & "ZL" & Chr(x) & Chr(y) & strText & Chr(0)
|
||
Debug.Print "#ZL " & x & "," & y & ",""" & strText & """"
|
||
End Sub
|
||
|
||
Public Sub PlaceTextRight(strText As String, x As Byte, y As Byte)
|
||
EaKitOutput ESC & "ZR" & Chr(x) & Chr(y) & strText & Chr(0)
|
||
Debug.Print "#ZR " & x & "," & y & ",""" & strText & """"
|
||
End Sub
|
||
|
||
Public Sub CenterText(strText As String, x As Byte, y As Byte)
|
||
EaKitOutput ESC & "ZZ" & Chr(x) & Chr(y) & strText & Chr(0)
|
||
Debug.Print "#ZZ " & x & "," & y & ",""" & strText & """"
|
||
End Sub
|
||
|
||
|
||
Public Sub PlaceDaempfung(intWert As Integer)
|
||
PlaceAusgabe CStr(intWert), 70, 110, 90, 120
|
||
End Sub
|
||
|
||
Public Sub Licht(Wert As Byte)
|
||
EaKitOutput ESC & "YL" & Chr(Wert)
|
||
End Sub
|
||
|
||
Public Property Get DaempfungMax() As Variant
|
||
DaempfungMax = intDaempfungMax
|
||
End Property
|
||
|
||
Public Property Let DaempfungMax(ByVal vNewValue As Variant)
|
||
intDaempfungMax = vNewValue
|
||
End Property
|
||
|
||
Public Sub init()
|
||
CallMakro 0
|
||
' sleep 1000
|
||
CallMakro 1
|
||
End Sub
|
||
|
||
Public Sub LoescheRechteck(x1 As Byte, y1 As Byte, x2 As Byte, y2 As Byte)
|
||
EaKitOutput ESC & "RL" & Chr(x1) & Chr(y1) & Chr(x2) & Chr(y2)
|
||
End Sub
|
||
|
||
Public Sub PlaceAusgabe(strText As String, x1 As Byte, y1 As Byte, x2 As Byte, y2 As Byte)
|
||
WriteToLog "sende an Display " & strText & "'"
|
||
|
||
LoescheRechteck x1, y1, x2, y2
|
||
EaKitOutput ESC & "ZL" & Chr(x1) & Chr(y1) & strText & Chr(0)
|
||
Debug.Print "An Display senden: " & strText
|
||
End Sub
|
||
|
||
Sub Tastendruck(strZeichen As String)
|
||
Dim strAdresse As String
|
||
Dim bytadresse As Byte
|
||
|
||
Dim strTaste As String
|
||
|
||
blnTaste = True
|
||
|
||
If Len(strZeichen) <> 2 Then
|
||
Debug.Print "ungültige Anzahl von Zeichen"
|
||
Exit Sub
|
||
End If
|
||
|
||
strTaste = Left(strZeichen, 1)
|
||
strAdresse = Mid(strZeichen, 2, 1)
|
||
|
||
bytadresse = Asc(strAdresse)
|
||
If bytadresse < 1 Or bytadresse > 10 Then
|
||
Debug.Print "ungültige Adresse: " & bytadresse
|
||
Exit Sub
|
||
End If
|
||
intAktivesDisplay = CInt(bytadresse)
|
||
|
||
Select Case strTaste
|
||
Case "+"
|
||
Debug.Print "+ an " & bytadresse
|
||
If intDaempfung(bytadresse) < intDaempfungMax Then
|
||
intDaempfung(bytadresse) = intDaempfung(bytadresse) + 1
|
||
End If
|
||
AktualisiereDaempfung bytadresse
|
||
RaiseEvent DaempfungChange(bytadresse, intDaempfung(bytadresse))
|
||
Case "-"
|
||
Debug.Print "- an " & bytadresse
|
||
If intDaempfung(bytadresse) > 1 Then
|
||
intDaempfung(bytadresse) = intDaempfung(bytadresse) - 1
|
||
End If
|
||
AktualisiereDaempfung bytadresse
|
||
RaiseEvent DaempfungChange(bytadresse, intDaempfung(bytadresse))
|
||
Case Else
|
||
RaiseEvent TasteGedrueckt(bytadresse, strTaste)
|
||
End Select
|
||
' alle wieder anwählen
|
||
End Sub
|
||
|
||
|
||
|
||
Sub AktualisiereDaempfung(bytadresse As Byte)
|
||
Dim Wert As Integer
|
||
Adressierung CInt(bytadresse)
|
||
Wert = intDaempfung(bytadresse)
|
||
PlaceDaempfung Wert
|
||
Adressierung 255
|
||
End Sub
|
||
|
||
Public Function getDaempfung(byteEinbauplatz As Byte) As Byte
|
||
getDaempfung = intDaempfung(byteEinbauplatz)
|
||
End Function
|
||
|
||
Public Function DeaktivateMeter()
|
||
LoescheRechteck SKALAX - 5, SKALAY + 1, SKALAX + 125, SKALAY + 10
|
||
End Function
|
||
|
||
|
||
Public Sub SetzeAlleDaempfungen(Wert As Integer)
|
||
Dim i As Integer
|
||
For i = 1 To 10
|
||
intDaempfung(i) = Wert
|
||
Next
|
||
Adressierung 255
|
||
PlaceDaempfung Wert
|
||
End Sub
|