Imports System.Text Imports DevExpress.XtraGrid.Views.Base Public Class frmMain Dim aktMandant As String Dim aktLHM_SDG_ID As Integer = 0 Dim SDG_READY As Boolean = False Dim aktLHM_ID As Integer Dim AnzPaket As Integer Public Shared _EDV_no As String Public Shared _LS_no As String Dim CURR_LIEFADR As String Dim CURR_PLZ As String Dim CURR_Ort As String Dim CURR_Str As String Private Sub frmMain_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing If pnlHuP.Visible = True And SDG_READY = False And CURRENT_SENDUNG <> 0 Then Delete_HUP() End If End Sub Private Sub frmMain_Load(sender As Object, e As System.EventArgs) Handles Me.Load If My.Settings.ConfigConnectionString = String.Empty Or My.Settings.ConfigConnStringMercator = String.Empty Then MsgBox("Bitte hinterlegen Sie die Datenbankverbindung in der Konfiguration!", MsgBoxStyle.Critical, "Fehlende Konfiguration:") frmConnection.ShowDialog() End If If My.Settings.ConfigConnectionString = String.Empty Or My.Settings.ConfigConnStringMercator = String.Empty Then MsgBox("Noch nicht alle Datenbankverknüpfungen hinterlegt!" & vbNewLine & "Programm wird beendet.", MsgBoxStyle.Critical, "Fehlende Konfiguration:") Application.Exit() End If Try 'If (System.Diagnostics.Debugger.IsAttached) = False Then My.Settings.ConfigConnectionString = "Data Source=192.168.13.101;Initial Catalog=SCHAUM_IID;Persist Security Info=True;User ID=sa;Password=dd" My.Settings.ConfigConnStringMercator = "Data Source=192.168.13.101;Initial Catalog=CP2DD;Persist Security Info=True;User ID=sa;Password=dd" My.Settings.Save() ' End If tslblConString.Text = "Constrings: " & My.Settings.ConfigConnectionString.Replace("=sa;Password=dd", "XXX") & " # " & My.Settings.ConfigConnStringMercator.Replace("=sa;Password=dd", "XXX") Me.TBWH_MANDANTTableAdapter.Connection.ConnectionString = My.Settings.ConfigConnectionString Me.TBKOMMCOLLI_PAKET_KOPFTableAdapter.Connection.ConnectionString = My.Settings.ConfigConnectionString Me.TBKOMMCOLLI_PAKET_POSTableAdapter.Connection.ConnectionString = My.Settings.ConfigConnectionString Me.TBKOMMCOLLI_TERMINARTTableAdapter.Connection.ConnectionString = My.Settings.ConfigConnectionString Me.TBKOMMCOLLI_SDGPOSITIONENTableAdapter.Connection.ConnectionString = My.Settings.ConfigConnectionString TBKOMMCOLLI_TEXTSCHLUESSELTableAdapter.Connection.ConnectionString = My.Settings.ConfigConnectionString Me.TBKOMMCOLLI_TEXTSCHLUESSELTableAdapter.Fill(Me.MyDataset.TBKOMMCOLLI_TEXTSCHLUESSEL) TBKOMMCOLLI_HINWEISTableAdapter.Connection.ConnectionString = My.Settings.ConfigConnectionString ClassDatabase.Init() Catch ex As Exception MsgBox("Fehler bei Load ConnectionString frm Main: " & vbNewLine & ex.Message, MsgBoxStyle.Exclamation) End Try ToolStripStatusLabelVersion.Text = String.Format("Version {0}", My.Application.Info.Version.ToString) End Sub Private Sub GrundeinstellungenToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles GrundeinstellungenToolStripMenuItem.Click frmConnection.ShowDialog() End Sub Private Sub MandanteneinstellungenToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles MandanteneinstellungenToolStripMenuItem.Click frmStammdatenverwaltung.Show() End Sub Sub ShowError(errormsg As String) Me.picbxError.Visible = True Me.txtError.Text = errormsg Me.txtError.Visible = True pnlError.Visible = True End Sub Sub deactivate_Error() Me.picbxError.Visible = False Me.txtError.Visible = False pnlError.Visible = False End Sub Private Sub btnAddNewPaket_Click(sender As System.Object, e As System.EventArgs) Handles btnAddNewColli.Click AddNew_Colli() End Sub Private Sub txtScan_GotFocus(sender As Object, e As System.EventArgs) Handles txtScan.GotFocus txtScan.BackColor = Color.LimeGreen End Sub Private Sub txtScan_KeyUp(sender As Object, e As System.Windows.Forms.KeyEventArgs) Handles txtScan.KeyUp If e.KeyCode = Keys.Return Then If txtScan.Text <> String.Empty Then AddBarcode(txtScan.Text) txtScan.Text = "" End If End If End Sub Private Sub txtScan_LostFocus(sender As Object, e As System.EventArgs) Handles txtScan.LostFocus txtScan.BackColor = Color.White End Sub Sub AddBarcode(BC As String) Try If BC.Contains("'") Then BC = BC.Replace("'", "_") End If If cmbAuswMandant.SelectedValue = 0 Then Else TBKOMMCOLLI_PAKET_POSTableAdapter.Insert(CURRENT_SENDUNG, BC) TBKOMMCOLLI_PAKET_KOPFTableAdapter.Fill(MyDataset.TBKOMMCOLLI_PAKET_KOPF, CURRENT_SENDUNG) Refresh_Barcodes() End If deactivate_Error() Catch ex As Exception If ex.Message.Contains("UNIQ_BARCODE_PER_POS") Then ShowError("ACHTUNG der Barcode wurde bereits einmal eingescannt!") Else ShowError("Fehler in AddBarcode: " & vbNewLine & ex.Message & vbNewLine & My.Settings.ConfigConnectionString) End If End Try End Sub Private Function AddBarcodeHuP(BarcodeString As String) Dim separators As New List(Of String) From {"|", "_", "'"} Try Dim BarcodeArray() As String For Each separator In separators If BarcodeString.Contains(separator) Then BarcodeArray = BarcodeString.Split(separator) Exit For End If Next Try _EDV_no = Trim(BarcodeArray(0)) Catch ex As Exception _EDV_no = "" End Try Try _LS_no = Trim(BarcodeArray(1)) Catch ex As Exception _LS_no = "" End Try If _EDV_no <> String.Empty And _LS_no <> String.Empty Then Dim sql = String.Format("SELECT * FROM VKKOPF WHERE GUID = (SELECT MAX(GUID) FROM VKKOPF WHERE vkkopf_bestellnr = '{0}')", _EDV_no) Dim DT_ROW As DataTable = ClassDatabase.Return_Datatable_CS(sql, My.Settings.ConfigConnStringMercator) If IsNothing(DT_ROW) Then MsgBox("Für diese Bestellnummer wurde kein Eintrag gefunden!", MsgBoxStyle.Exclamation) Return False ElseIf DT_ROW.Rows.Count <> 1 Then MsgBox("Für diese Bestellnummer wurde mehr als ein Eintrag gefunden!", MsgBoxStyle.Exclamation) Return False End If ' Dim GUID = ClassDatabase.Execute_Scalar_CS(sql, My.Settings.ConfigConnStringMercator, True) ' If IsDBNull(GUID) Then 'End If ' Dim getMERC_SELECT = String.Format("select TOP 1 vkkopf_kunde FROM VKKOPF WHERE vkkopf_bestellnr = '{0}' and [vkkopf_eingang_nr] = '{1}' AND GUID = {2}", _EDV_no, _LS_no, GUID) Dim MERC_KDNR = DT_ROW.Rows(0).Item("vkkopf_kunde") 'ClassDatabase.Execute_Scalar_CS(getMERC_SELECT, My.Settings.ConfigConnStringMercator, True) If MERC_KDNR Is Nothing Then MsgBox("Es konnte keine Kundennummer selektiert werden!", MsgBoxStyle.Exclamation) Return False End If 'getMERC_SELECT = String.Format("select TOP 1 LTRIM(RTRIM([vkkopf_liefadr_name1])) FROM VKKOPF WHERE vkkopf_bestellnr = '{0}' and [vkkopf_eingang_nr] = '{1}' AND GUID = {2}", _EDV_no, _LS_no, GUID) Dim MERC_LIEFADR1 = DT_ROW.Rows(0).Item("vkkopf_liefadr_name1") MERC_LIEFADR1 = LTrim(RTrim(MERC_LIEFADR1)) 'ClassDatabase.Execute_Scalar_CS(getMERC_SELECT, My.Settings.ConfigConnStringMercator, True) ' getMERC_SELECT = String.Format("select TOP 1 LTRIM(RTRIM([vkkopf_liefadr_name2])) FROM VKKOPF WHERE vkkopf_bestellnr = '{0}' and [vkkopf_eingang_nr] = '{1}' AND GUID = {2}", _EDV_no, _LS_no, GUID) 'Dim MERC_LIEFADR2 = ClassDatabase.Execute_Scalar_CS(getMERC_SELECT, My.Settings.ConfigConnStringMercator, True) Dim MERC_LIEFADR2 = DT_ROW.Rows(0).Item("vkkopf_liefadr_name2") MERC_LIEFADR2 = LTrim(RTrim(MERC_LIEFADR2)) 'getMERC_SELECT = String.Format("select TOP 1 LTRIM(RTRIM([vkkopf_liefadr_strasse])) FROM VKKOPF WHERE vkkopf_bestellnr = '{0}' and [vkkopf_eingang_nr] = '{1}' AND GUID = {2}", _EDV_no, _LS_no, GUID) Dim MERC_LIEFSTR = DT_ROW.Rows(0).Item("vkkopf_liefadr_strasse") 'ClassDatabase.Execute_Scalar_CS(getMERC_SELECT, My.Settings.ConfigConnStringMercator, True) MERC_LIEFSTR = LTrim(RTrim(MERC_LIEFSTR)) 'getMERC_SELECT = String.Format("select TOP 1 LTRIM(RTRIM([vkkopf_liefadr_land_nr])) FROM VKKOPF WHERE vkkopf_bestellnr = '{0}' and [vkkopf_eingang_nr] = '{1}' AND GUID = {2}", _EDV_no, _LS_no, Guid) Dim MERC_LIEFLAND = DT_ROW.Rows(0).Item("vkkopf_liefadr_land_nr") 'ClassDatabase.Execute_Scalar_CS(getMERC_SELECT, My.Settings.ConfigConnStringMercator, True) MERC_LIEFLAND = LTrim(RTrim(MERC_LIEFLAND)) 'getMERC_SELECT = String.Format("select TOP 1 LTRIM(RTRIM([vkkopf_liefadr_ldplz])) FROM VKKOPF WHERE vkkopf_bestellnr = '{0}' and [vkkopf_eingang_nr] = '{1}' AND GUID = {2}", _EDV_no, _LS_no, GUID) Dim MERC_LIEFPLZ = DT_ROW.Rows(0).Item("vkkopf_liefadr_ldplz") 'ClassDatabase.Execute_Scalar_CS(getMERC_SELECT, My.Settings.ConfigConnStringMercator, True) MERC_LIEFPLZ = LTrim(RTrim(MERC_LIEFPLZ)) 'getMERC_SELECT = String.Format("select TOP 1 LTRIM(RTRIM([vkkopf_liefadr_ort])) FROM VKKOPF WHERE vkkopf_bestellnr = '{0}' and [vkkopf_eingang_nr] = '{1}' AND GUID = {2}", _EDV_no, _LS_no, Guid) Dim MERC_LIEFORT = DT_ROW.Rows(0).Item("vkkopf_liefadr_ort") 'ClassDatabase.Execute_Scalar_CS(getMERC_SELECT, My.Settings.ConfigConnStringMercator, True) MERC_LIEFORT = LTrim(RTrim(MERC_LIEFORT)) 'getMERC_SELECT = String.Format("select TOP 1 LTRIM(RTRIM([vkkopf_gew_netto])) FROM VKKOPF WHERE vkkopf_bestellnr = '{0}' and [vkkopf_eingang_nr] = '{1}' AND GUID = {2}", _EDV_no, _LS_no, Guid) Dim MERC_GEWICHT = DT_ROW.Rows(0).Item("vkkopf_gew_netto") 'ClassDatabase.Execute_Scalar_CS(getMERC_SELECT, My.Settings.ConfigConnStringMercator, True) MERC_GEWICHT = LTrim(RTrim(MERC_GEWICHT)) If CURR_LIEFADR = "" And CURR_Ort = "" Then CURR_LIEFADR = MERC_LIEFADR1 CURR_Ort = MERC_LIEFORT CURR_PLZ = MERC_LIEFPLZ CURR_Str = MERC_LIEFSTR End If If CURR_LIEFADR <> MERC_LIEFADR1 Or CURR_PLZ <> MERC_LIEFPLZ Or CURR_Str <> MERC_LIEFSTR Or CURR_Ort <> MERC_LIEFORT Then ' Fragen ob das Profil wirklich gelöscht werden soll Dim result As MsgBoxResult = MsgBox("Die Adressen sind unterschiedlich!" & vbNewLine & "Wollen Sie den Lieferschein dennoch hinzufügen?" & vbNewLine & "Wenn ja, dann kontrollieren Sie bitte die Adresse!", MsgBoxStyle.YesNo, "Bitte bestätigen:") ' wenn das Profil gelöscht werden soll If result = MsgBoxResult.No Then ' MsgBox("ACHTUNG: " & vbNewLine & "Die Adressdaten sind unterschiedlich!", MsgBoxStyle.Exclamation) Return False End If End If Dim Upd = String.Format("UPDATE TBKOMMCOLLI_SENDUNGEN SET KUNDEN_ID = '{0}',NAME1 = '{1}',NAME2 = '{2}',STRASSE = '{3}',LKZ = '{4}',PLZ = '{5}',ORT = '{6}' WHERE GUID = {7}", MERC_KDNR, MERC_LIEFADR1, MERC_LIEFADR2, MERC_LIEFSTR, MERC_LIEFLAND, MERC_LIEFPLZ, MERC_LIEFORT, CURRENT_SENDUNG) If ClassDatabase.Execute_non_Query(Upd, True) = True Then Dim exists = String.Format("SELECT COUNT(*) FROM TBKOMMCOLLI_SDG_LHM WHERE SENDUNGNR = {0} AND FERTIG = 0", CURRENT_SENDUNG) Dim LHM_exists As Boolean = False If ClassDatabase.Execute_Scalar(exists, True) >= 1 Then LHM_exists = True End If If LHM_exists = False Then Dim ins = String.Format("INSERT INTO TBKOMMCOLLI_SDG_LHM (SENDUNGNR,LHM_ID,ERSTELLTWER) VALUES ({0},{1},'{2}')", CURRENT_SENDUNG, aktLHM_ID, Environment.UserName) If ClassDatabase.Execute_non_Query(ins, True) = True Then End If End If aktLHM_SDG_ID = ClassDatabase.Execute_Scalar("SELECT MAX(GUID) FROM TBKOMMCOLLI_SDG_LHM WHERE FERTIG = 0", True) If aktLHM_SDG_ID > 0 Then btnPalfertig.Text = "Palette (" & aktLHM_SDG_ID.ToString & ", " & cmbLHM.Text & ") fertig" MERC_GEWICHT = MERC_GEWICHT.ToString.Replace(",", ".") Dim ins = String.Format("INSERT INTO TBKOMMCOLLI_SDGPOSITIONEN (SENDUNGNR,SDG_LHM_ID,GEWICHT,ERSTELLTWER) VALUES ({0},{1},{2},'{3}')", CURRENT_SENDUNG, aktLHM_SDG_ID, MERC_GEWICHT, Environment.UserName) If ClassDatabase.Execute_non_Query(ins, True) = True Then 'cmbLHM.Enabled = False Refresh_POS(CURRENT_SENDUNG) End If End If If txtFreitext.Text <> "" Then Upd = String.Format("UPDATE TBKOMMCOLLI_SENDUNGEN SET BEMERKUNG = '{0}' WHERE GUID = {1}", txtFreitext.Text & ", " & _LS_no, CURRENT_SENDUNG) Else Upd = String.Format("UPDATE TBKOMMCOLLI_SENDUNGEN SET BEMERKUNG = '{0}' WHERE GUID = {1}", _LS_no, CURRENT_SENDUNG) End If If ClassDatabase.Execute_non_Query(Upd, True) = True Then txtFreitext.Text = ClassDatabase.Execute_Scalar("SELECT BEMERKUNG FROM TBKOMMCOLLI_SENDUNGEN WHERE GUID = " & CURRENT_SENDUNG, True) End If End If End If deactivate_Error() Catch ex As Exception If ex.Message.Contains("UNIQ_BARCODE_PER_POS") Then ShowError("ACHTUNG der Barcode wurde bereits einmal eingescannt!") Else ShowError("Fehler in AddBarcodeHuP: " & vbNewLine & ex.Message) End If Return False End Try End Function Sub Refresh_POS(SDG As Integer) Try Me.TBKOMMCOLLI_SDGPOSITIONENTableAdapter.Connection.ConnectionString = My.Settings.ConfigConnectionString Me.TBKOMMCOLLI_SDGPOSITIONENTableAdapter.Fill(Me.MyDataset.TBKOMMCOLLI_SDGPOSITIONEN, SDG, aktLHM_SDG_ID) GridControlPos.DataSource = Nothing grvwGridPos.Columns.Clear() Dim sel = String.Format("SELECT T.GUID,T2.LHM, T.POSINHALT,T.GEWICHT FROM TBKOMMCOLLI_SDGPOSITIONEN T, TBKOMMCOLLI_SDG_LHM T1, TBKOMMCOLLI_LHM T2 WHERE T.SDG_LHM_ID = T1.GUID AND T1.LHM_ID = T2.GUID AND T.SENDUNGNR = {0}", SDG) Dim DT As DataTable = ClassDatabase.Return_Datatable(sel, True) If Not DT Is Nothing Then GridControlPos.DataSource = DT End If Catch ex As Exception ShowError("Fehler in Refresh_POS: " & vbNewLine & ex.Message) End Try End Sub Sub Refresh_LHM(SDG As Integer) Try GridControlLHM.DataSource = Nothing 'hh GridViewLHM.Columns.Clear() Dim sel = String.Format("SELECT T.GUID,T1.LHM, T.POSINHALT, T.GEWICHT,T.FERTIG FROM TBKOMMCOLLI_SDG_LHM T, TBKOMMCOLLI_LHM T1 WHERE T.LHM_ID = T1.GUID AND T.SENDUNGNR = {0}", SDG) Dim DT As DataTable = ClassDatabase.Return_Datatable(sel, True) If Not DT Is Nothing Then GridControlLHM.DataSource = DT End If Catch ex As Exception End Try End Sub Sub AddNew_Colli() Try If cmbAuswMandant.SelectedIndex = -1 Then Exit Sub End If Select Case cmbAuswMandant.SelectedIndex Case 0 GridControlPos.DataSource = Nothing aktMandant = "HUP" btnPalfertig.Text = "Palette/LHM fertig" Dim sql = String.Format("INSERT INTO TBKOMMCOLLI_SENDUNGEN (ERSTELLTWER) VALUES ('{0}')", Environment.UserName) If ClassDatabase.Execute_non_Query(sql, True) = True Then AnzPaket = 0 sql = "SELECT MAX(GUID) FROM TBKOMMCOLLI_SENDUNGEN" CURRENT_SENDUNG = ClassDatabase.Execute_Scalar(sql, True) pnlPaketadd.Visible = False pnlHuP.Visible = True pnlHuP.Dock = DockStyle.Fill sql = "select GUID, LHM from TBKOMMCOLLI_LHM where AKTIV = 1 ORDER BY LHM" Dim DT As DataTable = ClassDatabase.Return_Datatable(sql, True) cmbLHM.DataSource = DT cmbLHM.DisplayMember = DT.Columns(1).ColumnName cmbLHM.ValueMember = DT.Columns(0).ColumnName CURR_LIEFADR = "" CURR_Ort = "" CURR_PLZ = "" CURR_Str = "" sql = "select PRINTER_NAME from TBKOMMCOLLI_MANDANT where KURZNAME = 'HuP'" CURR_IP_PRINTER = ClassDatabase.Execute_Scalar(sql) SDG_READY = False End If Case 1 aktMandant = "GLS" If txtPackstueck.Text <> String.Empty Then deactivate_Error() TBKOMMCOLLI_PAKET_KOPFTableAdapter.Insert(Me.cmbAuswMandant.SelectedValue, Environment.MachineName, Environment.UserName, txtPackstueck.Text, 0) AnzPaket = CInt(txtPackstueck.Text) CURRENT_SENDUNG = TBKOMMCOLLI_PAKET_KOPFTableAdapter.cmdGetMaxGUID() txtPackstueck.Text = "" Me.TBKOMMCOLLI_TERMINARTTableAdapter.Fill(Me.MyDataset.TBKOMMCOLLI_TERMINART, CType(Me.cmbAuswMandant.SelectedValue, Integer)) If CURRENT_SENDUNG > 0 Then cmbTerminart.SelectedIndex = cmbTerminart.FindStringExact("Standard") TBKOMMCOLLI_PAKET_KOPFTableAdapter.Fill(MyDataset.TBKOMMCOLLI_PAKET_KOPF, CURRENT_SENDUNG) pnlPaketadd.Visible = False pnlAddBarcodes.Visible = True pnlAddBarcodes.Dock = DockStyle.Fill txtScan.Focus() ListViewBarcodes.Items.Clear() cmbTerminart.Enabled = True End If Else ShowError("Fehlende Eingabe: " & vbNewLine & "Bitte füllen Sie alle Pflichtfelder aus") End If End Select Catch ex As Exception ShowError("Fehler in AddNew_Colli: " & vbNewLine & ex.Message) End Try End Sub Sub Refresh_Barcodes() Try TBKOMMCOLLI_PAKET_POSTableAdapter.Fill(MyDataset.TBKOMMCOLLI_PAKET_POS, CURRENT_SENDUNG) Dim DT As DataTable = MyDataset.TBKOMMCOLLI_PAKET_POS Dim Count As Integer = 0 ListViewBarcodes.Items.Clear() For Each row As DataRow In DT.Rows ListViewBarcodes.Items.Add(row.Item("GUID")) ListViewBarcodes.Items(Count).SubItems.Add(row.Item("BARCODE")) Count += 1 Next ' End If Me.lblInfoBarcodes.Text = "Zugeordnete Barcodes (Aktuell: " & Count & " Stück)" Catch ex As Exception ShowError("Fehler in Refresh_Barcodes: " & vbNewLine & ex.Message) End Try End Sub Private Sub btndeleteBarcode_Click(sender As System.Object, e As System.EventArgs) Handles btndeleteBarcode.Click Try Dim I As Integer For I = 0 To ListViewBarcodes.SelectedItems.Count - 1 TBKOMMCOLLI_PAKET_POSTableAdapter.Delete(ListViewBarcodes.SelectedItems(I).Text) tsinfolabel.Text = "Barcode erfolgreich gelöscht" Next TBKOMMCOLLI_PAKET_KOPFTableAdapter.Fill(MyDataset.TBKOMMCOLLI_PAKET_KOPF, CURRENT_SENDUNG) Refresh_Barcodes() tsinfolabel.Visible = True Catch ex As Exception ShowError("Fehler in Lösche Barcode: " & vbNewLine & ex.Message) End Try End Sub Private Function Delete_HUP() Try Dim del = String.Format("delete from TBKOMMCOLLI_SDGPOSITIONEN where SENDUNGNR = {0}", CURRENT_SENDUNG) If ClassDatabase.Execute_non_Query(del, False) = True Then del = String.Format("delete from TBKOMMCOLLI_SDG_LHM where SENDUNGNR = {0}", CURRENT_SENDUNG) If ClassDatabase.Execute_non_Query(del, False) = True Then del = String.Format("delete from TBKOMMCOLLI_HINWEIS where SENDUNGNR = {0}", CURRENT_SENDUNG) If ClassDatabase.Execute_non_Query(del, False) = True Then del = String.Format("delete from TBKOMMCOLLI_SENDUNGEN where GUID = {0}", CURRENT_SENDUNG) If ClassDatabase.Execute_non_Query(del, False) = True Then Return True Else Return False End If Else Return False End If Else Return False End If Else Return False End If Catch ex As Exception ShowError("Fehler in Abbruch Sendung: " & vbNewLine & ex.Message) Return False End Try End Function Private Sub tsbtnabbruch_Click(sender As System.Object, e As System.EventArgs) Handles tsbtnabbruch.Click Try Select Case aktMandant Case "HUP" Try If Delete_HUP() = True Then pnlHuP.Visible = False tsinfolabel.Visible = True tsinfolabel.Text = "Sendung erfolgreich gelöscht - " & Now.ToString End If Catch ex As Exception ShowError("Fehler in Abbruch Sendung: " & vbNewLine & ex.Message) End Try Case Else TBKOMMCOLLI_PAKET_POSTableAdapter.cmdDeleteKopfData(CURRENT_SENDUNG) TBKOMMCOLLI_PAKET_KOPFTableAdapter.Delete(CURRENT_SENDUNG) pnlAddBarcodes.Visible = False pnlPaketadd.Visible = False End Select tsbtnabbruch.Visible = False btnAddPaket.Enabled = True tsinfolabel.Text = "Vorgang abgebrochen" tsinfolabel.Visible = True ListBoxFortras.DataSource = Nothing 'ListBoxFortras.Items.Clear() txtFreitext.Text = "" txtHinweistext.Text = "" Catch ex As Exception ShowError("Fehler in Abbruch Paket: " & vbNewLine & ex.Message) End Try End Sub Private Sub btnAbschluss_Click(sender As System.Object, e As System.EventArgs) Handles btnAbschluss.Click If cmbTerminart.SelectedIndex = -1 Then ShowError("Fehlende Eingabe: " & vbNewLine & "Bitte wählen Sie eine Terminart aus der Auswahlliste") Exit Sub End If Try Dim GewichtGESAMT As Double GewichtGESAMT = CDbl(GESAMTGEWICHTTextBox.Text) GewichtGESAMT = GewichtGESAMT / AnzPaket If CDbl(GewichtGESAMT) > 40.0 Then MsgBox("Achtung: Das Gewicht des Packstücks überschreitet das Maximalgewicht von 40 kg!" & vbNewLine & "Bitte korrigieren Sie das Gewicht!", MsgBoxStyle.Critical, "Fehler") Exit Sub End If If CDbl(GewichtGESAMT) = 0.0 Then MsgBox("Achtung: Bitte geben Sie ein Gewicht ein!", MsgBoxStyle.Critical, "Fehler") GESAMTGEWICHTTextBox.Focus() GESAMTGEWICHTTextBox.SelectAll() Exit Sub End If If MyDataset.TBKOMMCOLLI_PAKET_POS.Rows.Count = 0 Then MsgBox("Achtung: Bitte scannen Sie mindestens einen Lieferschein!!", MsgBoxStyle.Critical, "Fehler") Exit Sub End If ' Fragen ob das Profil wirklich gelöscht werden soll Dim result As MsgBoxResult = MsgBox("Sind Sie sicher, dass sie das Paket abschliessen wollen?", MsgBoxStyle.YesNo, "Abschluss bestätigen") ' wenn das Profil gelöscht werden soll If result = MsgBoxResult.Yes Then Me.TBKOMMCOLLI_PAKET_KOPFTableAdapter.cmdUpdate_Gewicht(Environment.UserName, CDbl(Me.GESAMTGEWICHTTextBox.Text), Me.PAKET_IDTextBox.Text) TBKOMMCOLLI_PAKET_KOPFTableAdapter.CmdsetFertig(Environment.UserName, cmbTerminart.SelectedValue, CURRENT_SENDUNG) Me.pnlAddBarcodes.Visible = False pnlPaketadd.Visible = False tsbtnabbruch.Visible = False btnAddPaket.Enabled = True tsinfolabel.Text = "Paket " & PAKET_IDTextBox.Text & " erfolgreich abgeschlossen" tsinfolabel.Visible = True End If Catch ex As Exception ShowError("Fehler in Abschluss Paket: " & vbNewLine & ex.Message) End Try End Sub Private Sub BeendenToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles BeendenToolStripMenuItem.Click Me.Close() End Sub Private Sub AbschlussPaketeToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles AbschlussPaketeToolStripMenuItem.Click frmAbschluss.ShowDialog() End Sub Private Sub cmbTerminart_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles cmbTerminart.SelectedIndexChanged If cmbTerminart.SelectedIndex <> -1 Then deactivate_Error() End If End Sub Private Sub btnAddPaket_Click(sender As System.Object, e As System.EventArgs) Handles btnAddPaket.Click If Me.pnlPaketadd.Visible = False Then Me.TBWH_MANDANTTableAdapter.Fill(Me.MyDataset.TBWH_MANDANT) Me.pnlPaketadd.Visible = True Me.pnlPaketadd.Dock = DockStyle.Fill If My.Settings.Default_Mandant <> String.Empty Then cmbAuswMandant.SelectedIndex = cmbAuswMandant.FindStringExact(My.Settings.Default_Mandant) Else cmbAuswMandant.SelectedIndex = -1 End If txtPackstueck.Text = "" btnAddPaket.Enabled = False Me.tsbtnabbruch.Visible = True tsinfolabel.Visible = False End If End Sub Private Sub btnAbschlussPakete_Click(sender As System.Object, e As System.EventArgs) Handles btnAbschlussPakete.Click frmAbschluss.ShowDialog() End Sub Private Sub textbox_Focus(sender As System.Object, e As System.EventArgs) Handles txtPackstueck.GotFocus, GESAMTGEWICHTTextBox.GotFocus Dim box As TextBox = sender box.BackColor = Color.Lime End Sub Private Sub textbox_lostFocus(sender As System.Object, e As System.EventArgs) Handles txtPackstueck.LostFocus, GESAMTGEWICHTTextBox.LostFocus Dim box As TextBox = sender box.BackColor = Color.White End Sub Private Sub txtPackstueck_KeyUp(sender As System.Object, e As System.Windows.Forms.KeyEventArgs) Handles txtPackstueck.KeyUp If e.KeyCode = Keys.Return Then If txtPackstueck.Text <> String.Empty Then AddNew_Colli() End If End If End Sub Private Sub btndeletePaket_Click(sender As System.Object, e As System.EventArgs) Handles btndeletePaket.Click Try If txtPaketID.Text <> String.Empty Then ' Fragen ob das Profil wirklich gelöscht werden soll Dim result As MsgBoxResult = MsgBox("Sind Sie sicher, dass sie das Paket '" & Me.txtPaketID.Text & "' löschen wollen?", MsgBoxStyle.YesNo, "Löschen bestätigen") ' wenn das Profil gelöscht werden soll If result = MsgBoxResult.Yes Then TBKOMMCOLLI_PAKET_POSTableAdapter.cmdDelete_nachKopfID(Me.txtPaketID.Text) TBKOMMCOLLI_PAKET_KOPFTableAdapter.CMDDeletePaketnachID(Me.txtPaketID.Text) MsgBox("Paket erfolgreich gelöscht", MsgBoxStyle.Information, "Erfolgsmeldung:") Me.txtPaketID.Text = "" End If End If Catch ex As Exception ShowError("Fehler in Löschen von Paket: " & vbNewLine & ex.Message) End Try End Sub Private Sub cmbAuswMandant_SelectedIndexChanged(sender As Object, e As EventArgs) Handles cmbAuswMandant.SelectedIndexChanged Select Case cmbAuswMandant.SelectedIndex Case 0 lblpackstueck.Visible = False txtPackstueck.Visible = False btnAddNewColli.Text = "Neue Sendung" Case 1 lblpackstueck.Visible = True txtPackstueck.Visible = True btnAddNewColli.Text = "Neuer Colli" End Select End Sub Private Sub cmbLHM_SelectedIndexChanged(sender As Object, e As EventArgs) Handles cmbLHM.SelectedIndexChanged If cmbLHM.SelectedIndex <> -1 Then Me.txtScanHUP.Focus() Dim dd = cmbLHM.SelectedValue Try aktLHM_ID = cmbLHM.SelectedValue Catch ex As Exception End Try 'aktLHM_ID = cmbLHM.SelectedValue End If End Sub Private Sub txtScanHUP_KeyUp(sender As Object, e As KeyEventArgs) Handles txtScanHUP.KeyUp If e.KeyCode = Keys.Return Then If txtScanHUP.Text <> String.Empty Then If aktLHM_ID = 0 Then MsgBox("Bitte wählen Sie ein Ladehilfsmittel!", MsgBoxStyle.Information) cmbLHM.DroppedDown = True txtScanHUP.Text = "" Exit Sub End If If AddBarcodeHuP(txtScanHUP.Text) = False Then btnPrintOptions.Visible = True End If txtScanHUP.Text = "" End If End If End Sub Private Sub grvwGridPos_CellValueChanged(sender As Object, e As DevExpress.XtraGrid.Views.Base.CellValueChangedEventArgs) Handles grvwGridPos.CellValueChanged Try Dim column = e.Column.FieldName If column = "GEWICHT" Then Dim guid = grvwGridPos.GetFocusedRowCellValue(grvwGridPos.Columns("GUID")) Dim gewicht As String = e.Value gewicht = gewicht.Replace(",", ".") Dim upd = String.Format("UPDATE TBKOMMCOLLI_SDGPOSITIONEN SET GEWICHT = '{0}', GEAENDERTWER = '{2}' WHERE GUID = {1}", gewicht, guid, Environment.UserName) If ClassDatabase.Execute_non_Query(upd, True) = False Then End If ElseIf column = "POSINHALT" Then Dim guid = grvwGridPos.GetFocusedRowCellValue(grvwGridPos.Columns("GUID")) Dim POSINHALT As String = e.Value Dim upd = String.Format("UPDATE TBKOMMCOLLI_SDGPOSITIONEN SET POSINHALT = '{0}', GEAENDERTWER = '{2}' WHERE GUID = {1}", POSINHALT, guid, Environment.UserName) If ClassDatabase.Execute_non_Query(upd, True) = True Then upd = String.Format("UPDATE TBKOMMCOLLI_SDG_LHM SET POSINHALT = '{0}', GEAENDERTWER = '{1}' WHERE GUID = (SELECT SDG_LHM_ID FROM TBKOMMCOLLI_SDGPOSITIONEN WHERE GUID = {2})", POSINHALT, Environment.UserName, guid) ClassDatabase.Execute_non_Query(upd, True) End If End If Catch ex As Exception MsgBox("Error in grvwGridPos_CellValueChanged:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub btndeletePos_Click(sender As Object, e As EventArgs) Handles btndeletePosLHM.Click Try Dim guid = grvwGridPos.GetFocusedRowCellValue(grvwGridPos.Columns("GUID")) Dim del = String.Format("DELETE FROM TBKOMMCOLLI_SDGPOSITIONEN WHERE GUID = {0}", guid) If ClassDatabase.Execute_non_Query(del) = True Then tsinfolabel.Visible = True tsinfolabel.Text = "Position erfolgreich gelöscht - " & Now.ToString Refresh_POS(CURRENT_SENDUNG) End If Catch ex As Exception MsgBox("Error in btndeletePos_Click:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub btnPalfertig_Click(sender As Object, e As EventArgs) Handles btnPalfertig.Click Try Dim upd = String.Format("UPDATE TBKOMMCOLLI_SDG_LHM SET FERTIG = 1, FERTIGWER = '{1}', GEAENDERTWER = '{1}' WHERE GUID = {0}", aktLHM_SDG_ID, Environment.UserName) If ClassDatabase.Execute_non_Query(upd) = True Then upd = String.Format("UPDATE TBKOMMCOLLI_SDGPOSITIONEN SET FERTIG = 1, FERTIGWER = '{1}', GEAENDERTWER = '{1}' WHERE SDG_LHM_ID = {0}", aktLHM_SDG_ID, Environment.UserName) If ClassDatabase.Execute_non_Query(upd) = False Then Exit Sub End If SDG_READY = True If TabControl2.SelectedIndex = 0 Then Refresh_POS(CURRENT_SENDUNG) btndeletePosLHM.Text = "Lösche Position/Lieferschein" btndeletePosLHM.Enabled = True ElseIf TabControl2.SelectedIndex = 1 Then Refresh_LHM(CURRENT_SENDUNG) btndeletePosLHM.Text = "Lösche LHM" btndeletePosLHM.Enabled = False End If ' cmbLHM.Enabled = True ' cmbLHM.DroppedDown = True tsinfolabel.Visible = True tsinfolabel.Text = "Palette erfolgreich fertig gekennzeichnet - " & Now.ToString Else SDG_READY = False End If Catch ex As Exception MsgBox("Error in btndeletePos_Click:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub Button1_Click(sender As Object, e As EventArgs) Handles btnSendungFertig.Click Try Dim upd = String.Format("UPDATE TBKOMMCOLLI_SDG_LHM SET FERTIG = 1, FERTIGWER = '{1}', GEAENDERTWER = '{1}' WHERE SENDUNGNR = {0}", CURRENT_SENDUNG, Environment.UserName) If ClassDatabase.Execute_non_Query(upd) = True Then upd = String.Format("UPDATE TBKOMMCOLLI_SENDUNGEN SET FERTIG = 1, FERTIGWER = '{1}', GEAENDERTWER = '{1}' WHERE GUID = {0}", CURRENT_SENDUNG, Environment.UserName) If ClassDatabase.Execute_non_Query(upd) = True Then SDG_READY = True 'Sendungsdruck CURRENT_SENDUNG = CURRENT_SENDUNG pnlHuP.Visible = False tsbtnabbruch.Visible = False btnAddPaket.Enabled = True tsinfolabel.Text = "Vorgang abgebrochen" tsinfolabel.Visible = True 'ListBoxFortras.Items.Clear() ListBoxFortras.DataSource = Nothing frmPrintOptions.ShowDialog() GridControlLHM.DataSource = Nothing GridViewLHM.Columns.Clear() End If End If Catch ex As Exception MsgBox("Error in Set Sendung fertig:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub btnnewPallet_Click(sender As Object, e As EventArgs) Handles btnnewPallet.Click Dim result As MsgBoxResult = MsgBox("Sind Sie sicher, dass Sie eine neue Palette mit dem ausgewählten LHM anlegen wollen?", MsgBoxStyle.YesNo, "Bitte bestätigen") ' wenn das Profil gelöscht werden soll If result = MsgBoxResult.Yes Then Try Dim upd = String.Format("UPDATE TBKOMMCOLLI_SDGPOSITIONEN SET FERTIG = 1, FERTIGWER = '{1}', GEAENDERTWER = '{1}' WHERE SDG_LHM_ID = {0}", aktLHM_SDG_ID, Environment.UserName) If ClassDatabase.Execute_non_Query(upd) = False Then Exit Sub End If upd = String.Format("UPDATE TBKOMMCOLLI_SDG_LHM SET FERTIG = 1, FERTIGWER = '{1}', GEAENDERTWER = '{1}' WHERE GUID = {0}", aktLHM_SDG_ID, Environment.UserName) If ClassDatabase.Execute_non_Query(upd) = True Then Dim ins = String.Format("INSERT INTO TBKOMMCOLLI_SDG_LHM (SENDUNGNR,LHM_ID,ERSTELLTWER) VALUES ({0},{1},'{2}')", CURRENT_SENDUNG, cmbLHM.SelectedValue, Environment.UserName) If ClassDatabase.Execute_non_Query(ins, True) = True Then aktLHM_SDG_ID = ClassDatabase.Execute_Scalar("SELECT MAX(GUID) FROM TBKOMMCOLLI_SDG_LHM", True) If aktLHM_SDG_ID > 0 Then btnPalfertig.Text = "Palette (" & aktLHM_SDG_ID.ToString & ", " & cmbLHM.Text & ") fertig" Refresh_LHM(CURRENT_SENDUNG) 'ins = String.Format("INSERT INTO TBKOMMCOLLI_SDGPOSITIONEN (SENDUNGNR,SDG_LHM_ID,ERSTELLTWER) VALUES ({0},{1},'{2}')", CURRENT_SENDUNG, aktLHM_SDG_ID, Environment.UserName) 'If ClassDatabase.Execute_non_Query(ins, True) = False Then 'cmbLHM.Enabled = False ' Refresh_POS(CURRENT_SENDUNG) 'End If End If Else MsgBox("Konnte kein neues LHM anlegen...Log prüfen!", MsgBoxStyle.Exclamation) End If Refresh_POS(CURRENT_SENDUNG) ' cmbLHM.Enabled = True ' cmbLHM.DroppedDown = True End If Catch ex As Exception MsgBox("Error in btnnewPallet_Click:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End If End Sub Private Sub txtScanHUP_TextChanged(sender As Object, e As EventArgs) Handles txtScanHUP.TextChanged End Sub Private Sub Button1_Click_1(sender As Object, e As EventArgs) Handles Button1.Click If IsNothing(CURR_IP_PRINTER) Then MsgBox("Bitte wählen Sie den Versendertyp aus! (HuP oder GLS)", MsgBoxStyle.Information) Exit Sub End If 'frmLabel.ShowDialog() frmPrintOptions.ShowDialog() End Sub Public Sub New() DevExpress.XtraEditors.WindowsFormsSettings.DefaultFont = New Font("Segoe UI", 12) ' Dieser Aufruf ist für den Designer erforderlich. InitializeComponent() ' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu. End Sub Private Sub btnAddTextschlüssel_Click(sender As Object, e As EventArgs) Handles btnAddTextschlüssel.Click Try If cmbTextschlüssel.SelectedIndex <> -1 Then Dim ins = String.Format("INSERT INTO TBKOMMCOLLI_HINWEIS (SENDUNGNR,TEXTSCHLUSSEL_ID,TEXT,ERSTELLTWER) VALUES ({0},{1},'{2}','{3}')", CURRENT_SENDUNG, cmbTextschlüssel.SelectedValue, txtHinweistext.Text, Environment.UserName) If ClassDatabase.Execute_non_Query(ins) = True Then Me.txtHinweistext.Text = "" If IsNothing(ListBoxFortras.DataSource) Then Me.ListBoxFortras.DataSource = Me.TBKOMMCOLLI_HINWEISBindingSource Me.ListBoxFortras.DisplayMember = "BEZEICHNUNG" Me.ListBoxFortras.ValueMember = "GUID" End If Me.TBKOMMCOLLI_HINWEISTableAdapter.Fill(Me.MyDataset.TBKOMMCOLLI_HINWEIS, CURRENT_SENDUNG) tsinfolabel.Visible = True tsinfolabel.Text = "Update Textschlüssel erfolgreich - " & Now.ToString End If End If Catch ex As Exception MsgBox("Error in Add Textschlüssel:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub btnPrintOptions_Click(sender As Object, e As EventArgs) Handles btnPrintOptions.Click CURRENT_SENDUNG = CURRENT_SENDUNG frmPrintOptions.ShowDialog() End Sub Private Sub btnFreitext_Click(sender As Object, e As EventArgs) Handles btnFreitext.Click If txtFreitext.Text <> "" Then Dim Upd = String.Format("UPDATE TBKOMMCOLLI_SENDUNGEN SET BEMERKUNG = '{0}' WHERE GUID = {1}", txtFreitext.Text, CURRENT_SENDUNG) If ClassDatabase.Execute_non_Query(Upd, True) = True Then tsinfolabel.Visible = True tsinfolabel.Text = "Update Freitext erfolgreich - " & Now.ToString End If End If End Sub Private Sub btnChangeAdress_Click(sender As Object, e As EventArgs) Handles btnChangeAdress.Click frmAdressChange.ShowDialog() End Sub Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click Dim del = String.Format("DELETE FROM TBKOMMCOLLI_HINWEIS WHERE GUID = (SELECT MAX(GUID) FROM TBKOMMCOLLI_HINWEIS WHERE SENDUNGNR = {0})", CURRENT_SENDUNG) If ClassDatabase.Execute_non_Query(del) = True Then If IsNothing(ListBoxFortras.DataSource) Then Me.ListBoxFortras.DataSource = Me.TBKOMMCOLLI_HINWEISBindingSource Me.ListBoxFortras.DisplayMember = "BEZEICHNUNG" Me.ListBoxFortras.ValueMember = "GUID" End If Me.TBKOMMCOLLI_HINWEISTableAdapter.Fill(Me.MyDataset.TBKOMMCOLLI_HINWEIS, CURRENT_SENDUNG) tsinfolabel.Visible = True tsinfolabel.Text = "Löschen Textschlüssel erfolgreich - " & Now.ToString End If End Sub Private Sub TabControl2_SelectedIndexChanged(sender As Object, e As EventArgs) Handles TabControl2.SelectedIndexChanged Select Case TabControl2.SelectedIndex Case 0 btndeletePosLHM.Text = "Lösche Position/Lieferschein" btndeletePosLHM.Enabled = True Refresh_POS(CURRENT_SENDUNG) Case 1 Refresh_LHM(CURRENT_SENDUNG) btndeletePosLHM.Text = "Lösche LHM" btndeletePosLHM.Enabled = False End Select End Sub Private Sub GridViewLHM_CellValueChanged(sender As Object, e As CellValueChangedEventArgs) Handles GridViewLHM.CellValueChanged Try Dim column = e.Column.FieldName If column = "POSINHALT" Then Dim guid = GridViewLHM.GetFocusedRowCellValue(grvwGridPos.Columns("GUID")) Dim POSINHALT As String = e.Value Dim upd = String.Format("UPDATE TBKOMMCOLLI_SDG_LHM SET POSINHALT = '{0}', GEAENDERTWER = '{2}' WHERE GUID = {1}", POSINHALT, guid, Environment.UserName) If ClassDatabase.Execute_non_Query(upd, True) = True Then upd = String.Format("UPDATE TBKOMMCOLLI_SDGPOSITIONEN SET POSINHALT = '{0}', GEAENDERTWER = '{1}' WHERE SDG_LHM_ID = {2}", POSINHALT, Environment.UserName, guid) ClassDatabase.Execute_non_Query(upd, True) End If End If Catch ex As Exception MsgBox("Error in GridViewLHM.CellValueChanged:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub txtHinweistext_TextChanged(sender As Object, e As EventArgs) Handles txtHinweistext.TextChanged If txtHinweistext.Text <> String.Empty Then If txtHinweistext.Text.Length > 35 Then Dim text = txtHinweistext.Text text = txtHinweistext.Text.Substring(0, 35) txtHinweistext.Text = text txtHinweistext.SelectionStart = 36 MsgBox("Achtung, hier sind nur 35 Zeichen erlaubt!",MsgBoxStyle.Information) End If End If End Sub Private Sub pnlHuP_VisibleChanged(sender As Object, e As EventArgs) Handles pnlHuP.VisibleChanged txtFreitext.Text = "" txtHinweistext.Text = "" ListBoxFortras.DataSource = Nothing 'ListBoxFortras.Items.Clear() End Sub Private Sub txtFreitext_TextChanged(sender As Object, e As EventArgs) Handles txtFreitext.TextChanged If txtFreitext.Text.Length >= 70 Then MsgBox("Achtung: Maximale Anzahl Textzeichen erreicht!", MsgBoxStyle.Critical) End If End Sub End Class