Feature_Routenberechnung implementiert

This commit is contained in:
2022-10-07 16:13:36 +02:00
parent ed48c0eaef
commit 2b982ebb9a
8 changed files with 6651 additions and 198 deletions

View File

@@ -1,6 +1,8 @@
Imports System.CodeDom
Imports DocumentFormat.OpenXml.Bibliography
Imports Org.BouncyCastle.Utilities
Imports SDL
Imports Therefore.API
Public Class frmRoutendauerBerechnen
@@ -8,8 +10,10 @@ Public Class frmRoutendauerBerechnen
Dim SQL As New VERAG_PROG_ALLGEMEIN.SQL
Dim destination As String = ""
Dim departure As String
Dim transportmittel As String = "LKW"
Dim transportmittel As String = "LKW" 'Defaultvalue -> wird in Zukunft ev. noch erweitert (LKW, Sprinter, etc.)
Dim days As Integer = -1
Dim calcDays As Integer = -1
Dim destinationShortcut As String = ""
Sub New(dest As String)
@@ -20,45 +24,60 @@ Public Class frmRoutendauerBerechnen
End Sub
Function findDestinationAndReplaceToShortCut(destination As String) As String
Dim shortcut As String
shortcut = CStr(SQL.DLookup("[grz_ZollamtDST]", "[tblGrenzstelle]", "[grz_Grenzstelle]= '" & destination & "'", "AVISO", ""))
Return shortcut
End Function
Private Sub frmRoutendauerBerechnen_Load(sender As Object, e As EventArgs) Handles MyBase.Load
txtNach.Text = destination.ToString
txbAbgangsdatum._value = CStr(Date.Today())
initCheckBoxDepartment()
txtNach.Text = destination
destinationShortcut = findDestinationAndReplaceToShortCut(destination)
initComboboxDeparture()
txbAbgangsdatum._value = ""
End Sub
Sub initCheckBoxDepartment()
Sub initComboboxDeparture()
cbxVon.Items.Clear()
cbxVon.fillWithSQL("SELECT [nctsr_dauer_in_tagen], [nctsr_von] FROM [tblNTCSRouten] WHERE [nctsr_nach] = '" & destination & "'", False, "FMZOLL", False)
cbxVon.fillWithSQL("SELECT [nctsr_von], [nctsr_von_region] FROM [tblNTCSRouten] WHERE [nctsr_nach] = '" & destinationShortcut & "'", False, "FMZOLL", False)
cbxVon.Items.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("", ""))
cbxVon.changeItem("")
End Sub
Private Sub btnPlus_Click(sender As Object, e As EventArgs) Handles btnPlus.Click
'addDaysToGivenDate(1)
addDaysToGivenDate2(datVoraussichtlichesEintreffen, 1)
If checkIfDepartureDateIsFilled() = False Then Exit Sub
addDaysToGivenDate(txbVoraussichtlichesEintreffen, 1)
calcDays += 1
checkIfDepatureDateIsNotPast()
End Sub
Private Sub btnMinus_Click(sender As Object, e As EventArgs) Handles btnMinus.Click
addDaysToGivenDate2(datVoraussichtlichesEintreffen, -1)
'addDaysToGivenDate(-1)
If checkIfDepartureDateIsFilled() = False Then Exit Sub
addDaysToGivenDate(txbVoraussichtlichesEintreffen, -1)
calcDays -= 1
checkIfDepatureDateIsNotPast()
End Sub
Function calculateTripDuration() As Integer
Dim destination As String
'Dim destination As String
Dim departure As String
departure = cbxVon.Text
destination = txtNach.Text
departure = cbxVon._value
'destination = txtNach.Text
Try
days = CInt(SQL.DLookup("nctsr_dauer_in_tagen", "tblNTCSRouten", "[nctsr_von]='" & departure & "' AND [nctsr_nach]= '" & destination & "' AND [nctsr_route]= 'Landweg' AND [nctsr_tansportmittel]= '" & transportmittel & "'", "VERAG", -1))
days = CInt(SQL.DLookup("nctsr_dauer_in_tagen", "tblNTCSRouten", "[nctsr_von]='" & departure & "' AND [nctsr_nach]= '" & destinationShortcut & "' AND [nctsr_route]= 'Landweg' AND [nctsr_transportmittel]= '" & transportmittel & "'", "VERAG", -1))
Catch ex As Exception
VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name)
End Try
@@ -67,53 +86,114 @@ Public Class frmRoutendauerBerechnen
End Function
Private Sub cbxVon_SelectedValueChanged(sender As Object, e As EventArgs) Handles cbxVon.SelectedValueChanged
Private Sub addDaysToGivenDate(givenDate As VERAG_PROG_ALLGEMEIN.MyTextBox, days As Integer)
departure = cbxVon.Text
Dim calculatedDuration = calculateTripDuration()
txbVoraussichtlichesEintreffen._value = Convert.ToDateTime(givenDate._value).AddDays(days)
txbVoraussichtlichesEintreffen.Show()
If calculatedDuration > 0 Then
addDaysToGivenDate2(txbAbgangsdatum, calculatedDuration)
End If
lblberechneteDauer.Text = CStr(calcDuration())
lblberechneteDauer.Visible = True
End Sub
Private Sub addDaysTocurrentDate(days As Integer)
datVoraussichtlichesEintreffen._value = Convert.ToDateTime(txbAbgangsdatum._value).AddDays(days)
datVoraussichtlichesEintreffen.Show()
End Sub
Private Sub addDaysToGivenDate(days As Integer)
datVoraussichtlichesEintreffen._value = Convert.ToDateTime(datVoraussichtlichesEintreffen._value).AddDays(days)
datVoraussichtlichesEintreffen.Show()
End Sub
Private Sub addDaysToGivenDate2(givenDate As VERAG_PROG_ALLGEMEIN.MyTextBox, days As Integer)
datVoraussichtlichesEintreffen._value = Convert.ToDateTime(givenDate._value).AddDays(days)
datVoraussichtlichesEintreffen.Show()
End Sub
Private Sub btnOK_Click(sender As Object, e As EventArgs) Handles btnOK.Click
calculatedDate = CDate(datVoraussichtlichesEintreffen._value)
Close()
calculatedDate = CDate(txbVoraussichtlichesEintreffen._value)
' Close()
'btnOK.DialogResult = DialogResult.OK
End Sub
Private Sub btnCancel_Click(sender As Object, e As EventArgs) Handles btnCancel.Click
Close()
End Sub
Private Sub txbAbgangsdatum_TextChanged(sender As Object, e As EventArgs) Handles txbAbgangsdatum.TextChanged
Private Sub txbAbgangsdatum_TextChanged(sender As Object, e As EventArgs) Handles txbAbgangsdatum.TextChanged, cbxVon.SelectedValueChanged
If checkIfDepartureDateIsFilled() = False Then Exit Sub
days = calculateTripDuration()
calcDays = days
If days > 0 Then
addDaysToGivenDate2(txbAbgangsdatum, days)
addDaysToGivenDate(txbAbgangsdatum, days)
End If
checkIfDepatureDateIsNotPast()
End Sub
Function checkIfDepartureDateIsFilled() As Boolean
Dim isFilled = False
If txbAbgangsdatum._value = "" Then
lblWarning.Visible = True
lblDauer.Visible = False
lblberechneteDauer.Text = ""
lblberechneteDauer.Visible = False
btnOK.DialogResult = DialogResult.None
Else
lblWarning.Visible = False
isFilled = True
lblDauer.Visible = True
btnOK.DialogResult = DialogResult.OK
calcDuration()
End If
Return isFilled
End Function
Function checkIfDepatureDateIsNotPast() As Boolean
Dim depatureDateIsNotPast = False
If txbVoraussichtlichesEintreffen._value <> "" Then
If CDate(txbVoraussichtlichesEintreffen._value) >= CDate(Today().ToShortDateString) Then
depatureDateIsNotPast = True
lbWarningDateIsPast.Visible = False
btnOK.DialogResult = DialogResult.OK
btnMinus.Enabled = True
Else
btnOK.DialogResult = DialogResult.None
lbWarningDateIsPast.Visible = True
btnMinus.Enabled = False
End If
End If
Return depatureDateIsNotPast
End Function
Function calcDuration()
Dim result As Integer = 0
If txbVoraussichtlichesEintreffen._value <> "" Then
Dim StartDate = Convert.ToDateTime(txbAbgangsdatum._value)
Dim EndDate = Convert.ToDateTime(txbVoraussichtlichesEintreffen._value)
result = (EndDate - StartDate).Days
If (result < 0) Then
MsgBox("Transportdauer kann nicht negativ sein!")
btnOK.DialogResult = DialogResult.None
Else
btnOK.DialogResult = DialogResult.OK
End If
End If
Return result
End Function
End Class