Poslední věcí, kterou musíme naprogramovat, je změna množství v paletě. Uživatel si bude vybírat, zdali do palety přidává, nebo ubírá materiál. Změnu množství je možné dělat pouze tehdy, pokud je paleta ve stavu Vyskladněna. Uživateli také před vyplníme maximální hodnoty, které může přidat, nebo odebrat z palety. Než změny uložíme, provedeme kontroly. Pokud odebereme veškerý materiál z palety, zeptáme se uživatele, zda je možné označit paletu jako volnou a tím umožnit vkládat do palety jiný materiál.
Programový kód vložíme do regiónu #Region "Editace zaznamu".
#Region "Zmena obsahu palety"
Private Sub btnZmenaObsahuPalety_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnZmenaObsahuPalety.Click
'Kontrola, že paleta je vyskladněná
If Me.TblPaletyBindingSource.Current("Stav_pa") <> "V" Then
MsgBox("Paleta " + Me.TblPaletyBindingSource.Current("Cislo_Pa") + " není vyskladněna ")
Exit Sub 'prerusime proceduru
End If
'Deaktivace ostatnich ovladacich tlacitek
Me.pnlNavig.Enabled = False
Me.pnlEdit.Enabled = False
Me.pnlStav.Enabled = False
Me.pnlPrirad.Enabled = False
Me.btnZavrit.Enabled = False
Me.dgvTblPalety.Enabled = False
'Zprovozneni (aktivace) potvrzovacich tlacitek
Me.pnlPotvrdit.Enabled = True
'Aktivace polí pro zadávání ukládání do palety
Me.mtxtMnozstvi.Visible = True
Me.mtxtMnozstvi.Text = 0
Me.lblMnozstvi.Visible = True
Me.grbPridatUbrat.Visible = True
Me.btnMnozstviZmen.Visible = True
Me.btnMnozstviZrus.Visible = True
Me.mtxtMnozstvi.Focus()
Me.mtxtMnozstvi.SelectAll()
End Sub
Private Sub rdbPridatPaletu_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles rdbPridatPaletu.Click
Me.mtxtMnozstvi.Focus()
Me.mtxtMnozstvi.SelectAll()
ErrorProvider.SetError(Me.mtxtMnozstvi, "")
End Sub
Private Sub rdbUbratPaletu_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles rdbUbratPaletu.Click
Me.mtxtMnozstvi.Focus()
Me.mtxtMnozstvi.SelectAll()
ErrorProvider.SetError(Me.mtxtMnozstvi, "")
End Sub
Private Sub mtxtMnozstvi_GotFocus(ByVal sender As Object, ByVal e As System.EventArgs) Handles mtxtMnozstvi.GotFocus
If Me.rdbPridatPaletu.Checked Then
'Pridava se
Me.mtxtMnozstvi.Text = Me.txtMnoz_Do_Pa.Text - Me.txtMnoz_Pa.Text
Else
'Ubírá se
Me.mtxtMnozstvi.Text = Me.txtMnoz_Pa.Text
End If
End Sub
Private Sub mtxtMnozstvi_Validating(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles mtxtMnozstvi.Validating
'Kontrola, že zadané množství je kladné
ErrorProvider.SetError(Me.mtxtMnozstvi, "")
If mtxtMnozstvi.Text.Trim <> "" Then
If CInt(mtxtMnozstvi.Text) < 0 Then
MsgBox("Množství musí být >= 0")
ErrorProvider.SetError(Me.mtxtMnozstvi, "Množství musí být >= 0")
Exit Sub
End If
'Kontrola, že zadané množství nepřesáhne max. do pal.
If rdbPridatPaletu.Checked Then
'Přidávání do palety
If CInt(Me.txtMnoz_Pa.Text) + CInt(Me.mtxtMnozstvi.Text) > CInt(Me.txtMnoz_Do_Pa.Text) Then
MsgBox("Vkládané množství přesáhne max. do pal.")
ErrorProvider.SetError(Me.mtxtMnozstvi, "Vkládané množství přesáhne max. do pal.")
End If
Else
'Vybírání z palety
If CInt(Me.txtMnoz_Pa.Text) < CInt(Me.mtxtMnozstvi.Text) Then
MsgBox("Tolik v paletě není")
ErrorProvider.SetError(Me.mtxtMnozstvi, "Tolik v paletě není. Max. množství je " & Me.txtMnoz_Pa.Text)
End If
End If
Else
'neni nic zadane
ErrorProvider.SetError(Me.mtxtMnozstvi, "Množství musí být >= 0")
End If
End Sub
Private Sub btnMnozstviZrus_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnMnozstviZrus.Click
'Zneviditelnění zadávání materiálu do palety
Me.mtxtMnozstvi.Visible = False
Me.lblMnozstvi.Visible = False
Me.grbPridatUbrat.Visible = False
Me.btnMnozstviZmen.Visible = False
Me.btnMnozstviZrus.Visible = False
'aktivace ostatnich ovladacich tlacitek
Me.pnlNavig.Enabled = True
Me.pnlEdit.Enabled = True
Me.pnlStav.Enabled = True
Me.pnlPrirad.Enabled = True
Me.btnZavrit.Enabled = True
Me.dgvTblPalety.Enabled = True
End Sub
Private Sub btnMnozstviZmen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnMnozstviZmen.Click
'Kontrola, že zadané množství je kladné
ErrorProvider.SetError(Me.mtxtMnozstvi, "")
If mtxtMnozstvi.Text.Trim <> "" Then
If CInt(mtxtMnozstvi.Text) < 0 Then
Exit Sub
End If
'Kontrola, že zadané množství nepřesáhne max. do pal.
If rdbPridatPaletu.Checked Then
'Přidávání do palety
If CInt(Me.txtMnoz_Pa.Text) + CInt(Me.mtxtMnozstvi.Text) <= CInt(Me.txtMnoz_Do_Pa.Text) Then
Me.txtMnoz_Pa.Text = CInt(Me.txtMnoz_Pa.Text) + CInt(Me.mtxtMnozstvi.Text)
Me.txtMnoz_Celk.Text = CInt(Me.txtMnoz_Celk.Text) + CInt(Me.mtxtMnozstvi.Text)
Me.TblPaletyBindingSource.EndEdit()
Me.TableAdapterManager.UpdateAll(Me.DsPaletyMaterial)
'vypocitame celkove mnozstvi pomoci agregacni funkce
CelkoveMnozstvi()
Else
Exit Sub
End If
Else
'Vybírání z palety
If CInt(Me.txtMnoz_Pa.Text) >= CInt(Me.mtxtMnozstvi.Text) Then
Me.txtMnoz_Pa.Text = CInt(Me.txtMnoz_Pa.Text) - CInt(Me.mtxtMnozstvi.Text)
Else
Exit Sub
End If
'Je paleta prázdná ?
If CInt(Me.txtMnoz_Pa.Text) = 0 Then
If MsgBox("Vybráno všechno. Označit paletu s materiálem " & Me.txtNazev_Mat.Text & " jako volnou?", MsgBoxStyle.YesNo Or MsgBoxStyle.Question) = MsgBoxResult.Yes Then
'ano, označit jako volnou
Me.TblPaletyBindingSource.Current("cislo_mat") = DBNull.Value
Me.btnRezervace.Enabled = True
btnZmenaObsahuPalety.Enabled = False
End If
End If
Me.TblPaletyBindingSource.EndEdit()
Me.TableAdapterManager.UpdateAll(Me.DsPaletyMaterial)
'vypocitame celkove mnozstvi pomoci agregacni funkce
CelkoveMnozstvi()
'Bylo dosaženo minima ?
Try
If CInt(Me.txtMnoz_Celk.Text) <= CInt(Me.txtMnoz_Poj.Text) Then
MsgBox("Pozor, dosaženo minima")
End If
Catch ex As Exception
'neni paleta prirazena k materialu, tak predchozi test hodi chybu
End Try
End If
'Zneviditelnění zadávání materiálu do palety
Me.mtxtMnozstvi.Visible = False
Me.lblMnozstvi.Visible = False
Me.grbPridatUbrat.Visible = False
Me.btnMnozstviZmen.Visible = False
Me.btnMnozstviZrus.Visible = False
'aktivace ostatnich ovladacich tlacitek
Me.pnlNavig.Enabled = True
Me.pnlEdit.Enabled = True
Me.pnlStav.Enabled = True
Me.pnlPrirad.Enabled = True
Me.btnZavrit.Enabled = True
Me.dgvTblPalety.Enabled = True
Else
'neni nic zadane
Exit Sub
End If
End Sub
#End Region