Aktuální stav aplikace si můžete stáhnout zde .
Public Class frmPrehMat
#Region "Udalosti formulare"
Private Sub frmPrehMat_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Me.Cursor = Cursors.WaitCursor
'TODO: This line of code loads data into the 'DsData.tblPalety' table. You can move, or remove it, as needed.
Me.TblPaletyTableAdapter.Fill(Me.DsData.tblPalety)
'TODO: This line of code loads data into the 'DsData.tblMaterial' table. You can move, or remove it, as needed.
Me.TblMaterialTableAdapter.Fill(Me.DsData.tblMaterial)
'radit podle cisla materialu
rdbRaditCislaMat.Checked = True
Me.Cursor = Cursors.Default
End Sub
#End Region
#Region "grbRazeni"
Private Sub rdbRaditCislaMat_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles rdbRaditCislaMat.CheckedChanged
If rdbRaditCislaMat.Checked Then
Me.TblMaterialBindingSource.Sort = "Cislo_Mat"
Me.dgvTblMaterial.Focus()
End If
End Sub
Private Sub rdbRaditNazevMat_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles rdbRaditNazevMat.CheckedChanged
If rdbRaditNazevMat.Checked Then
Me.TblMaterialBindingSource.Sort = "Nazev_Mat"
Me.dgvTblMaterial.Focus()
End If
End Sub
#End Region
#Region "Navigace"
#Region "Ridici tlacitka"
Private Sub btnZavrit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnZavrit.Click
'otevrit formular frmRidici
Me.Cursor = Cursors.WaitCursor
Dim frmRidici As New frmRidici
frmRidici.MdiParent = MyFrmHlavni
frmRidici.Show()
Me.Close() 'zavrit tento formular
Me.Cursor = Cursors.Default
End Sub
Private Sub btnPrvni_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnPrvni.Click
'najit prvni zaznam
Me.TblMaterialBindingSource.MoveFirst()
Me.dgvTblMaterial.Focus()
End Sub
Private Sub btnPosledni_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnPosledni.Click
'najit posledni zaznam
Me.TblMaterialBindingSource.MoveLast()
Me.dgvTblMaterial.Focus()
End Sub
Private Sub btnKomentar_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnKomentar.Click
Me.txtKoment.Visible = Not Me.txtKoment.Visible
End Sub
#End Region
#End Region
#Region "Hledani"
Private Sub btnNajit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnNajit.Click
'aktivace tlacitek
Me.pnlNavig.Enabled = False
Me.pnlEdit.Enabled = False
Me.btnZavrit.Enabled = False
Me.grbRazeni.Enabled = False
'zviditelneni zadavaciho pole
Me.pnlNajit.Visible = True
Me.txtNajit.Text = ""
Me.txtNajit.Focus()
End Sub
Private Sub txtNajit_LostFocus(ByVal sender As Object, ByVal e As System.EventArgs) Handles txtNajit.LostFocus
'aktivace tlacitek
Me.pnlNavig.Enabled = True
Me.pnlEdit.Enabled = True
Me.btnZavrit.Enabled = True
Me.grbRazeni.Enabled = True
Dim foundIndex As Integer 'cislo radku odpovidajici kriteriu
If rdbRaditCislaMat.Checked Then
'foundIndex = TblMaterialBindingSource.Find("Cislo_Mat", Me.txtNajit.Text) 'presne hledani
foundIndex = SearchRows(TblMaterialBindingSource, "Cislo_Mat", Me.txtNajit.Text)
ElseIf rdbRaditNazevMat.Checked Then
'foundIndex = TblMaterialBindingSource.Find("Nazev_Mat", Me.txtNajit.Text)
foundIndex = SearchRows(TblMaterialBindingSource, "Nazev_Mat", Me.txtNajit.Text)
End If
If foundIndex > -1 Then
TblMaterialBindingSource.Position = foundIndex
End If
'zviditelneni zadavaciho pole
Me.pnlNajit.Visible = False
Me.txtNajit.Text = ""
End Sub
#End Region
#Region "Zmena radky zaznamu"
Private Sub TblMaterialBindingSource_PositionChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles TblMaterialBindingSource.PositionChanged
Cursor.Current = Cursors.WaitCursor
If TblMaterialBindingSource.Current("Koment").ToString.Length > 0 Then
Me.btnKomentar.Text = "KOMENTÁŘ" 'existuje komentar
Else
Me.btnKomentar.Text = "Komentář" 'neexistuje komentar
End If
'vypocitame celkove mnozstvi pomoci agregacni funkce
Dim strSQL As String
strSQL = "SELECT SUM(Mnoz_pa) AS CelkoveMnozstvi FROM tblPalety WHERE Cislo_Mat = '" & _
Me.TblMaterialBindingSource.Current("Cislo_Mat") & "' GROUP BY Cislo_Mat"
'nadefinujeme sluzbu pro pristup k databazi
Dim builder As New System.Data.OleDb.OleDbConnectionStringBuilder
builder.Provider = "Microsoft.ACE.OLEDB.12.0" 'Pristup do Access typu accdb
builder.DataSource = "|DataDirectory|\Data\Data.accdb"
'inicializace objektu spojení na databázi
Dim oledbcon As New OleDb.OleDbConnection
oledbcon.ConnectionString = builder.ConnectionString
oledbcon.Open() 'pomocí dat z ConnectionStringu spojení otevřeme
Dim cmd As New OleDb.OleDbCommand(strSQL, oledbcon) 'deklarace prikazu nad databazi pomoci SQL
Dim dataReader As OleDb.OleDbDataReader = cmd.ExecuteReader() 'spuštění dotazu a vytvoření objektu na čtení řádků
dataReader.Read() 'nacteme data z databaze s definovanym SQL prikazem
'ziskame celkove mnozstvi
Dim CelkoveMnozstvi As Integer
If dataReader.HasRows Then
'existují palety vybraneho materialu
CelkoveMnozstvi = dataReader("CelkoveMnozstvi")
Else
'neexistují palety vybraneho materialu
CelkoveMnozstvi = 0
End If
Me.txtMnoz_Celk.Text = CelkoveMnozstvi
dataReader.Close() '// nejdříve uzavřeme aktuální dotaz
oledbcon.Close() '// a pak i spojení
Cursor.Current = Cursors.Default
End Sub
#End Region
#Region "Editace zaznamu"
#Region "Ridici tlacitka"
Private Sub btnVlozit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnVlozit.Click
'zablokovat jiné možnosti, než změnu materiálu
Me.pnlNavig.Enabled = False
Me.pnlEdit.Enabled = False
Me.btnZavrit.Enabled = False
Me.grbRazeni.Enabled = False
Me.dgvTblMaterial.Enabled = False
Me.pnlVlozit.Visible = True
Me.txtVlozit.Text = "" 'vlozeni prazdneho retezce
Me.txtVlozit.Focus()
End Sub
Private Sub btnZmenit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnZmenit.Click
'zablokovat jiné možnosti, než změnu materiálu
Me.pnlNavig.Enabled = False
Me.pnlEdit.Enabled = False
Me.btnZavrit.Enabled = False
Me.grbRazeni.Enabled = False
Me.dgvTblMaterial.Enabled = False
'zviditelnit potvrzovací skupinu
Me.pnlPotvrdit.Visible = True
'uvolnit pole pro editaci
Me.cmbMerna_Jed.Enabled = True
Me.txtNazev_Mat.Enabled = True
Me.txtMnoz_Poj.Enabled = True
Me.txtMnoz_Do_Pa.Enabled = True
Me.txtKoment.Enabled = True
Me.cmbMerna_Jed.Focus()
End Sub
Private Sub btnOdstranit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnOdstranit.Click
Dim vys As MsgBoxResult
Dim dvPalety As New DataView(Me.DsData.tblPalety)
dvPalety.RowFilter = "Cislo_Mat = '" & Me.txtCislo_Mat.Text & "'"
If dvPalety.Count > 0 Then
'Material v nektere palete nalezen
MsgBox("Nelze zrušit. Materiál je v některé paletě", MsgBoxStyle.Exclamation)
Else
'Material v zadne palete nenalezen
vys = MsgBox("Opravdu chcete smazat tuto položku", MsgBoxStyle.Information + MsgBoxStyle.YesNo + MsgBoxStyle.DefaultButton2, "Smazat")
If vys = MsgBoxResult.Yes Then
'muzeme smazat material
TblMaterialBindingSource.RemoveCurrent()
End If
End If
End Sub
Private Sub btnUlozit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnUlozit.Click
Try
Me.Validate()
Me.TblMaterialBindingSource.EndEdit() 'ukonceni editace zaznamu
Me.TableAdapterManager.UpdateAll(Me.DsData) 'ulozeni vsech zmen do databaze
'zpristupneni tlacitek
Me.pnlNavig.Enabled = True
Me.pnlEdit.Enabled = True
Me.btnZavrit.Enabled = True
Me.grbRazeni.Enabled = True
Me.dgvTblMaterial.Enabled = True
'znepristupneni editacnich poli
Me.pnlPotvrdit.Visible = False
Me.cmbMerna_Jed.Enabled = False
Me.txtNazev_Mat.Enabled = False
Me.txtMnoz_Poj.Enabled = False
Me.txtMnoz_Do_Pa.Enabled = False
Me.txtKoment.Enabled = False
Catch ex As Exception
MsgBox(ex.ToString, MsgBoxStyle.Critical & MsgBoxStyle.OkOnly, "Chyba")
End Try
End Sub
Private Sub btnVratit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnVratit.Click
Me.TblMaterialBindingSource.CancelEdit() 'zruseni vsech provedenych zmen
'zpristupneni tlacitek
Me.pnlNavig.Enabled = True
Me.pnlEdit.Enabled = True
Me.btnZavrit.Enabled = True
Me.grbRazeni.Enabled = True
Me.dgvTblMaterial.Enabled = True
'znepristupneni editacnich poli
Me.pnlPotvrdit.Visible = False
Me.cmbMerna_Jed.Enabled = False
Me.txtNazev_Mat.Enabled = False
Me.txtMnoz_Poj.Enabled = False
Me.txtMnoz_Do_Pa.Enabled = False
Me.txtKoment.Enabled = False
End Sub
#End Region
#Region "Vlozeni noveho zaznamu"
Private Sub txtVlozit_LostFocus(ByVal sender As Object, ByVal e As System.EventArgs) Handles txtVlozit.LostFocus
Dim foundIndex As Integer
Dim VkladanyText As String = Me.txtVlozit.Text
foundIndex = TblMaterialBindingSource.Find("Cislo_Mat", VkladanyText)
If foundIndex >= 0 Then
MsgBox("Takový materiál již existuje", MsgBoxStyle.Exclamation, "Nelze vložit")
Me.pnlNavig.Enabled = True
Me.pnlEdit.Enabled = True
Me.btnZavrit.Enabled = True
Me.grbRazeni.Enabled = True
Me.dgvTblMaterial.Enabled = True
Else
'zablokovat jiné možnosti, než změnu materiálu
Me.pnlNavig.Enabled = False
Me.pnlEdit.Enabled = False
Me.btnZavrit.Enabled = False
Me.grbRazeni.Enabled = False
Me.dgvTblMaterial.Enabled = False
'zviditelnit potvrzovací skupinu
Me.pnlPotvrdit.Visible = True
'uvolnit pole pro editaci
Me.cmbMerna_Jed.Enabled = True
Me.txtNazev_Mat.Enabled = True
Me.txtMnoz_Poj.Enabled = True
Me.txtMnoz_Do_Pa.Enabled = True
Me.txtKoment.Enabled = True
'nastaveni pocatecnich hodnot pro nove zaznamy
With DsData.tblMaterial
.Cislo_MatColumn.DefaultValue = Me.txtVlozit.Text.Trim
.Merna_JedColumn.DefaultValue = "ks"
.Mnoz_Do_PaColumn.DefaultValue = 1
.Mnoz_PojColumn.DefaultValue = 1
.DatumColumn.DefaultValue = Date.Today
End With
Me.TblMaterialBindingSource.AddNew() 'vytvori se novy zaznam
Me.txtMnoz_Celk.Text = 0
Me.txtNazev_Mat.Focus()
End If
Me.pnlVlozit.Visible = False
End Sub
#End Region
#Region "Kontrola vstupnich dat"
Private Sub txtMnoz_Poj_Validating(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles txtMnoz_Poj.Validating
If Not KontrolaNaKladnyInteger(sender, 1, Integer.MaxValue) Then
e.Cancel = True
End If
End Sub
Private Sub txtMnoz_Do_Pa_Validating(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles txtMnoz_Do_Pa.Validating
If Not KontrolaNaKladnyInteger(sender, 1, Integer.MaxValue) Then
e.Cancel = True
End If
End Sub
Private Function KontrolaNaKladnyInteger(ByRef sender As Object, ByVal MinHodnota As Integer, ByVal MaxHodnota As Integer) As Boolean
Me.ErrorProvider1.SetError(sender, "")
Dim num As Integer
'If Not IsNumeric(Me.txtMnoz_Poj.Text) Then
If Not Integer.TryParse(sender.text, num) OrElse num < MinHodnota OrElse num > MaxHodnota Then
Me.ErrorProvider1.SetError(sender, "Musíte zadat celé číslo v rozsahu " & MinHodnota.ToString & " až " & MaxHodnota.ToString)
Me.pnlPotvrdit.Enabled = False
Return False
Else
Me.pnlPotvrdit.Enabled = True
Return True
End If
End Function
Private Sub txtVlozit_Validating(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles txtVlozit.Validating
Me.ErrorProvider1.SetError(sender, "")
If sender.text.Length <> 10 Then
Me.ErrorProvider1.SetError(sender, "Číslo materiálu musí obsahovat 10 znaků")
e.Cancel = True
End If
End Sub
Private Sub txtNazev_Mat_Validating(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles txtNazev_Mat.Validating
Me.ErrorProvider1.SetError(sender, "")
If sender.text.Length = 0 Then
Me.ErrorProvider1.SetError(sender, "Název materiálu musí být zadán")
e.Cancel = True
End If
End Sub
#End Region
#End Region
End Class