VERSION 5.00 Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx" Begin VB.Form frmFunktionstest Caption = "Pruef2000" ClientHeight = 9180 ClientLeft = 165 ClientTop = 450 ClientWidth = 15240 KeyPreview = -1 'True LinkTopic = "Form2" ScaleHeight = 9180 ScaleWidth = 15240 StartUpPosition = 3 'Windows-Standard Begin VB.Frame FrmTab Caption = "Waage" Height = 5295 Index = 1 Left = 150 TabIndex = 1 Top = 3630 Width = 7155 Begin VB.CommandButton cmdWarteAufRuhe Caption = "Warte auf Ruhe" Height = 255 Left = 240 TabIndex = 96 Top = 1440 Width = 1335 End Begin VB.TextBox txtVolumen Height = 345 Left = 5880 TabIndex = 79 Top = 1050 Width = 915 End Begin VB.CommandButton cmdGetVolumen Caption = "GetVolumen" Height = 375 Left = 4650 TabIndex = 78 Top = 1050 Width = 1185 End Begin VB.Frame Frame2 Caption = "zuerst wählen !" Height = 1095 Left = 240 TabIndex = 63 Top = 210 Width = 2745 Begin VB.CommandButton Command4 Caption = "Waagen Parameter lesen" Height = 405 Left = 120 TabIndex = 66 Top = 630 Width = 2535 End Begin VB.TextBox txtBehVol Height = 315 Left = 1500 TabIndex = 64 Text = "1000" Top = 270 Width = 1095 End Begin VB.Label Label15 Caption = "Behälter Volumen" Height = 255 Left = 150 TabIndex = 65 Top = 300 Width = 1305 End End Begin VB.CommandButton cmdNull Caption = "Nullstellen" Height = 285 Left = 240 TabIndex = 31 Top = 1770 Width = 1335 End Begin VB.CommandButton cmdSoftTaraRest Caption = "Soft Tara Reset" Height = 285 Left = 1890 TabIndex = 30 Top = 2850 Width = 1335 End Begin VB.CommandButton cmdSofttara Caption = "Soft Tara" Height = 285 Left = 1890 TabIndex = 29 Top = 2520 Width = 1335 End Begin VB.Timer Timer2 Left = 6420 Top = 2610 End Begin VB.CheckBox Check2 Caption = "Gewicht laufend abfragen" Height = 315 Left = 420 TabIndex = 28 Top = 3210 Width = 2505 End Begin VB.CommandButton cmdCOMReset Caption = "COM Reset" Height = 345 Left = 5580 TabIndex = 27 Top = 570 Width = 1335 End Begin VB.TextBox Text1 Height = 1455 Left = 120 MultiLine = -1 'True ScrollBars = 2 'Vertikal TabIndex = 18 Top = 3600 Width = 6795 End Begin VB.CommandButton cmdTaraReset Caption = "Tara Reset" Height = 555 Left = 240 TabIndex = 15 Top = 2520 Width = 1335 End Begin VB.TextBox txtGrenzwert Height = 315 Left = 4650 TabIndex = 13 Top = 2280 Width = 1215 End Begin VB.CommandButton cmdGrenzwert Caption = "Setze Grenzwert1 für Nettovergleich" Height = 555 Left = 3840 TabIndex = 12 Top = 2940 Width = 2175 End Begin VB.CommandButton cmdWaageReset Caption = "Reset" Height = 345 Left = 5580 TabIndex = 9 Top = 150 Width = 1335 End Begin VB.TextBox txtGewicht Enabled = 0 'False Height = 315 Left = 4650 TabIndex = 7 Top = 1920 Width = 1215 End Begin VB.CommandButton cmdWaageGewicht Caption = "GetGewicht" Height = 345 Left = 4650 TabIndex = 6 Top = 1500 Width = 1185 End Begin VB.CommandButton cmdWaageTara Caption = "Tara" Height = 285 Left = 240 TabIndex = 5 Top = 2160 Width = 1335 End Begin VB.CommandButton cmdWaageAnwahl Caption = "Anwahl 2" Height = 345 Index = 2 Left = 1740 TabIndex = 4 ToolTipText = "nur für Umschaltung der Waagen an einer COM Schnittstelle" Top = 1800 Width = 1425 End Begin VB.CommandButton cmdWaageAnwahl Caption = "Anwahl 1" Height = 315 Index = 1 Left = 1740 TabIndex = 3 ToolTipText = "nur für Umschaltung der Waagen an einer COM Schnittstelle" Top = 1440 Width = 1425 End Begin VB.Label Label17 Caption = "l" Height = 345 Left = 6870 TabIndex = 80 Top = 1110 Width = 195 End Begin VB.Label Label1 Alignment = 2 'Zentriert Caption = "Waagen Test" BeginProperty Font Name = "Arial" Size = 14.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 3060 TabIndex = 2 Top = 180 Width = 2655 End Begin VB.Label Label3 Caption = "Grenzwert" Height = 315 Left = 3840 TabIndex = 14 Top = 2280 Width = 855 End Begin VB.Label Label2 Caption = "Gewicht" Height = 315 Left = 3840 TabIndex = 8 Top = 1980 Width = 795 End End Begin VB.Frame FrmTab Caption = "EA KIT 160-7 Display" Height = 5295 Index = 4 Left = 840 TabIndex = 32 Top = 3000 Width = 7155 Begin VB.CommandButton Command5 Caption = "Adress Test" Height = 555 Left = 420 TabIndex = 95 Top = 4140 Width = 1245 End Begin VB.CommandButton Command3 Caption = "Texte" Height = 555 Left = 2160 TabIndex = 59 Top = 1740 Width = 855 End Begin VB.CommandButton cmd_display_makro1 Caption = "Makro 1" Height = 555 Left = 2100 TabIndex = 58 Top = 1050 Width = 1005 End Begin VB.CommandButton Command2 Caption = "alle Licht ein" Height = 555 Left = 420 TabIndex = 51 Top = 3510 Width = 1245 End Begin VB.CommandButton Command1 Caption = "alle Licht aus" Height = 555 Left = 420 TabIndex = 50 Top = 2880 Width = 1245 End Begin VB.CheckBox Check3 Caption = "Beep alle 3 sec" Height = 345 Left = 600 TabIndex = 49 Top = 1380 Width = 2745 End Begin VB.Timer Timer3 Left = 1290 Top = 1890 End Begin VB.Frame Frame1 Caption = "Werte" Height = 4305 Left = 3690 TabIndex = 34 Top = 570 Width = 2625 Begin VB.ComboBox cmbDislpayAdr Height = 315 Left = 540 Style = 2 'Dropdown-Liste TabIndex = 93 Top = 2820 Width = 645 End Begin VB.CommandButton cmdInitFuerQtRegulierung Caption = "init Qt Regulierung" Height = 585 Left = 540 TabIndex = 92 Top = 3420 Width = 1515 End Begin VB.CommandButton cmdAdresseProgrammieren Caption = "Set Adresse" Height = 405 Left = 1380 TabIndex = 91 Top = 2760 Width = 1035 End Begin VB.TextBox txtNW Height = 285 Left = 540 TabIndex = 45 Text = "100" Top = 2100 Width = 405 End Begin VB.TextBox txtTyp Height = 315 Left = 540 TabIndex = 44 Text = "WPD" Top = 1740 Width = 735 End Begin VB.TextBox txtEbP Height = 315 Left = 540 TabIndex = 42 Text = "10" Top = 1380 Width = 375 End Begin VB.TextBox txtSnr Height = 345 Left = 540 TabIndex = 40 Text = "123456789" Top = 990 Width = 975 End Begin VB.TextBox txtDaempfung Height = 285 Left = 540 TabIndex = 37 Text = "4" Top = 210 Width = 645 End Begin VB.TextBox txtFehler Height = 315 Left = 540 TabIndex = 36 Text = "0" Top = 630 Width = 645 End Begin VB.CommandButton cmdDisplay_update Caption = "Update" Height = 375 Left = 1350 TabIndex = 35 Top = 2280 Width = 1005 End Begin VB.Label Label14 Caption = "Adr" Height = 315 Left = 120 TabIndex = 94 Top = 2880 Width = 315 End Begin VB.Label Label13 BorderStyle = 1 'Fest Einfach Height = 255 Left = 540 TabIndex = 48 Top = 2430 Width = 435 End Begin VB.Label Label12 Alignment = 1 'Rechts Caption = "NW" Height = 285 Left = 180 TabIndex = 47 Top = 2130 Width = 285 End Begin VB.Label Label11 Alignment = 1 'Rechts Caption = "Typ" Height = 285 Left = 150 TabIndex = 46 Top = 1770 Width = 285 End Begin VB.Label Label10 Alignment = 1 'Rechts Caption = "EbP" Height = 285 Left = 120 TabIndex = 43 Top = 1440 Width = 315 End Begin VB.Label Label9 Alignment = 1 'Rechts Caption = "SNr" Height = 285 Left = 150 TabIndex = 41 Top = 1050 Width = 255 End Begin VB.Label Label8 Alignment = 1 'Rechts Caption = "F" Height = 285 Left = 150 TabIndex = 39 Top = 690 Width = 255 End Begin VB.Label Label7 Alignment = 1 'Rechts Caption = "D" Height = 285 Left = 180 TabIndex = 38 Top = 270 Width = 255 End End Begin VB.CommandButton cmdDisplay_init Caption = "Makro 0 Alle Initialisieren" Height = 555 Left = 120 TabIndex = 33 Top = 360 Width = 2325 End End Begin VB.Frame FrmTab Caption = "Wetterstation / Labjack" Height = 4935 Index = 0 Left = 6870 TabIndex = 75 Top = 3960 Width = 7095 Begin VB.CommandButton cmdInstallLabjack Caption = "labjackWrapper.dll installieren" Height = 855 Left = 5250 TabIndex = 90 Top = 330 Width = 1635 End Begin VB.Timer Timer4 Left = 6450 Top = 2520 End Begin VB.CheckBox chkContLabjack Caption = "kontinuierlich" Enabled = 0 'False Height = 255 Left = 5730 TabIndex = 89 Top = 3420 Width = 1305 End Begin VB.CommandButton cmdLabjack Caption = "Abfrage" Height = 435 Left = 5730 TabIndex = 83 Top = 3750 Width = 1245 End Begin VB.TextBox txtAusgabe Height = 1035 Left = 120 MultiLine = -1 'True TabIndex = 77 Top = 930 Width = 2445 End Begin VB.CommandButton cmdGetWeather Caption = "Abfrage" Height = 435 Left = 2730 TabIndex = 76 Top = 930 Width = 975 End Begin VB.Label Label22 Caption = "Bar" BeginProperty Font Name = "Arial" Size = 36 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 825 Left = 4440 TabIndex = 88 Top = 3330 Width = 1245 End Begin VB.Label lblDruck Alignment = 1 'Rechts BorderStyle = 1 'Fest Einfach Caption = "0,123" BeginProperty Font Name = "Courier New" Size = 60 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 1515 Left = 150 TabIndex = 87 Top = 3060 Width = 4215 End Begin VB.Label lblFaktor BorderStyle = 1 'Fest Einfach Height = 345 Left = 1890 TabIndex = 86 Top = 2640 Width = 795 End Begin VB.Label Label20 Caption = "V * " Height = 255 Left = 1530 TabIndex = 85 Top = 2700 Width = 345 End Begin VB.Label lblLabjack1 BorderStyle = 1 'Fest Einfach Height = 345 Left = 150 TabIndex = 84 Top = 2640 Width = 1335 End Begin VB.Label Label19 Caption = "Labjack / Drucksensor" Height = 345 Left = 150 TabIndex = 82 Top = 2370 Width = 2835 End Begin VB.Label Label18 Caption = "Wetterstation:" Height = 225 Left = 180 TabIndex = 81 Top = 660 Width = 1725 End End Begin VB.Frame FrmTab Caption = "Bestellcode" Enabled = 0 'False Height = 4935 Index = 8 Left = 8910 TabIndex = 72 Top = 3450 Width = 7095 Begin VB.CommandButton cmdBestellcodeStart Caption = "OK" Height = 315 Left = 4710 TabIndex = 73 Top = 600 Width = 1425 End Begin VB.Label lblFortschritt Caption = "Label17" Height = 345 Left = 1230 TabIndex = 74 Top = 2010 Width = 1575 End End Begin VB.Frame FrmTab Caption = "FM85" Height = 4935 Index = 7 Left = 240 TabIndex = 67 Top = 330 Width = 7095 Begin VB.TextBox txtFM85Fehlerbytes Height = 3615 Left = 540 MultiLine = -1 'True ScrollBars = 2 'Vertikal TabIndex = 71 Text = "frmFunktionstest.frx":0000 Top = 1080 Width = 6315 End Begin VB.TextBox txtFm85Adresse Alignment = 1 'Rechts Height = 315 Left = 3540 TabIndex = 69 Text = "1" Top = 480 Width = 375 End Begin VB.CommandButton cmdFehlerbytes Caption = "Fehlerbytes auslesen" Height = 435 Left = 540 TabIndex = 68 Top = 420 Width = 1695 End Begin VB.Label Label16 Alignment = 1 'Rechts Caption = "Adresse" Height = 255 Left = 2700 TabIndex = 70 Top = 540 Width = 795 End End Begin VB.Frame FrmTab Caption = "Turbo2e" Height = 4935 Index = 6 Left = 9450 TabIndex = 60 Top = 2550 Width = 7095 Begin VB.CommandButton cmdStartTurboScan Caption = "Search For Turbo" Height = 375 Left = 1440 TabIndex = 62 Top = 4440 Width = 2235 End Begin VB.ListBox lstOut Height = 3960 Left = 420 TabIndex = 61 Top = 360 Width = 6435 End End Begin VB.Frame FrmTab Caption = "ProTool / SPS" Height = 5655 Index = 2 Left = 6180 TabIndex = 10 Top = 2100 Width = 7605 Begin VB.Timer Timer1 Left = 6060 Top = 660 End Begin VB.CheckBox Check1 Caption = "Kontinuierlich" Height = 435 Left = 2040 TabIndex = 26 Top = 1560 Width = 1275 End Begin VB.ComboBox Combo2 Height = 315 Left = 240 TabIndex = 24 Top = 2520 Width = 1635 End Begin VB.ComboBox Combo1 Height = 315 Left = 240 TabIndex = 23 Top = 1200 Width = 1635 End Begin VB.CommandButton cmdSchreiben Caption = "Variablen Wert setzen" Height = 315 Left = 1980 TabIndex = 22 Top = 2520 Width = 1815 End Begin VB.TextBox txtSetWert BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 3960 TabIndex = 21 Top = 2520 Width = 1275 End Begin VB.CommandButton cmdProToolLesen Caption = "Variablen Wert lesen" Height = 315 Left = 2040 TabIndex = 20 Top = 1200 Width = 1815 End Begin VB.Label Label6 BorderStyle = 1 'Fest Einfach Caption = "Label6" BeginProperty Font Name = "Arial" Size = 90 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 1965 Left = 180 TabIndex = 57 Top = 3210 Width = 7275 End Begin VB.Label lblLeseWert Alignment = 1 'Rechts BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 3960 TabIndex = 25 Top = 1200 Width = 1275 End Begin VB.Label Label4 Alignment = 2 'Zentriert Caption = "SPS ProTool Test" BeginProperty Font Name = "Arial" Size = 14.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 600 TabIndex = 11 Top = 450 Width = 6855 End End Begin VB.Frame FrmTab Caption = "INI Daten" Height = 5295 Index = 3 Left = 9180 TabIndex = 16 Top = 3510 Width = 7155 Begin VB.TextBox text2 Height = 4455 Left = 120 MultiLine = -1 'True ScrollBars = 2 'Vertikal TabIndex = 19 Top = 720 Width = 6795 End Begin VB.Label Label5 Alignment = 2 'Zentriert Caption = "INI Daten" BeginProperty Font Name = "Arial" Size = 14.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 120 TabIndex = 17 Top = 240 Width = 6855 End End Begin VB.Frame FrmTab Caption = "Füllstandsensor" Height = 4035 Index = 5 Left = 4500 TabIndex = 52 Top = 1860 Width = 6195 Begin VB.TextBox txtFuellstand Height = 2295 Left = 240 MultiLine = -1 'True TabIndex = 56 Top = 1440 Width = 3855 End Begin VB.Timer TimerFuellstand Enabled = 0 'False Left = 2160 Top = 360 End Begin VB.CommandButton cmdFuellstand BackColor = &H000000C0& Caption = "START" Height = 465 Left = 300 MaskColor = &H8000000F& TabIndex = 54 Top = 360 Width = 1515 End Begin VB.ComboBox cmbBehaelter Height = 315 Left = 300 Style = 2 'Dropdown-Liste TabIndex = 53 Top = 930 Width = 1395 End Begin VB.Label lblFuellstand Alignment = 1 'Rechts BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "MS Sans Serif" Size = 13.5 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 345 Left = 1800 TabIndex = 55 Top = 900 Width = 2355 End End Begin MSComctlLib.TabStrip TabStrip1 Height = 5835 Left = 180 TabIndex = 0 Top = 60 Width = 10485 _ExtentX = 18494 _ExtentY = 10292 _Version = 393216 BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628} NumTabs = 1 BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628} ImageVarType = 2 EndProperty EndProperty End End Attribute VB_Name = "frmFunktionstest" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Private m_oWaage As CWaage Private m_SPS As CSPS Private m_angewaehlteWaage As Integer Private WithEvents m_Display As CEAKIT Attribute m_Display.VB_VarHelpID = -1 Private m_Startzeit As Long Private fso As scripting.FileSystemObject Private objTextstream As TextStream Private m_Pumpe As CPumpe Private m_ColPumpen As Collection Private m_ColRefZaehler As Collection ' ################################################################################### Private Sub PrintTo(Control As TextBox, Msg As String) Debug.Print Msg Control.text = Control.text & Msg & vbCrLf Control.SelStart = Len(Control.text) End Sub Private Sub Check1_Click() If Check1.Value = 1 Then Timer1.Enabled = True Timer1.Interval = 100 Else Timer1.Enabled = False End If End Sub Private Sub Check2_Click() On Error Resume Next If Check2.Value = 1 Then Timer2.Enabled = True Timer2.Interval = 100 Text2.text = "Waagenabfrage gestartet" & vbCrLf If objTextstream Is Nothing Then If MsgBox("Loggen in Textfile C:\gewicht.txt ?", vbYesNo Or vbDefaultButton2) = vbYes Then Set fso = New scripting.FileSystemObject Set objTextstream = fso.CreateTextFile("C:\gewicht.txt") m_Startzeit = GetTickCount() End If End If Else Timer2.Enabled = False Text2.text = Text2.text & "Waagenabfrage gestoppt" & vbCrLf objTextstream.Close Set objTextstream = Nothing End If End Sub Private Sub Check3_Click() If Check3.Value = vbChecked Then Timer3.Enabled = True Timer3.Interval = 3000 Else Timer3.Enabled = False Timer3.Interval = 3000 End If End Sub Private Sub chkContLabjack_Click() If chkContLabjack.Value = vbChecked Then Timer4.Interval = 1000 Timer4.Enabled = True Else Timer4.Enabled = False End If End Sub Private Sub cmd_display_makro1_Click() m_Display.Adressierung 255 m_Display.CallMakro 1 End Sub Private Sub cmdAdresseProgrammieren_Click() m_Display.AdresseZuweisen Val(cmbDislpayAdr.text) End Sub Private Sub cmdCOMReset_Click() On Error Resume Next Screen.MousePointer = vbHourglass frmSerial.commWaage.PortOpen = False Sleep 1000 frmSerial.commWaage.PortOpen = True Screen.MousePointer = vbNormal End Sub Private Sub cmdDisplay_init_Click() Dim i As Integer m_Display.Adressierung 255 m_Display.CallMakro 0 'm_Display.Adressierung 255 'For i = 1 To 10 ' m_Display.Adressierung i ' m_Display.Licht 10 ' 'm_Display.beep 2 ' Next ' Sleep 1000 ' ' m_Display.Adressierung 255 ' m_Display.init ' Sleep 1000 ' For i = 1 To 10 ' m_Display.Adressierung i ' Sleep 100 ' m_Display.PlaceEinbauplatz CStr(i) ' Sleep 100 ' Next ' m_Display.Adressierung 255 End Sub Private Sub cmdDisplay_update_Click() Dim adr As Integer If cmbDislpayAdr.text = "alle" Then adr = 255 Else If IsNumeric(cmbDislpayAdr.text) Then adr = CInt(cmbDislpayAdr.text) m_Display.Adressierung adr End If End If m_Display.PlaceDaempfung CInt(txtDaempfung.text) m_Display.SetMeter CDbl(txtFehler.text) m_Display.PlaceEinbauplatz txtEbP.text m_Display.PlaceSeriennr txtSnr.text End Sub Private Sub cmdInitFuerQtRegulierung_Click() m_Display.SelectEAKit Val(cmbDislpayAdr.text) m_Display.ClrScreen m_Display.PlaceAusgabe "SerNr: 123456789", 10, 20, 140, 29 m_Display.PlaceAusgabe "T: 60", 10, 30, 140, 35 m_Display.DefineButton 41, 50, 3, "Start" End Sub Private Sub cmdWarteAufRuhe_Click() m_oWaage.WarteAufRuhe End Sub Private Sub Command5_Click() Dim intNr As Integer For intNr = 1 To 10 m_Display.Adressierung intNr m_Display.beep 2 m_Display.ClrScreen m_Display.PlaceAusgabe "Adresse " & CStr(intNr), 10, 10, 100, 100 Next End Sub Private Sub m_Display_TasteGedrueckt(ByVal bytadresse As Byte, ByVal strTaste As String) m_Display.DefineButton 41, 50, 3, "..." End Sub Private Sub cmdFuellstand_Click() If TimerFuellstand.Enabled = False Then TimerFuellstand.Enabled = True TimerFuellstand.Interval = 1000 cmdFuellstand.Caption = "STOP" m_Startzeit = GetTickCount() Else cmdFuellstand.Caption = "START" TimerFuellstand.Enabled = False End If End Sub Private Sub cmdGetWeather_Click() Dim dblLT As Double Dim dblRF As Double Dim dblLD As Double Dim strFehler As String txtAusgabe.text = "" If GetWeatherData(dblLT, dblRF, dblLD, strFehler) = True Then txtAusgabe.text = txtAusgabe.text & "LT=" & dblLT & " °C " & vbCrLf txtAusgabe.text = txtAusgabe.text & "RF=" & dblRF & " % " & vbCrLf txtAusgabe.text = txtAusgabe.text & "LD=" & dblLD & " hPa " & vbCrLf Else txtAusgabe.text = strFehler End If End Sub Private Sub cmdInstallLabjack_Click() If Not IsLabjackWrapperInstalled() Then ' Installieren! If CopyToWinsysDirAndRegisterDll("\\La--01\Auftrag\Pruefstation 2000 EXE", "LabjackWrapper.dll") Then MsgBox "Labjackwrapper.dll wurde installiert!" Else MsgBox "LabjackWrapper dll konnte nicht installiert werden." End If Else MsgBox "Labjackwrapper.dll ist bereits installiert" End If g_App.Settings.GetOrSetIniWert "Labjack", "Wasserdruck_ID", "0" g_App.Settings.GetOrSetIniWert "Labjack", "Wasserdruck_Channel", "0" g_App.Settings.GetOrSetIniWert "Labjack", "Wasserdruck_Faktor", "0.6" End Sub Private Sub Timer4_Timer() cmdLabjack_Click End Sub Private Sub cmdLabjack_Click() Dim LabjackID As Integer Dim LabjackChannel As Integer Dim dblFaktor As Double Dim lngReturn As Long Dim sngWert As Single Dim objLabjack As Object If IsLabjackWrapperInstalled() Then If g_App.Settings.GetWasserdruckLabjackSettings(LabjackID, LabjackChannel, dblFaktor) = True Then lblFaktor.Caption = dblFaktor Set objLabjack = CreateObject("LabjackWrapper.MainClass") lngReturn = objLabjack.GetAnalogwert(LabjackID, LabjackChannel, sngWert) If lngReturn = 0 Then lblLabjack1.Caption = Round(sngWert, 3) lblDruck.Caption = Round(CDbl(sngWert) * dblFaktor, 3) chkContLabjack.Enabled = True Else chkContLabjack.Value = vbUnchecked chkContLabjack_Click End If Else chkContLabjack.Value = vbUnchecked chkContLabjack_Click MsgBox "Bitte LabjackID, LabjackChannel, dblFaktor in ini pflegen!" End If Else chkContLabjack.Value = vbUnchecked chkContLabjack_Click MsgBox "Labjackwrapper DLL ist nicht instaliert" End If End Sub Private Sub cmdNull_Click() If m_oWaage.Nullstellen = True Then MsgBox "OK" Else MsgBox "Fehler" End If End Sub Private Sub cmdProToolLesen_Click() On Error GoTo Errorhandler Screen.MousePointer = vbHourglass lblLeseWert = m_SPS.ProToolObj.VarLesen(Combo1.text) Label6.Caption = lblLeseWert.Caption If lblLeseWert.Caption = "" Or lblLeseWert.Caption = "FALSCH" Then Call StopKontinuierlicheAbfrage End If Screen.MousePointer = vbNormal lblLeseWert.BackColor = vbWhite Exit Sub Errorhandler: lblLeseWert.BackColor = vbRed Screen.MousePointer = vbNormal End Sub Private Sub StopKontinuierlicheAbfrage() Check1.Value = 0 Call Check1_Click End Sub Private Sub cmdSchreiben_Click() Screen.MousePointer = vbHourglass If m_SPS.ProToolObj.VarSchreiben(Combo2.text, txtSetWert) Then End If Screen.MousePointer = vbNormal End Sub Private Sub cmdSofttara_Click() m_oWaage.SoftTara End Sub Private Sub cmdSoftTaraRest_Click() m_oWaage.SoftTaraReset End Sub Private Sub cmdStartTurboScan_Click() Dim i As Integer Dim j As Integer Dim comport As Integer Dim EinbauplatzNr As Integer Dim lngSuccess As Long Dim strAusgabe As String Dim strTemp As String Dim objSensusInterface As SensusIF2.Interface lstOut.Clear For i = 1 To 22 For j = 1 To 22 comport = Val(g_App.Settings.getUSComPort(j)) If comport = i Then EinbauplatzNr = j Exit For Else EinbauplatzNr = 0 End If Next Set objSensusInterface = New SensusIF2.Interface objSensusInterface.CommPortNr = i objSensusInterface.DebugWindowsIsVisible = False lngSuccess = objSensusInterface.PortInit If lngSuccess <> 1 Then strAusgabe = "FEHLER init " & objSensusInterface.GetErrorMessage(lngSuccess) Else 'objSensusInterface.DebugWindowsIsVisible = True lngSuccess = objSensusInterface.GetVersion(strTemp) If lngSuccess <> 1 Then strAusgabe = "FEHLER GetVersion " & objSensusInterface.GetErrorMessage(lngSuccess) Else strAusgabe = "OK: " & strTemp End If End If If EinbauplatzNr <> 0 Then strAusgabe = "(Einbauplatz " & EinbauplatzNr & ") " & strAusgabe End If lstOut.AddItem "COM " & i & ": " & strAusgabe Set objSensusInterface = Nothing Next End Sub ' ############################ Waage ####################################################### Private Sub cmdTaraReset_Click() Screen.MousePointer = vbHourglass If m_oWaage.TaraReset Then PrintTo Text1, "Tara Reset OK" Else PrintTo Text1, "Tara Reset Fehler" End If Screen.MousePointer = vbNormal End Sub Private Sub cmdWaageAnwahl_Click(Index As Integer) Screen.MousePointer = vbHourglass m_angewaehlteWaage = Index If m_oWaage.Anwahl(Index) Then PrintTo Text1, "Anwahl Waage OK" & Index Else PrintTo Text1, "Anwahl Waage" & Index & " Fehler" End If Screen.MousePointer = vbNormal End Sub Private Sub cmdGetVolumen_Click() Dim Gewicht As Double Dim Temperatur As Double txtVolumen.text = "" Screen.MousePointer = vbHourglass DoEvents Gewicht = m_oWaage.GetGewicht If Gewicht = -1 Then txtVolumen = "Fehler" PrintTo txtVolumen, "Lese Gewicht Fehler" Else Temperatur = m_SPS.GetEinlaufTemperatur() txtVolumen.text = Round(1000 * Volumen(CDbl(Gewicht), Temperatur), 3) & " l" End If Screen.MousePointer = vbNormal End Sub Private Sub cmdWaageGewicht_Click() Dim Gewicht As Double Screen.MousePointer = vbHourglass Gewicht = m_oWaage.GetGewicht If Gewicht = -1 Then txtGewicht = "Fehler" PrintTo Text1, "Lese Gewicht Fehler" Else txtGewicht = CDbl(Gewicht) End If Screen.MousePointer = vbNormal End Sub Private Sub cmdWaageReset_Click() Screen.MousePointer = vbHourglass If m_oWaage.Reset Then PrintTo Text1, "Waage Reset OK" Else PrintTo Text1, "Waage Reset Fehler" End If Screen.MousePointer = vbNormal End Sub Private Sub cmdWaageTara_Click() If m_oWaage.Tara Then PrintTo Text1, "Tara OK" Else PrintTo Text1, "Tara Fehler" End If End Sub Private Sub cmdGrenzwert_Click() Dim sFormat As String Screen.MousePointer = vbHourglass If m_angewaehlteWaage = 2 Then sFormat = "0.0" Else sFormat = "0.00" End If If IsNumeric(txtGrenzwert.text) Then If m_oWaage.SetNettoGrenzwert1(CDbl(txtGrenzwert.text), sFormat) Then PrintTo Text1, "Grenzwert setzen OK" Else PrintTo Text1, "Grenztwert setzen Fehler" End If End If Screen.MousePointer = vbNormal End Sub Private Sub Combo1_Change() StopKontinuierlicheAbfrage End Sub Private Sub Command1_Click() m_Display.Adressierung 255 m_Display.Licht 0 End Sub Private Sub Command2_Click() m_Display.Adressierung 255 m_Display.Licht 1 End Sub Private Sub Command3_Click() Dim i As Integer For i = 1 To 10 Sleep 500 m_Display.Adressierung i Sleep 1000 m_Display.CallMakro 1 Sleep 1000 DoEvents m_Display.Licht 1 Sleep 100 m_Display.PlaceEinbauplatz CStr(i) m_Display.PlaceSeriennr "123456789" m_Display.PlaceTyp "WZD" m_Display.PlaceNW "100" m_Display.PlaceDaempfung 9 m_Display.PlaceKeineWdh 'm_Display.PlacePuls Next End Sub Private Sub Command4_Click() Dim Behaelter As CBehaelter Set Behaelter = New CBehaelter If Not Behaelter.LoadForVolumen(CDbl(txtBehVol.text)) Then MsgBox "kein Behälter für dieses Volumen in ini definiert" End If g_App.getWaage.Initialize (Behaelter.m_Nr) g_App.getWaage.Anwahl Behaelter.m_WaageAnwahl End Sub Private Sub Form_KeyPress(KeyAscii As Integer) If KeyAscii = 27 Then ' Stoppe Kontinuierliches Lesen wenn EXC Taste gedrückt Call StopKontinuierlicheAbfrage End If End Sub Private Sub Form_Load() Dim frame As frame TabStrip1.Tabs.Clear On Error Resume Next For Each frame In FrmTab TabStrip1.Tabs.Add , , frame.Caption frame.Caption = "" frame.Top = TabStrip1.ClientTop frame.Left = TabStrip1.ClientLeft frame.Height = TabStrip1.ClientHeight frame.Width = TabStrip1.ClientWidth frame.BorderStyle = 1 Next Combo1.AddItem "PT_T_Luft" Combo1.AddItem "PT_RH_Luft" Combo1.AddItem "PT_QIst" Combo1.AddItem "PT_Strecke1" Combo1.AddItem "PT_P1Status" Combo1.AddItem "PT_P2Status" Combo1.AddItem "PT_P3Status" Combo1.AddItem "PT_BetrArt" Combo1.AddItem "PT_T_Einlauf" Combo1.AddItem "PT_Regler" Combo1.AddItem "PT_PrfStatus" Combo1.AddItem "PT_Waage" Combo1.AddItem "PT_FU_Ist" Combo1.AddItem "PT_M1_Ist" Combo1.AddItem "PT_M2_Ist" Combo1.AddItem "PT_M3_Ist" Combo1.AddItem "PT_M4_Ist" Combo1.text = "PT_QIst" Combo1.AddItem "VB_Lwl" Combo1.AddItem "VB_Betrieb" Combo1.AddItem "VB_MidGr" Combo1.AddItem "VB_MidNr" Combo1.AddItem "VB_Ablass" Combo1.AddItem "VB_Behaelter" Combo1.AddItem "VB_Pumpe1" Combo1.AddItem "VB_Pumpe2" Combo1.AddItem "VB_Pumpe3" Combo1.AddItem "VB_Pumpe5" Combo1.AddItem "VB_QSoll" Combo1.AddItem "VB_Einsatz" Combo1.AddItem "VB_ReguMotor" Combo1.AddItem "VB_Regu" Combo1.AddItem "VB_RegelArt" Combo1.AddItem "VB_ServoSt" Combo1.AddItem "VB_Ende" Combo1.AddItem "VB_QDiff" Combo1.AddItem "VB_Regu" Combo2.AddItem "VB_Ablass" Combo2.AddItem "VB_Behaelter" Combo2.AddItem "VB_Betrieb" Combo2.AddItem "VB_Einsatz" Combo2.AddItem "VB_Ende" Combo2.AddItem "VB_Lwl" Combo2.AddItem "VB_MidGr" Combo2.AddItem "VB_MidNr" Combo2.AddItem "VB_Pumpe1" Combo2.AddItem "VB_Pumpe2" Combo2.AddItem "VB_Pumpe3" Combo2.AddItem "VB_Pumpe5" Combo2.AddItem "VB_Pumpe_test" Combo2.AddItem "VB_QDiff" Combo2.AddItem "VB_QSoll" Combo2.AddItem "VB_RegelArt" Combo2.AddItem "VB_Regu" Combo2.AddItem "VB_ReguMotor" Combo2.AddItem "VB_ServoSt" cmbDislpayAdr.AddItem "alle" cmbDislpayAdr.AddItem 1 cmbDislpayAdr.AddItem 2 cmbDislpayAdr.AddItem 3 cmbDislpayAdr.AddItem 4 cmbDislpayAdr.AddItem 5 cmbDislpayAdr.AddItem 6 cmbDislpayAdr.AddItem 7 cmbDislpayAdr.AddItem 8 cmbDislpayAdr.AddItem 9 cmbDislpayAdr.AddItem 10 cmbBehaelter.AddItem 1 cmbBehaelter.AddItem 2 cmbBehaelter.ListIndex = 1 'Me.Width = TabStrip1.Width + TabStrip1.Left 'Me.Height = TabStrip1.Height + TabStrip1.Top TabStrip1.Tabs.Item(1).Selected = True Call TabStrip1_Click Set m_oWaage = g_App.getWaage Call GetINIData Set m_SPS = g_App.getSPS Set m_Display = g_App.GetDisplay End Sub Private Sub Form_Unload(Cancel As Integer) Timer1.Enabled = False Timer2.Enabled = False Timer3.Enabled = False TimerFuellstand.Enabled = False End Sub Private Sub m_Display_DaempfungChange(ByVal bytadresse As Byte, ByVal intDaempfung As Integer) Debug.Print "Adresse " & bytadresse & ", D=" & intDaempfung End Sub Private Sub TabStrip1_Click() Dim selectedTab As Integer selectedTab = TabStrip1.SelectedItem.Index FrmTab.Item(selectedTab).ZOrder 0 End Sub ' ################################## Ini Daten ####################################### Private Sub GetINIData() Dim m_oBehaelter As CBehaelter Dim dblVolumen As Double Dim byteAblassAnwahlAlleBeahelter As Byte Dim i As Integer PrintTo Text2, "-------------------------------------" For i = 1 To g_App.getAnzahlBehaelter Set m_oBehaelter = New CBehaelter If m_oBehaelter.LoadFromIni(i) Then dblVolumen = m_oBehaelter.m_OVolumen If dblVolumen > 0 Then PrintTo Text2, dblVolumen & " Liter :" If m_oBehaelter.LoadForVolumen(dblVolumen) Then PrintTo Text2, " Behälter Nr: " & i & " mit " & dblVolumen & " Liter" Select Case m_oBehaelter.m_Waagenart Case WAAGENART_BIZERBA PrintTo Text2, "Waagenart: BIZERBA" Case WAAGENART_METTLER PrintTo Text2, "Waagenart: METTLER" Case WAAGENART_METTLER_2 PrintTo Text2, "Waagenart: METTLER_2" Case WAAGENART_FUELLSTAND PrintTo Text2, "Waagenart: FUELLSTAND" Case Else PrintTo Text2, "Waagenart unbekannt" End Select byteAblassAnwahlAlleBeahelter = byteAblassAnwahlAlleBeahelter Or m_oBehaelter.m_AblassAnwahl PrintTo Text2, " Ablasse Anwahl=" & m_oBehaelter.m_AblassAnwahl PrintTo Text2, " Anwahl=" & m_oBehaelter.m_BehaelterAnwahl PrintTo Text2, " UeberlaufFaktor=" & m_oBehaelter.m_nUeberlaufFaktor PrintTo Text2, " O Volumen=" & m_oBehaelter.m_OVolumen PrintTo Text2, " U Volumen=" & m_oBehaelter.m_UVolumen PrintTo Text2, " RuheGrenzwert=" & m_oBehaelter.m_RuheGrenzwert PrintTo Text2, " RuheWdh=" & m_oBehaelter.m_RuheWdh PrintTo Text2, " WaageAnwahl=" & m_oBehaelter.m_WaageAnwahl PrintTo Text2, "-------------------------------------" End If End If End If Next PrintTo Text2, " Ablasse Anwahl Alle Behälter =" & byteAblassAnwahlAlleBeahelter Dim ColPumpen As Collection Dim Pumpe As CPumpe Set ColPumpen = g_App.Settings.getPumpen For Each Pumpe In ColPumpen PrintTo Text2, "Pumpe " & Pumpe.getNr & ": Qmin=" & Pumpe.GetDurchflussUnten & ": Nw=" & Pumpe.getNennweite & " Qmax=" & Pumpe.GetDurchflussOben & ", SPS-Varname='" & Pumpe.GetSPSVarname & "'" Next End Sub Private Sub Timer1_Timer() Call cmdProToolLesen_Click End Sub Private Sub Timer2_Timer() Dim strAntwort As String On Error Resume Next frmSerial.commWaage.PortOpen = True Screen.MousePointer = vbHourglass ' m_oWaage.send "q%" ' strAntwort = m_oWaage.receive(WAAGE_DEFAULT_TIMEOUT) strAntwort = m_oWaage.GetGewicht PrintTo Text1, "Antwort: " & strAntwort If Not objTextstream Is Nothing Then objTextstream.WriteLine GetTickCount - m_Startzeit & vbTab & strAntwort End If frmSerial.commWaage.PortOpen = False Screen.MousePointer = vbNormal End Sub Private Sub Timer3_Timer() m_Display.Adressierung 255 m_Display.CallMakro 0 m_Display.CallMakro 1 m_Display.Adressierung 1 m_Display.beep 2 m_Display.EaKitOutput Chr(27) & "S" & Chr(10) & "1234567890" m_Display.Adressierung 1 m_Display.beep 2 m_Display.EaKitOutput Chr(27) & "S" & Chr(10) & "1234567890" End Sub Private Sub TimerFuellstand_Timer() Dim dblFuellstand As Double Dim lngTime As Long dblFuellstand = Format(m_SPS.GetFuellstand(CInt(cmbBehaelter.text)), "0.000") lblFuellstand.Caption = dblFuellstand lngTime = (GetTickCount - m_Startzeit) / 1000 PrintFuellstand lngTime & vbTab & dblFuellstand End Sub Private Sub PrintFuellstand(sText As String) txtFuellstand.text = txtFuellstand.text & sText & vbCrLf txtFuellstand.SelStart = Len(txtFuellstand.text) Debug.Print sText End Sub Private Sub cmdFehlerbytes_Click() Dim fm85bus As CFMBus Dim i As Integer Dim strAntwort As String Dim varAdresse As Variant Set fm85bus = g_App.getFMBus() txtFM85Fehlerbytes.text = "" For i = 1 To g_App.Settings.EinbauplaetzeJeStrang fm85bus.send "**" & Hex(i) & "@" strAntwort = fm85bus.receive(500) AusgabeTxtFM85 "FM85P nr " & i & " antwortet '" & strAntwort & "'" For Each varAdresse In Split("40 41 42 43", " ") fm85bus.send CStr(varAdresse) & " " strAntwort = fm85bus.receive(500) If Mid(strAntwort, 6, 2) <> "" Then AusgabeTxtFM85 CStr(varAdresse) & "->" & strAntwort & vbCrLf & FM85FehlerbyteMeldung(Mid(strAntwort, 6, 2), CStr(varAdresse)) Else AusgabeTxtFM85 CStr(varAdresse) & "->" & "unerwartete Antwort: '" & strAntwort & "'" End If Next Next End Sub Sub AusgabeTxtFM85(strText As String) txtFM85Fehlerbytes.text = txtFM85Fehlerbytes.text & strText & vbCrLf txtFM85Fehlerbytes.SelStart = Len(txtFM85Fehlerbytes.text) txtFM85Fehlerbytes.SelLength = 1 End Sub ''''''''''''''''''''''''''''' Private Sub cmdBestellcodeStart_Click() Dim rsAP As CRecordset Dim rsMW As CRecordset Dim Bestellcode As CBestellcode Dim strZeile As String Dim strText As String Dim lngZeile As Long Set rsMW = New CRecordset Set rsAP = New CRecordset rsMW.openRS "SELECT DISTINCT Merkmalsname From Bestellcode_Merkmalswerte", True rsAP.openRS "SELECT AuftragPosition.*, Identnr.Bestellgruppe FROM AuftragPosition INNER JOIN Identnr ON AuftragPosition.IdentNr = Identnr.IdentNr where Bestellgruppe > 0 and AuftragPosition.Bestellcode is not null and AuftragPosition.Bestellcode <> '' ", True strText = "" rsMW.MoveFirst strZeile = "" strZeile = strZeile & "AuftragNr" & vbTab strZeile = strZeile & "PositionNr" & vbTab strZeile = strZeile & "IdentNr" & vbTab strZeile = strZeile & "SerienNrVon" & vbTab strZeile = strZeile & "SerienNrBis" & vbTab strZeile = strZeile & "Bestellgruppe" & vbTab strZeile = strZeile & "Bestellcode" & vbTab Do While Not rsMW.EOF strZeile = strZeile & rsMW.getStringValue("Merkmalsname") & vbTab rsMW.MoveNext Loop Debug.Print strZeile strText = strText & strZeile & vbCrLf Do While Not rsAP.EOF lngZeile = lngZeile + 1 strZeile = "" strZeile = strZeile & rsAP.getLongValue("AuftragNr") & vbTab strZeile = strZeile & rsAP.getLongValue("PositionNr") & vbTab strZeile = strZeile & rsAP.getLongValue("IdentNr") & vbTab strZeile = strZeile & rsAP.getLongValue("SerienNrVon") & vbTab strZeile = strZeile & rsAP.getLongValue("SerienNrBis") & vbTab strZeile = strZeile & rsAP.getLongValue("Bestellgruppe") & vbTab strZeile = strZeile & rsAP.getStringValue("Bestellcode") & vbTab Dim i As Long For i = 0 To rsAP.FieldsCount - 1 Debug.Print rsAP.FieldName(i) & "=" & rsAP.GetVariantValue(rsAP.FieldName(i)) Next Set Bestellcode = New CBestellcode If Bestellcode.load(rsAP.getStringValue("Bestellcode"), rsAP.getLongValue("Bestellgruppe")) Then End If rsMW.MoveFirst Do While Not rsMW.EOF strZeile = strZeile & Bestellcode.GetWert(rsMW.getStringValue("Merkmalsname")) & vbTab rsMW.MoveNext Loop Debug.Print strZeile strText = strText & strZeile & vbCrLf lblFortschritt.Caption = lngZeile & "/" & rsAP.RecordCount rsAP.MoveNext DoEvents Loop Clipboard.SetText strText End Sub