Public TheEvent As Integer
Public TimerAus As Boolean

Public SerialInterface As Boolean
Public FreigabeErteilt As Boolean


Private Sub BAbwertenAlt_Click()


Dim wert1 As Variant
Dim Wert As Double
Dim aktLieferscheinnummer
Dim db1 As Database

Dim rs1 As Recordset
Dim rs2 As Recordset

aktLieferscheinnummer = TLieferscheinnummer

wert1 = InputBox("Welchen Gewichtsanteil dieser Lieferung wollen Sie abwerten ?")

If Not IsNull(wert1) And wert1 > 0 Then
 
 Wert = wert1
 If Wert >= TGewicht Then
  MsgBox ("Gesamte Lieferung abwerten")
  OAbgewertet = True
  TOechsleOriginal = TOechsle
  TQSNROriginal = TQSNR
  
  'CP 20070213: Oechslsereduktion bei Abwertung nur bedingt
  'If Not IsNull(TSANR) And TSANR <> "" Then
  '  If DFirst("AbwertungInAuszahlungIgnorieren", "TSortenattribute", "SANR='" + TSANR + "'") = True Then
  '   'Keine Oechslereduktion
  '  Else
  '   TOechsle = GetParameter("ABWERTUNGOECHSLE")
  '  End If
  'Else
  '  If DFirst("AbwertungInAuszahlungIgnorieren", "TSorten", "SNR='" + TSNR + "'") = True Then
  '   'Keine Oechslereduktion
  '  Else
  '   TOechsle = GetParameter("ABWERTUNGOECHSLE")
  '  End If
  'End If
  
  TLieferscheinnummer = TLieferscheinnummer + "A"
  TQSNR = 0
  
 Else
  MsgBox ("Teil der Lieferung abwerten - Neuen Lieferschein erstellen")
  Set db1 = CurrentDb
  Set rs1 = db1.OpenRecordset("TLieferungen")
  Set rs2 = db1.OpenRecordset("SELECT * FROM TLieferungen WHERE LINR=" + Format(TLINR))
  rs1.AddNew

  rs1!MGNR = rs2!MGNR
  rs1!GNR = rs2!GNR
  rs1!RNR = rs2!RNR
  
  rs1!ZNR = rs2!ZNR
  rs1!SNR = rs2!SNR
  If Not IsNull(rs2!SANR) Then
   rs1!SANR = rs2!SANR
  End If
  rs1!Lieferscheinnummer = rs2!Lieferscheinnummer + "A"
  rs1!Datum = rs2!Datum
  rs1!Uhrzeit = rs2!Uhrzeit
  rs1!Anmerkung = rs2!Anmerkung
  rs1!Gerebelt = rs2!Gerebelt
  
  rs1!LINR = DMax("LINR", "TLieferungen") + 1
  rs1!OechsleOriginal = rs2!Oechsle
  
  'CP 20070213: Oechslsereduktion bei Abwertung nur bedingt
  'If Not IsNull(TSANR) And TSANR <> "" Then
  '  If DFirst("AbwertungInAuszahlungIgnorieren", "TSortenattribute", "SANR='" + TSANR + "'") = True Then
  '   'Keine Oechslereduktion
  '   rs1!Oechsle = rs2!Oechsle
  '  Else
  '   rs1!Oechsle = GetParameter("ABWERTUNGOECHSLE")
  '  End If
  'Else
  '  If DFirst("AbwertungInAuszahlungIgnorieren", "TSorten", "SNR='" + TSNR + "'") = True Then
  '   'Keine Oechslereduktion
  '   rs1!Oechsle = rs2!Oechsle
  '  Else
  '   rs1!Oechsle = GetParameter("ABWERTUNGOECHSLE")
  '  End If
  'End If
  
  rs1!Abgewertet = True
  rs1!Gewicht = Wert
  rs1!QSNROriginal = rs2!QSNR
  rs1!QSNR = 0
  rs1!Handwiegung = False
  rs1!Storniert = False
  
  rs1.Update
  rs1.Close
  rs2.Close
  TGewicht = TGewicht - Wert
 End If
End If

Requery
TLieferscheinnummer.SetFocus
DoCmd.FindRecord aktLieferscheinnummer, acEntire, , acSearchAll, , acCurrent


End Sub

Private Sub BChargen_Click()

DoCmd.OpenForm "MChargenAuswahl"

End Sub

Private Sub BDrucken_Click()

Dim LieferscheinName As String
Dim abschlaege1 As Integer

abschlaege1 = GetAbschlaege


If GetParameter("LIEFERSCHEINART") = Null Then
 SetParameter "LIEFERSCHEINART", "2"
End If

LieferscheinName = "BLieferschein" + GetParameter("LIEFERSCHEINART")

If IsNull(DMax("MGNR", "TMitglieder", "[Aktives Mitglied]=True AND MGNR=Forms!FÜbernahme!TMGNR")) Then
 MsgBox "Bitte zuerst gültiges Mitglied eingeben !", vbCritical
 TMGNR.SetFocus
 Exit Sub
End If

If IsNull(DMax("ZNR", "TZweigstellen", "ZNR=Forms!FÜbernahme!TZweigstelle")) Then
 MsgBox "Bitte zuerst gültige Zweigstelle eingeben !", vbCritical
 TZweigstelle.SetFocus
 Exit Sub
End If


If IsNull(DMax("SNR", "TSorten", "SNR=Forms!FÜbernahme!TSNR")) Then
 MsgBox "Bitte zuerst gültige Sorte eingeben !", vbCritical
 TSNR.SetFocus
 Exit Sub
End If

If IsNull(TGewicht) Or TGewicht = "" Then
 MsgBox "Bitte zuerst wiegen !", vbCritical
 If BWiegen.Enabled Then
  BWiegen.SetFocus
 End If
 Exit Sub
End If

If IsNull(TOechsle) Or TOechsle = "" Then
 MsgBox "Bitte zuerst Oechsle eingeben !", vbCritical
 TOechsle.SetFocus
 Exit Sub
End If

If IsNull(GetParameter("ABSCHLAG_ERFORDERLICH")) Then
 SetParameter "ABSCHLAG_ERFORDERLICH", "0"
End If

If GetParameter("ABSCHLAG_ERFORDERLICH") = "1" And abschlaege1 = 0 Then
 MsgBox "Es muss mindestens ein Abschlag vergeben werden!", vbCritical
 Exit Sub
End If

DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70

If Not IsNull(TCNR) Then
    If ChargeStandNachFuellung(LINR) > 0 And GetParameter("CHARGENWARNUNG_BEHAELTERVOLL") = "Ja" Then
     If MsgBox("Diese Lieferung würde den Behälter um " + Format(ChargeStandNachFuellung(LINR)) + " überfüllen. Wollen Sie trotzdem diese Lieferung dieser Charge zuordnen und fortsetzen?", vbYesNo) = vbNo Then
      TCNR = Null
      Exit Sub
    
     End If
    Else
        If ChargeStandNachFuellung(LINR) > -GetParameter("CHARGENWARNUNG_BEHAELTERFASTVOLL") Then
          MsgBox ("Warnung! Im Behälter der gewählten Charge sind nach dieser Befüllung nur noch " + Format(-ChargeStandNachFuellung(LINR)) + " frei")
        End If
    End If
End If


TMGNR.SetFocus
BDrucken.Enabled = False


If Not IsNull(TCNR) Then
 OAufChargeverbucht = ChargeBefuellen(TCNR, TLINR)
End If

If IsNull(TLieferscheinnummer) Or TLieferscheinnummer = "" Then
        'Noch keine Lieferscheinnummer
        
            ' Switch RTS for 3 seconds -> Waage Freigabe
            
            TheEvent = 0
            If GetParameter("STEUERUNGTYP") = "SERIELL" Then
             If XCommSteuerung.PortOpen = 0 Then
              On Error GoTo WeiterNachKippen
              XCommSteuerung.PortOpen = 1
             End If
            End If

            TimerAus = True
            Kippen (True)
            While TheEvent < 3
             DoEvents
            Wend
            Kippen (False)
            TimerAus = False
            
            If GetParameter("STEUERUNGTYP") = "SERIELL" Then
             If XCommSteuerung.PortOpen = 1 Then
              On Error GoTo WeiterNachKippen
              XCommSteuerung.PortOpen = 0
             End If
            End If

WeiterNachKippen:
            
            On Error Resume Next
            ' Lieferscheinnummer setzen
            
            SetLieferscheinnummer
                        
            'Ausdrucken
            
            DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70


            DoCmd.OpenReport LieferscheinName, , , "[LINR]=" + Format(Forms!FÜbernahme!TLINR)
            If GetParameter("LIEFERSCHEINART") <> "1" Then
                '2x drucken
                DoCmd.OpenReport LieferscheinName, , , "[LINR]=" + Format(Forms!FÜbernahme!TLINR)
            End If
            
            
            
            'If GetParameter("LIEFERSCHEINART") = "1" Then
            ' DoCmd.OpenReport "BLieferschein1", , , "[LINR]=" + Format(Forms!FÜbernahme!TLINR)
            'Else
            ' DoCmd.OpenReport "BLieferschein2", , , "[LINR]=" + Format(Forms!FÜbernahme!TLINR)
            ' DoCmd.OpenReport "BLieferschein2", , , "[LINR]=" + Format(Forms!FÜbernahme!TLINR)
            'End If
               
            ' new record
            
            NewLieferschein
            
            
Else
        ' Lieferschein bereits 1x gedruckt (kein Kippen, kein neuer Datensatz, keine Lieferscheinnummer
        ' nur ausdrucken
        DoCmd.OpenReport LieferscheinName, , , "[LINR]=" + Format(Forms!FÜbernahme!TLINR)
           
        'If GetParameter("LIEFERSCHEINART") = "1" Then
        ' DoCmd.OpenReport "BLieferschein1", , , "[LINR]=" + Format(Forms!FÜbernahme!TLINR)
        'Else
        ' DoCmd.OpenReport "BLieferschein2", , , "[LINR]=" + Format(Forms!FÜbernahme!TLINR)
        'End If
            
End If


BDrucken.Enabled = True


End Sub

Private Sub Befehl114_Click()

Dim Wert

Wert = InputBox("Geben Sie bitte das Gewicht an:", "Manuelle Gewichtseingabe")

If Wert <> "" And Not IsNull(Wert) Then

TGewicht.SetFocus
TGewicht = Wert

OHandwiegung = 1

DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
RefreshAll
End If

End Sub



Private Sub Befehl170_Click()

Dim str1 As String
Dim rnr1 As Long

str1 = InputBox("Bitte geben Sie die Riedbezeichnung ein:")

If str1 <> "" And Not IsNull(str1) Then

Dim db1 As Database
Dim rs1 As Recordset

Set db1 = CurrentDb
Set rs1 = db1.OpenRecordset("SELECT * FROM TRiede;")

rs1.AddNew
rnr1 = DMax("[RNR]", "TRiede") + 1
rs1!RNR = rnr1
rs1!GNR = Forms!FÜbernahme!TGNR
rs1!Bezeichnung = str1
rs1.Update
rs1.Close
TRNR.Requery
TRNR = rnr1


End If


End Sub

Private Sub Befehl183_Click()

If Not IsNull(TMGNR) And TMGNR <> "" Then
  DoCmd.OpenForm "FMitgliedInfo"
End If

End Sub

Private Sub Befehl184_Click()


SetLieferscheinnummer

End Sub

Private Sub Befehl189_Click()

If LBishergeliefert.Visible = True Then
 LBishergeliefert.Visible = False
 TLiefersumme.Visible = False
 XSumme1.Visible = False
 XFeld1.Visible = False
 XFeld2.Visible = False
 XFeld3.Visible = False
 XFeld4.Visible = False
 XFeld5.Visible = False

Else
 LBishergeliefert.Visible = True
 TLiefersumme.Visible = True
 XSumme1.Visible = True
 XFeld1.Visible = True
 XFeld2.Visible = True
 XFeld3.Visible = True
 XFeld4.Visible = True
 XFeld5.Visible = True
End If


End Sub


Private Sub BKippen_Click()

' Switch RTS for 3 seconds

TheEvent = 0
'MsgBox ("Kippen auslösen")
Kippen (True)
While TheEvent < 3
 DoEvents
Wend
'MsgBox ("Kippen zurück")
Kippen (False)

End Sub

Private Sub BS1_Click()

Dim ASNR1 As Long
Dim db1 As Database
Dim rs1 As Recordset

ASNR1 = BS1.Tag

'Check if this ASNR is already assigned
Set db1 = CurrentDb
Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag WHERE ASNR=" + Format(ASNR1) + " AND LINR=" + Format(TLINR))
If rs1.recordcount > 0 Then
 Exit Sub
 rs1.Close
End If

'Add to Table TLieferungenAbschlaege
Set db1 = CurrentDb
Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag")
rs1.AddNew
rs1!LINR = TLINR
rs1!ASNR = ASNR1
rs1.Update
FAbschlaege.Requery
rs1.Close



End Sub

Private Sub BS2_Click()

Dim ASNR1 As Long
Dim db1 As Database
Dim rs1 As Recordset

ASNR1 = BS2.Tag

'Check if this ASNR is already assigned
Set db1 = CurrentDb
Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag WHERE ASNR=" + Format(ASNR1) + " AND LINR=" + Format(TLINR))
If rs1.recordcount > 0 Then
 Exit Sub
 rs1.Close
End If

'Add to Table TLieferungenAbschlaege
Set db1 = CurrentDb
Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag")
rs1.AddNew
rs1!LINR = TLINR
rs1!ASNR = ASNR1
rs1.Update
FAbschlaege.Requery
rs1.Close

End Sub

Private Sub BS3_Click()

Dim ASNR1 As Long
Dim db1 As Database
Dim rs1 As Recordset

ASNR1 = BS3.Tag

'Check if this ASNR is already assigned
Set db1 = CurrentDb
Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag WHERE ASNR=" + Format(ASNR1) + " AND LINR=" + Format(TLINR))
If rs1.recordcount > 0 Then
 Exit Sub
 rs1.Close
End If

'Add to Table TLieferungenAbschlaege
Set db1 = CurrentDb
Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag")
rs1.AddNew
rs1!LINR = TLINR
rs1!ASNR = ASNR1
rs1.Update
FAbschlaege.Requery
rs1.Close

End Sub

Private Sub BS4_Click()

Dim ASNR1 As Long
Dim db1 As Database
Dim rs1 As Recordset

ASNR1 = BS4.Tag

'Check if this ASNR is already assigned
Set db1 = CurrentDb
Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag WHERE ASNR=" + Format(ASNR1) + " AND LINR=" + Format(TLINR))
If rs1.recordcount > 0 Then
 Exit Sub
 rs1.Close
End If

'Add to Table TLieferungenAbschlaege
Set db1 = CurrentDb
Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag")
rs1.AddNew
rs1!LINR = TLINR
rs1!ASNR = ASNR1
rs1.Update
FAbschlaege.Requery
rs1.Close

End Sub

Private Sub BWiegen_Click()

' Wiegung durchführen
Dim i As Integer
Dim countit
Dim retryvalue

Dim Datum As Date
Dim zeit As Date
Dim Gewicht As Long
Dim Waagentext As String

TimerAus = True

If IsNull(DMax("MGNR", "TMitglieder", "[Aktives Mitglied]=True AND MGNR=Forms!FÜbernahme!TMGNR")) Then
 MsgBox "Bitte zuerst gültiges Mitglied eingeben !", vbCritical
 TMGNR.SetFocus
 Exit Sub
End If

If IsNull(DMax("SNR", "TSorten", "SNR=Forms!FÜbernahme!TSNR")) Then
 MsgBox "Bitte zuerst gültige Sorte eingeben !", vbCritical
 TSNR.SetFocus
 Exit Sub
End If

If GetParameter("UEBERNAME_WIEGENVOROECHSLE") = "0" Then
 If IsNull(TOechsle) Or TOechsle = "" Then
  MsgBox "Bitte zuerst Oechsle eingeben !", vbCritical
  TOechsle.SetFocus
  Exit Sub
 End If
End If


DoCmd.Hourglass True
TGewicht.SetFocus
BWiegen.Enabled = False

retryvalue = GetParameter("RETRY")
If IsNull(retryvalue) Or retryvalue = "" Then
 retryvalue = 10
 SetParameter "RETRY", CLng(retryvalue)
Else
 retryvalue = CLng(retryvalue)
End If

If SerialInterface Then
 If XComm.PortOpen = 0 Then
  On Error GoTo PortOpenError1
  XComm.PortOpen = 1
 End If
End If

countit = 0
i = -1
While i < 0 And countit < retryvalue
 If SerialInterface Then
  XComm.InBufferCount = 0
 End If
 i = Wiegen(Datum, zeit, Gewicht, Waagentext)
 countit = countit + 1
Wend

If SerialInterface Then
 XComm.PortOpen = 0
End If

DoCmd.Hourglass False

BWiegen.Enabled = True
If i >= 0 Then
 
 If Not IsNull(Datum) And Datum > DateValue("1.1.2000") Then
  TDatum = Datum
 End If
 If Not IsNull(Uhrzeit) And Uhrzeit > TimeValue("3:00") Then
  TUhrzeit = zeit
 End If
 If Not IsNull(Gewicht) Then
  TGewicht.SetFocus
  TGewicht = Gewicht
 Else
  TGewicht = i
 End If
 If Not IsNull(Waagentext) Then
  TWaagentext = Waagentext
 End If

 OHandwiegung = 0
 DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
 RefreshAll
Else
 MsgBox "Fehler Nr. " + Format(i) + ": Waage nicht bereit !", vbCritical
 BWiegen.SetFocus
End If

TimerAus = False

Exit Sub

PortOpenError1:
 MsgBox ("COM Port für Waage nicht verfügbar")
 'BWiegen.Enabled = False
 Exit Sub

End Sub



Private Sub FAbschlaege_Exit(Cancel As Integer)

  GetAbschlaege

End Sub

Private Sub Form_Activate()

'RefreshAll
TCNR.Requery

End Sub




Private Sub Kombinationsfeld105_Change()

TSNR = TSorte

End Sub


Private Sub Form_BeforeUpdate(Cancel As Integer)

If TLINR <> DMax("LINR", "TLieferungen") And Not IsNull(TLieferscheinnummer) And TLieferscheinnummer <> "" Then
 If MsgBox("Diese Lieferung wurde bereits ausgedruckt ! Sind Sie sicher, dass Sie die Daten ändern möchten ?", vbYesNo) = vbNo Then
      DoCmd.DoMenuItem acFormBar, acEditMenu, acUndo, , acMenuVer70
 End If
End If


End Sub

Private Sub Form_Close()

TimerAus = True
  
  LetztenLieferscheinLöschen

 TheEvent = 10
 
 
 WiegenBeenden
 
 If SerialInterface Then
  If XComm.PortOpen = 1 Then
   XComm.PortOpen = 0
  End If
  If XCommSteuerung.PortOpen = 1 Then
   XCommSteuerung.PortOpen = 0
  End If
 End If
 
 
End Sub

Private Sub Form_Current()

'MsgBox ("BeimAnzeigen")
RefreshAll
TMGNR.SetFocus


End Sub



Private Sub Form_Open(Cancel As Integer)

TimerAus = False
Freigabe (True)
FreigabeErteilt = True

SchnellauswahlAnlegen
NewLieferschein
RefreshAll

'Reihenfolge TOechsle-BWiegen
If IsNull(GetParameter("UEBERNAME_WIEGENVOROECHSLE")) Then
 SetParameter "UEBERNAME_WIEGENVOROECHSLE", "0"
End If
If GetParameter("UEBERNAME_WIEGENVOROECHSLE") = "1" Then
 BWiegen.TabIndex = 8
 TGewicht.TabIndex = 9
 TOechsle.TabIndex = 10
 BDrucken.TabIndex = 11
End If


WiegenInitialisieren

'Serial interface needed?
If GetParameter("WAAGENTYP") = "L246" Then
 SerialInterface = False
Else
 SerialInterface = True
End If

'COM Port Waage öffnen
If SerialInterface Then
 XComm.Settings = GetParameter("WAAGEPORTSETTINGS")
 XComm.CommPort = GetParameter("WAAGEPORT")
 XCommSteuerung.CommPort = GetParameter("STEUERUNGPORT")
End If

'DoCmd.Save acForm, "FÜbernahme"
'DoCmd.Close acForm, "FÜbernahme", acSaveYes



If IsNull(GetParameter("UEBERNAHME_WAAGESENDETZUERST")) Then
 SetParameter "UEBERNAHME_WAAGESENDETZUERST", "0"
End If
If GetParameter("UEBERNAHME_WAAGESENDETZUERST") = "1" Then
 'port öffnen
 If SerialInterface Then
    If XComm.PortOpen = 0 Then
     On Error GoTo PortOpenError1
     XComm.PortOpen = 1
    End If
 End If
 BWiegen.Enabled = False
End If

If GetParameter("WAAGENMONITOR") = "1" Then
 'port öffnen
 If SerialInterface Then
    If XComm.PortOpen = 0 Then
     On Error GoTo PortOpenError1
     XComm.PortOpen = 1
    End If
 End If
End If

Exit Sub

PortOpenError1:
 MsgBox ("COM Port für Waage nicht verfügbar")
 'BWiegen.Enabled = False
 Exit Sub

End Sub

Private Sub Form_Timer()

Dim Datum As Date
Dim zeit As Date
Dim Gewicht As Long
Dim Waagentext As String
Dim gewichtslimit As String
Dim result As Integer
 
 
 TheEvent = TheEvent + 1

 If GetParameter("UEBERNAHME_WAAGESENDETZUERST") = "1" And TimerAus = False Then
    If Forms!FÜbernahme!XComm.InBufferCount > 0 Then
      result = Wiegen(Datum, zeit, Gewicht, Waagentext)
      If result >= 0 Then
        If Not IsNull(Datum) Then
         TDatum = Datum
        End If
        If Not IsNull(Uhrzeit) Then
         TUhrzeit = zeit
        End If
        If Not IsNull(Gewicht) Then
         TGewicht.SetFocus
         TGewicht = Gewicht
        Else
         TGewicht = i
        End If
        If Not IsNull(Waagentext) Then
         TWaagentext = Waagentext
        End If
       OHandwiegung = 0
       DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
       RefreshAll
      Else
       If result <> -9 Then
        MsgBox "Fehler bei Kommunikation mit Waage!", vbCritical
       End If
      End If
    End If
 End If

 gewichtslimit = GetParameter("WAAGENMONITORLIMIT")
 
 If GetParameter("WAAGENMONITOR") = "1" And TimerAus = False Then
      result = Wiegen(Datum, zeit, Gewicht, Waagentext, True)
      If result >= 0 Then
       'TTest = Format(result) + ": " + Format(Datum, "dd.mm.yyyy") + " " + Format(zeit, "hh:MM:ss") + " " + Format(Gewicht, "0") + "kg " + waagentext
       TGewichtMonitor = Gewicht
      Else
       'TTest = Format(result)
      End If
      If result >= 0 Then
        If Not IsNull(Gewicht) Then
         If Gewicht >= gewichtslimit Then
           DoCmd.Beep
           
            If FreigabeErteilt = True Then
             Freigabe (False)
             FreigabeErteilt = False
            End If
                  
                    
           
           'If TheEvent Mod 2 = 0 Then
           ' Forms!FÜbernahme.Section(0).BackColor = 10874304
           'Else
            Forms!FÜbernahme.Section(0).BackColor = &HFF
           'End If
         Else
           Forms!FÜbernahme.Section(0).BackColor = 10874304
            If FreigabeErteilt = False Then
             Freigabe (True)
             FreigabeErteilt = True
            End If
           
         End If
        End If
      Else
       'MsgBox "Fehler bei Kommunikation mit Waage!", vbCritical
      End If
 End If

End Sub

Private Sub LBishergeliefert_DblClick(Cancel As Integer)

If Not IsNull(LBishergeliefert) Then
 TLieferscheinnummer.SetFocus
 DoCmd.FindRecord LBishergeliefert, acEntire, , acSearchAll, , acCurrent
End If

End Sub

Private Sub OAbgewertet_Click()

If OAbgewertet = True Then
 If Right(TLieferscheinnummer, 1) <> "A" Then
  TLieferscheinnummer = TLieferscheinnummer + "A"
 End If
Else
 If Right(TLieferscheinnummer, 1) = "A" Then
  TLieferscheinnummer = Left(TLieferscheinnummer, Len(TLieferscheinnummer) - 1)
 End If
End If

End Sub

Private Sub OGerebelt_Alt_Click()


 'If MsgBox("Soll der entsprechende Gewichtsanteil abgezogen werden ?", vbYesNo) = vbYes Then

 Dim ra As Double
 Dim gw As Double

 ra = CDbl(GetParameter("REBELABZUG"))

 gw = TGewicht
 
 
 If OGerebelt.Value = False Then

  gw = gw * (100 - ra) / 100
 
 Else
 
  gw = gw / (100 - ra) * 100
 
 End If

 
 TGewicht = gw

 DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
 RefreshAll

 'End If


End Sub

Private Sub OSpaetlese_Click()

Dim Oechsle As Long
Dim QSNR As Long
Oechsle = CLng(TOechsle.Value)
QSNR = DFirst("QSNR", "TQualitaetsstufen", "Von<=" + Format(Oechsle) + " AND Bis>=" + Format(Oechsle))

If QSNR = 5 Then
 If OSpaetlese.Value = True Then
  TQSNR = 5
 Else
  TQSNR = 3
 End If
End If

DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
RefreshAll


End Sub

Private Sub TGewicht_Exit(Cancel As Integer)

DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
RefreshAll

End Sub




Private Sub TGNR_Exit(Cancel As Integer)

DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
RefreshAll
TRNR.Requery

End Sub

Private Sub TMGNR_Exit(Cancel As Integer)

DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70

End Sub

Private Sub TMitglied_Click()

TMGNR = TMitglied

End Sub

Private Sub TMitglied_Exit(Cancel As Integer)

DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70

Dim ort1
Dim GNR1

If Not IsNull(TMGNR) And Not IsNull(TOrt) Then

 ort1 = TOrt
 If InStr(ort1, " ") > 0 Then
  ort1 = Left(ort1, InStr(ort1, " ") - 1)
 End If
 
 GNR1 = DFirst("GNR", "TGemeinden", "Bezeichnung='" + ort1 + "'")
 If Not IsNull(GNR1) Then
  TGNR = GNR1
 Else
    'Voller Ortsname ohne Leerzeichen
    GNR1 = DFirst("GNR", "TGemeinden", "Bezeichnung='" + TOrt + "'")
    If Not IsNull(GNR1) Then
     TGNR = GNR1
    End If
 End If
 

End If

VollieferantenZuschlagEintragen

End Sub



Private Sub TOechsle_Exit(Cancel As Integer)
        
Dim CNR1 As Integer
        
If IsNull(TOechsle) Or TOechsle = 0 Or TOechsle = "" Then
Else
 TQSNR.Value = DFirst("QSNR", "TQualitaetsstufen", "Von<=" + Format(TOechsle) + " AND Bis>=" + Format(TOechsle))
End If

If Not IsNull(TSNR) And Not IsNull(TQSNR) And Not IsNull(TZweigstelle) Then
    CNR1 = GetActiveCharge(TSNR, TQSNR, TZweigstelle, TSANR)
    If CNR1 > 0 Then
     TCNR = CNR1
    Else
     'Warnung
     If GetParameter("CHARGENWARNUNG") = "Ja" Then
      If MsgBox("Es konnte keine Charge im Status 'Befüllung' für diese Übernahme gefunden werden. Wollen Sie eine Charge auswählen bzw. neu anlegen", vbYesNo) = vbYes Then
       DoCmd.OpenForm ("FUebernahmeChargenauswahl")
      End If
     End If
    End If
End If

 DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
 RefreshAll


End Sub

Sub RefreshAll()

Dim w1

w1 = TOechsle

If Not IsNull(w1) And w1 <> "" Then
 'TQualitaetsstufe.Caption = DMax("Bezeichnung", "TQualitaetsstufen", "QSNR=" + Format(TQSNR))
 If TQSNR = 4 Then
  OSpaetlese.Visible = True
 Else
  OSpaetlese.Visible = False
 End If
 TKW.Caption = "= " + Format((DMax("[KW]", "TUmrechnung", "Oechsle=" + Format(TOechsle)))) + " ° KW"
Else
 TKW.Caption = ""
End If

If Not IsNull(TGNR) Then
 TGLNR = DFirst("[GLNR]", "TGemeinden", "GNR=" + Format(TGNR))
 If Not IsNull(TQSNR) And Not IsNull(TSNR) And Not IsNull(TGLNR) Then
  TWBGNR = GetGebietGLNR(TSNR, TQSNR, TGLNR)
  TRGNR = DFirst("[RGNR]", "TGebiete", "WBGNR=" + Format(TWBGNR))
 End If
 
 'TWBGNR = DFirst("[WBGNR]", "TGrosslagen", "GLNR=" + Format(TGLNR))
End If


LBishergeliefert.Requery

End Sub


Private Sub Befehl133_Click()
On Error GoTo Err_Befehl133_Click


    DoCmd.GoToRecord , , acFirst

Exit_Befehl133_Click:
    Exit Sub

Err_Befehl133_Click:
    MsgBox Err.Description
    Resume Exit_Befehl133_Click
    
End Sub
Private Sub Befehl134_Click()
On Error GoTo Err_Befehl134_Click


    DoCmd.GoToRecord , , acPrevious

Exit_Befehl134_Click:
    Exit Sub

Err_Befehl134_Click:
    MsgBox Err.Description
    Resume Exit_Befehl134_Click
    
End Sub
Private Sub Befehl135_Click()
On Error GoTo Err_Befehl135_Click


    DoCmd.GoToRecord , , acNext

Exit_Befehl135_Click:
    Exit Sub

Err_Befehl135_Click:
    MsgBox Err.Description
    Resume Exit_Befehl135_Click
    
End Sub
Private Sub Befehl136_Click()
On Error GoTo Err_Befehl136_Click


    DoCmd.GoToRecord , , acLast

Exit_Befehl136_Click:
    Exit Sub

Err_Befehl136_Click:
    MsgBox Err.Description
    Resume Exit_Befehl136_Click
    
End Sub
Private Sub Befehl137_Click()

On Error GoTo Err_Befehl137_Click


    DoCmd.GoToRecord , , acNewRec

Exit_Befehl137_Click:
    Exit Sub

Err_Befehl137_Click:
    MsgBox Err.Description
    Resume Exit_Befehl137_Click
    
TMGNR.SetFocus


End Sub
Private Sub Befehl138_Click()

If MsgBox("Sind Sie sicher, daß Sie diesen Datensatz löschen möchten (ev. stornieren) ?", vbYesNo) = vbYes Then

On Error GoTo Err_Befehl138_Click


    DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
    DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70

Exit_Befehl138_Click:
    Exit Sub

Err_Befehl138_Click:
    MsgBox Err.Description
        Resume Exit_Befehl138_Click
    
    
End If

End Sub
Private Sub Befehl141_Click()

If MsgBox("Wollen Sie diese Lieferung wirklich stornieren ?", vbYesNo) = vbYes Then

 If Not IsNull(TCNR) And TGewicht > 0 And TOechsle > 0 Then
  If MsgBox("Wollen Sie die Liefermenge bei der zugeordneten Charge ebenfalls abziehen?", vbYesNo) = vbYes Then
    ChargeBefuellungRueckgaengig TCNR, TLINR
    TCNR = ""
  End If
 End If
 TGewicht = 0
 OStorniert = 1
 
 DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
 RefreshAll
 
End If
    
    
End Sub

Private Sub TSANR_Click()

'If TSANR.Column(1) = "Sekt" Then
' TQSNR = 0
'End If

End Sub

Private Sub TSNR_Exit(Cancel As Integer)


    TSNR = UCase(TSNR)
    
    Dim SNR1 As String
    Dim SANR1 As String
    
    If IsNull(TSNR) Then
     Exit Sub
    End If
    
    If GetSNRAndSANRFromInput(TSNR, SNR1, SANR1) Then
     TSNR = SNR1
     TSANR = SANR1
    Else
     TSANR = Null
    End If
    
    
     If DCount("[SNR]", "TSorten", "SNR='" + TSNR + "'") = 0 Then
      MsgBox "Bitte geben Sie ein gültiges Sortenkürzel ein!", vbCritical
      'TSNR =
      TSNR.SetFocus
      Exit Sub
     End If
    
    DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
    
    RefreshAll
    
    
    Dim mgnr1
    Dim flageb1
    
    mgnr1 = TMGNR
    SNR1 = TSNR
    
    If IsNull(SNR1) Or IsNull(mgnr1) Then
     Exit Sub
    End If
    
    flageb1 = DSum("Flaeche", "TFlaechenbindungen", "SNR='" + Format(SNR1) + "' AND MGNR=" + Format(mgnr1))
    
    If Not IsNull(flageb1) And flageb1 > 0 Then
     OGebunden = True
    Else
     OGebunden = False
    End If

End Sub




Sub SetLieferscheinnummer()

Dim newLieferscheinnummer As String
Dim tag1 As String
Dim mon1 As String
Dim Jahr1 As String
Dim temp1
Dim lief1 As String
Dim zwst1 As String

tag1 = Format(Day(TDatum.Value), "00")
mon1 = Format(Month(TDatum.Value), "00")
Jahr1 = Format(year(TDatum.Value), "0000")

'MsgBox ("[Datum]=DateValue('" + Format(TDatum, "dd.mm.yyyy") + "')")
temp1 = DCount("[LINR]", "TLieferungen", "[Datum]=DateValue('" + Format(TDatum, "dd.mm.yyyy") + "') AND TLieferungen.ZNR=" + Format(TZweigstelle))
If IsNull(temp1) Then
 lief1 = Format(1, "000")
Else
 lief1 = Format(temp1, "000")
End If

zwst1 = DMax("[Kennbst]", "TZweigstellen", "ZNR=" + Format(TZweigstelle))

newLieferscheinnummer = Jahr1 + mon1 + tag1 + zwst1 + lief1

TLieferscheinnummer = newLieferscheinnummer

End Sub


Public Sub send(ByVal b As Byte)
' Sends 1 Byte to serial interface
Dim buff As Variant
ReDim buff(0 To 0) As Byte

buff(0) = b

 Forms!FÜbernahme!XComm.Output = buff
 
 While Forms!FÜbernahme!XComm.OutBufferCount > 0
 Wend

End Sub

Public Function Receive() As Integer
' Receives 1 byte from serial interface
' Timeout after 'MPreferences.ICommTimeout' milliseconds

Dim i As Variant

On Error GoTo err1
Forms!FÜbernahme!XComm.InputLen = 1
TheEvent = 0

While Forms!FÜbernahme!XComm.InBufferCount < 1 And TheEvent < 1
 DoEvents
 If Forms!FÜbernahme.ActiveControl = False Then
  Exit Function
 End If
Wend
ReDim i(1)

If Forms!FÜbernahme!XComm.InBufferCount >= 1 Then
  i = Forms!FÜbernahme!XComm.Input
  'MsgBox (i(0))
  Receive = i(0)
Else
  Receive = -1
End If
Exit Function

err1:
  Receive = -1

End Function




Private Sub Befehl186_Click()
    
DoCmd.OpenForm "MLieferungSuchen"
    
End Sub

Sub NewLieferschein()

 Dim db1 As Database
 Dim rs1 As Recordset
 Dim rs2 As Recordset
 Dim LINR1 As Long
 Set db1 = CurrentDb
 Set rs1 = db1.OpenRecordset("TLieferungen")
 rs1.AddNew
 If IsNull(DMax("LINR", "TLieferungen")) Then
  rs1!LINR = 1
 Else
  rs1!LINR = DMax("LINR", "TLieferungen") + 1
  'rs1!ZNR = DMax("[ZNR]", "TLieferungen", "[LINR]=" + Format(DMax("[LINR]", "TLieferungen", "[LINR]<>" + Format(rs1!LINR))))
  rs1!ZNR = GetParameter("LETZTEZNR")
  rs1!Gerebelt = DMax("[Gerebelt]", "TLieferungen", "[LINR]=" + Format(DMax("[LINR]", "TLieferungen", "[LINR]<>" + Format(rs1!LINR))))
 End If
 LINR1 = rs1!LINR
 rs1!Datum = Date
 rs1!Uhrzeit = time
 rs1.Update
 rs1.Close
 
 ' Standardabschläge suchen
 On Error GoTo EndNew
 Set rs1 = db1.OpenRecordset("SELECT * FROM TAbschlaege WHERE Standard=TRUE")
 Set rs2 = db1.OpenRecordset("TLieferungAbschlag")
  While Not rs1.EOF
   rs2.AddNew
   rs2!LINR = LINR1
   rs2!ASNR = rs1!ASNR
   rs2.Update
  rs1.MoveNext
 Wend
 rs1.Close
 rs2.Close
 
EndNew:
 Requery
 DoCmd.GoToRecord acActiveDataObject, , acLast

End Sub

Sub LetztenLieferscheinLöschen()

 Dim db1 As Database
 Dim rs1 As Recordset
 Dim LINR1
 
 LINR1 = DMax("LINR", "TLieferungen")
 Set db1 = CurrentDb
 Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungen WHERE LINR=" + Format(LINR1))
 rs1.MoveLast
 
 If rs1!Gewicht = 0 Or IsNull(rs1!Gewicht) Then
  LINR1 = rs1!LINR
  rs1.Delete
  db1.Execute ("DELETE * FROM TLieferungAbschlag WHERE LINR=" + Format(LINR1))
 End If
 rs1.Close

 

End Sub

Private Sub TZweigstelle_Exit(Cancel As Integer)

If Not IsNull(TZweigstelle) Then
 SetParameter "LETZTEZNR", TZweigstelle
End If



End Sub



Function GetAbschlaege() As Integer

Dim db1 As Database
Dim rs1 As Recordset
Dim str1 As String

str1 = ""

Set db1 = CurrentDb
Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag INNER JOIN TAbschlaege ON TLieferungAbschlag.ASNR = TAbschlaege.ASNR WHERE LINR = " + Format(TLINR))
GetAbschlaege = rs1.recordcount
While Not rs1.EOF
 str1 = str1 + rs1!Bezeichnung
 rs1.MoveNext
 If Not rs1.EOF Then
 str1 = str1 + Chr(13) + Chr(10)
 End If
Wend
rs1.Close

TAbschlaege = str1


End Function

Sub SchnellauswahlAnlegen()

Dim db1 As Database
Dim rs1 As Recordset
Dim max1 As Long
Dim i, j As Long
Dim bs_name As String

max1 = 4 ' derzeit 4 Buttons

Set db1 = CurrentDb
Set rs1 = db1.OpenRecordset("SELECT * FROM TAbschlaege WHERE Schnellauswahl=True")
i = 0
While Not rs1.EOF And i < max1
 str1 = str1 + rs1!Bezeichnung
 bs_name = "BS" + Format(i + 1, "0")
 Controls(bs_name).Visible = True
 Controls(bs_name).Caption = rs1!Bezeichnung
 Controls(bs_name).Tag = rs1!ASNR
 i = i + 1
 rs1.MoveNext
Wend
rs1.Close
For j = i To max1 - 1
 bs_name = "BS" + Format(j + 1, "0")
 Controls(bs_name).Visible = False
Next j


End Sub


Sub VollieferantenZuschlagEintragen()

Dim db1 As Database
Dim rs1 As Recordset
Dim ASNR1 As Long

max1 = 4 ' derzeit 4 Buttons

If Not IsNull(TMGNR) Then
 If DFirst("Volllieferant", "TMitglieder", "MGNR=" + Format(TMGNR)) = True Then

  If Not IsNull(DFirst("ASNR", "TAbschlaege", "Bezeichnung='Treuebonus'")) Then
   ASNR1 = DFirst("ASNR", "TAbschlaege", "Bezeichnung='Treuebonus'")
   Set db1 = CurrentDb
 
    'Check if this ASNR is already assigned
    Set db1 = CurrentDb
    Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag WHERE ASNR=" + Format(ASNR1) + " AND LINR=" + Format(TLINR))
    If rs1.recordcount > 0 Then
     Exit Sub
     rs1.Close
    End If

    'Add to Table TLieferungenAbschlaege
    Set db1 = CurrentDb
    Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag")
    rs1.AddNew
    rs1!LINR = TLINR
    rs1!ASNR = ASNR1
    rs1.Update
    FAbschlaege.Requery
    rs1.Close
   End If
 End If
End If




End Sub