Příklady VB.NET VS 2008

 

Jiří Strach

 

 

 

2008

 

 

Příklady VB.NET VS 2008

1.Kalkulátor. 1 - Zadání

2.Kostky. 4 - Zadání

· Třída Kostka. 4

· Třída KostkaMenu. 6

· Třída Kostka1. 7

· Třída Kostka 2. 8

· Třída Kostka 3. 8

3.Soubory. 9 - Zadání

· Třída SouboryMenu. 9

· Třida SouborRTF. 13

· Třída DvouPrimPris. 16

· Třída  DvouDatabase. 19

· Třída střední vrstvy Osoba4. 21

· Třida TriPrimPris. 24

· Třída střední vrstvy Osoba1. 27

· Třida Tridatabaze. 31

· Třída Učitel – dědí třídu soubory.TriDatabaze. 34

4.Mapy. 34 - Zadání

· Třída MapyMenu. 34

· Třída Test 36

5.Testy. 40 - Zadání

Třída ProgramTesty. 40

Třída T1. 43

Třída T11. 46

Třída T2. 48

Třída T22. 51

1.  Kalkulátor

Public Class Kalkulator

    'Přepínání tlačítka operací

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        Select Case Button1.Text

            Case "+"

                Button1.Text = "-"

            Case "-"

                Button1.Text = "x"

            Case "x"

                Button1.Text = ":"

            Case ":"

                Button1.Text = "+"

        End Select

    End Sub

 

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click

        Carka(TextBox1.Text) 'Volání prpcedury pro přepsání desetiné čárky na tečku

        Carka(TextBox2.Text) 'Volání prpcedury pro přepsání desetiné čárky na tečku

        Select Case Button1.Text

            Case "+"

                TextBox3.Text = Val(TextBox1.Text) + Val(TextBox2.Text)

            Case "-"

                TextBox3.Text = Val(TextBox1.Text) - Val(TextBox2.Text)

            Case "x"

                TextBox3.Text = Val(TextBox1.Text) * Val(TextBox2.Text)

            Case ":"

                TextBox3.Text = Val(TextBox1.Text) / Val(TextBox2.Text)

        End Select

        Carka1(TextBox1.Text) 'Volání prpcedury pro přepsání desetiné tečky na čárku

        Carka1(TextBox2.Text)

    End Sub

    'Procedury pro vymazání TextBoxů

    Private Sub TextBox1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox1.Click

        TextBox1.Clear()

    End Sub

    Private Sub TextBox2_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox2.Click

        TextBox1.Clear()

    End Sub

    'Tato procedura je nutná, neboť v Česku se používá desetiná čárka a v USA desetiná tečka

    'VB pracuje pouze s desetinou tečkou

    Private Sub Carka(ByRef M1 As String)

        Dim a, b As String

        a = ","

        b = "."

        M1 = M1.Replace(a, b)

    End Sub

    'Tato procedura je nutná, neboť v Česku se používá desetiná čárka a v USA desetiná tečka

    'VB pracuje pouze s desetinou tečkou

    Private Sub Carka1(ByRef M1 As String)

        Dim a, b As String

        a = "."

        b = ","

        M1 = M1.Replace(a, b)

    End Sub

 

    Private Sub TextBox1_KeyUp(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles TextBox1.KeyUp

        Select Case e.KeyCode

            Case Keys.Enter 'Reakce na klávesu "Enter"

                TextBox2.Select()

        End Select

 

    End Sub

 

    Private Sub TextBox2_KeyUp(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles TextBox2.KeyUp

        Dim a As System.Object

        Dim b As System.EventArgs

        Dim pom As String

        Select Case e.KeyValue

            Case 13   'Reakce na klávesu "Enter"

                Button2_Click(a, b)

                Button2.Select()

            Case 107             'Reakce na klávesu "+"

                Button1.Text = "+"

                Button2_Click(a, b)

                uprav1(TextBox2.Text)

                Button2.Select()

            Case 106                'Reakce na klávesu "*"

                Button1.Text = "x"

                Button2_Click(a, b)

                uprav1(TextBox2.Text)

                Button2.Select()

            Case 109

                Button1.Text = "-"  'Reakce na klávesu "-"

                Button2_Click(a, b)

                uprav1(TextBox2.Text)

                Button2.Select()

            Case 111                'Reakce na klávesu "/"

                Button1.Text = ":"

                Button2_Click(a, b)

                uprav1(TextBox2.Text)

                Button2.Select()

        End Select

    End Sub

    Private Sub Button2_KeyUp(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Button2.KeyUp

        Select Case e.KeyValue

            Case 13 'Reakce na klávesu "Enter"

                TextBox1.Select()

                TextBox1.Clear()

                TextBox2.Clear()

                TextBox3.Clear()

        End Select

    End Sub

    'Tato procedura umazává písmena (+,-,*,/) při zadání operace z klávesnice

    Private Sub uprav1(ByRef a As String)

        a = a.Substring(0, a.Length - 1)

    End Sub

End Class

2.    Kostky

·         Třída Kostka

'Nová třída pro vytváření kostky na Formuláři Windows

Public Class Kostka

    Dim vHodnota As Integer 'Deklarace vnitřních proměných objektu

    Dim frmF As Object

    Dim p, q As Integer

    Dim vObrazek As PictureBox

    Sub New()

        Randomize() 'Spuštění generátoru náhodných čísel

    End Sub

    Public Sub Hod() 'Veřejná metoda vyvolávající událost "Hoď kostkou" jako zprávu vyšle zprávu Hodnota

        Static b As Integer

        Do

            vHodnota = Int((6 * Rnd() + 1)) 'Úprava čísla od 1 do 6

        Loop Until vHodnota > 0 And vHodnota < 7 And b <> vHodnota

        b = vHodnota

    End Sub

    'Procedura pro vykreslení kruhu

    Private Sub kruh(ByVal X As Integer, ByVal Y As Integer, ByVal Prumer As Single)

        Dim I As Short

        Dim pen As New Drawing.Pen(System.Drawing.Color.Red, 1) 'Nastavení barvy a tloušťky čáry

        For I = 0 To Prumer

            'Vykreslení kruhu na formulář na zadané souřadnice X a Y

            frmF.CreateGraphics.DrawEllipse(pen, X + (Prumer - I) / 2, Y + (Prumer - I) / 2, I, I)

        Next I

        pen.Dispose() 'Zrušení pera

    End Sub

 

    Private Sub kruh1(ByVal X As Integer, ByVal Y As Integer, ByVal Prumer As Single)

        Dim I As Short

        Dim pen As New Drawing.Pen(System.Drawing.Color.Red, 1)

        For I = 0 To Prumer

            'Vykreslení kruhu nado obrázku na zadané souřadnice X a Y

            vObrazek.CreateGraphics.DrawEllipse(pen, X + (Prumer - I) / 2, Y + (Prumer - I) / 2, I, I)

        Next I

        pen.Dispose() 'Zrušení pera

    End Sub

    'Veřejná procedura, pro zaslání koleček hozené kostky na formulář

    Public Sub Hod1()

        Dim X As Integer

        Dim y As Integer

        Dim d As Integer

        p = Int(frmF.Width / 6)  'relativní  vzdálenost kruhů dle šířky formuláře ve směru souřadnice x

        q = Int(frmF.Height / 6) 'relativní vzdálenost kruhú dle výšky formuláře ve směru souřadnice y

        Hod() 'hod - získá se číslo od 1 do 6

        X = Int(frmF.Width / 2 - q / 2) 'Počátek souřadnic dle šířky formuláře

        y = Int(frmF.Height / 2 - q / 2) 'Počátek souřadnic dle výšky formuláře

        frmF.CreateGraphics.Clear(System.Drawing.Color.LightGray) 'Vymazání předchozího hodu

        d = Int(frmF.Width / 9) 'Průměr kruhu dle šířky formuláře

        'Vykreslení kruhů podle hozené hodnoty "vHodnota"

        Select Case vHodnota

            Case 1

                kruh(X, y, d)

            Case 2

                kruh(X, y + q, d)

                kruh(X, y - q, d)

            Case 3

                kruh(X, y, d)

                kruh(X + p, y + q, d)

                kruh(X - p, y - q, d)

            Case 4

                kruh(X - p, y + q, d)

                kruh(X + p, y + q, d)

                kruh(X - p, y - q, d)

                kruh(X + p, y - q, d)

            Case 5

                kruh(X, y, d)

                kruh(X - p, y + q, d)

                kruh(X + p, y + q, d)

                kruh(X - p, y - q, d)

                kruh(X + p, y - q, d)

            Case 6

                kruh(X - p, y + q, d)

                kruh(X + p, y + q, d)

                kruh(X - p, y - q, d)

                kruh(X + p, y - q, d)

                kruh(X + p, y, d)

                kruh(X - p, y, d)

        End Select

    End Sub

    'Rozhraní pro zaslání zprávy o jménu formuláře do kterého se má kreslit

    Public Property ObjektProZobrazeni() As Object

        Get

            ObjektProZobrazeni = frmF

        End Get

        Set(ByVal Value As Object)

            frmF = Value

        End Set

    End Property

    'Veřejná procedura, pro zaslání koleček hozené kostky do obrázku (PictureBox)

    'Rozhraní pro zaslání zprávy jaká hodnota byla kostkou hozena

    Public Property Hodnota() As Integer

        Get

            Hodnota = vHodnota

        End Get

        Set(ByVal Value As Integer)

        End Set

    End Property

    'Rozhraní pro zaslání zprávy o jménu obrázku (PictureBoxu) do kterého se má kreslit

End Class

 

·         Třída KostkaMenu

 


 

Public Class KostkaMenu_

    Dim a As Form   'Vytvoření formulářů

       Private Sub Kostka1ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles _

    Kostka1ToolStripMenuItem.Click

        If a IsNot Nothing Then a.close()

        a = New Kostka1

        a.MdiParent() = Me 'Vlání formuláře jko dítě formuláře1

        a.Show()           'Zobrazení formuláře

        Me.Width = a.Width + 50

        Me.Height = a.Height + 100

    End Sub

 

    Private Sub Kostka2ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles _

    Kostka2ToolStripMenuItem.Click

        If a IsNot Nothing Then a.Close()

        a = New Kostka2

        a.MdiParent() = Me 'Vlání formuláře jko dítě formuláře1

        a.Show()           'Zobrazení formuláře

        Me.Width = a.Width + 50

        Me.Height = a.Height + 100

    End Sub

 

    Private Sub Kostka3ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles _

    Kostka3ToolStripMenuItem.Click

        If a IsNot Nothing Then a.Close()

        a = New Kostka3

        a.MdiParent() = Me 'Vlání formuláře jko dítě formuláře1

        a.Show()           'Zobrazení formuláře

        Me.Width = a.Width + 50

        Me.Height = a.Height + 100

    End Sub

    Private Sub KonecToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles _

    KonecToolStripMenuItem.Click

        a.Dispose()

        Me.Dispose()

        End

   End Sub    Private Sub KostkaMenu__Load(ByVal sender As System.Object, ByVal e As _ System.EventArgs) Handles MyBase.Load

    End Sub

End Class

·         Třída Kostka1

 


 


Public Class Kostka1

    Dim Ko As New Kostka 'vytváření objektu Ko ze třídy Kostka

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As _ System.EventArgs) Handles Button1.Click

        Ko.Hod()     'Volaní metody Hod

        Label1.Text = Ko.Hodnota   'Zobrazení hodu v popisce

    End Sub

End Class

·         Třída Kostka 2

 

 

 

 

 

 

 

 

 

 

 


Public Class Kostka2

    Private Sub Kostka2_Click(ByVal sender As Object, ByVal e As _ System.EventArgs) Handles Me.Click

        Dim ko As New Kostka 'vytvoření objekru Ko ze třídy Kostka

        ko.ObjektProZobrazeni = Me 'Poslání objektu na kterém se má objevit

                                    'kostka

        ko.Hod1() 'Hod kostkou

    End Sub

End Class

·         Třída Kostka 3

 

 

 

 

 

 

 

 

 

 

 

 

 

Public Class Kostka3

    Dim ko As New Kostka

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        ko.ObjektProZobrazeni = PictureBox1

        ko.Hod1()

    End Sub

 

    Private Sub Button2_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button2.Click

        ko.ObjektProZobrazeni = PictureBox2

        ko.Hod1()

    End Sub

End Class

 

3.    Soubory

·         Třída SouboryMenu

 

 

 

 

 

 

 

 


Public Class SouboryMenu

    Dim A1 As TextovySoubor  'Vytvořeí formulářů

    Dim A2 As SouborRTF

    Dim A3 As DvouPrimPris

    Dim A4 As DvouDatabase

    Dim A5 As TriPrimPris

    Dim A6 As TriDatabaze

    Dim A7 As ucitel

    Private Sub TextovýSouborToolStripMenuItem_Click(ByVal sender As  System.Object, ByVal e As System.EventArgs) Handles TextovýSouborToolStripMenuItem.Click

        On Error Resume Next

        A1 = New TextovySoubor

        Me.Menu.GetMainMenu() 'Navrat k základnímu Menu

        Me.Width = A1.Width + 100 'Určení velikosti Mdi formuáře

        Me.Height = A1.Height + 150

        A1.MdiParent = Me 'určení formuláře jako dítětš

        A1.Show() 'Zobrazeni formuáře

        A2.Close() 'Zavření ostatních

        A3.Close()

        A4.Close()

        A5.Close()

        A6.Close()

        A7.Close()

    End Sub

 

    Private Sub SouborRTFToolStripMenuItem_Click(ByVal sender As  System.Object, ByVal e As System.EventArgs) Handles SouborRTFToolStripMenuItem.Click

        On Error Resume Next

        A2 = New SouborRTF

        Me.Menu.GetMainMenu() 'Navrat k základnímu Menu

        Me.Width = A2.Width + 200 'Určení velikosti Mdi formuáře

        Me.Height = A2.Height + 150

        A2.Top = 0

        A2.MdiParent = Me 'určení formuláře jako dítětš

        A2.Show() 'Zobrazeni formuáře

        A1.Close() 'Zavření ostatních

        A3.Close()

        A4.Close()

        A5.Close()

        A6.Close()

        A7.Close()

    End Sub

 

    Private Sub SouborSPřímýmPřístupemToolStripMenuItem_Click(ByVal sender  As System.Object, ByVal e As System.EventArgs) Handles SouborSPřímýmPřístupemToolStripMenuItem.Click

        On Error Resume Next

        A3 = New DvouPrimPris

        Me.Menu.GetMainMenu() 'Navrat k základnímu Menu

        Me.Width = A3.Width + 200 'Určení velikosti Mdi formuáře

        Me.Height = A3.Height + 150

        A3.MdiParent = Me 'určení formuláře jako dítětš

        A3.Show() 'Zobrazeni formuáře

        A2.Close() 'Zavření ostatních

        A1.Close()

        A4.Close()

        A5.Close()

        A6.Close()

        A7.Close()

    End Sub

 

    Private Sub DatabázovýSouborToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles DatabázovýSouborToolStripMenuItem.Click

        On Error Resume Next

        A4 = New DvouDatabase

        Me.Menu.GetMainMenu() 'Navrat k základnímu Menu

        Me.Width = A5.Width + 200 'Určení velikosti Mdi formuáře

        Me.Height = A4.Height + 150

        A4.MdiParent = Me 'určení formuláře jako dítětš

        A4.Show() 'Zobrazeni formuáře

        A2.Close() 'Zavření ostatních

        A1.Close()

        A3.Close()

        A5.Close()

        A6.Close()

        A7.Close()

    End Sub

 

    Private Sub SouborSPřímýmPřísstupemToolStripMenuItem_Click(ByVal sender  As System.Object, ByVal e As System.EventArgs) Handles SouborSPřímýmPřísstupemToolStripMenuItem.Click

        On Error Resume Next

        A5 = New TriPrimPris

        Me.Menu.GetMainMenu() 'Navrat k základnímu Menu

        Me.Width = A5.Width + 100 'Určení velikosti Mdi formuáře

        Me.Height = A5.Height + 150

        A5.MdiParent = Me 'určení formuláře jako dítětš

        A5.Show() 'Zobrazeni formuáře

        A2.Close() 'Zavření ostatních

        A3.Close()

        A4.Close()

        A1.Close()

        A6.Close()

        A7.Close()

    End Sub

 

    Private Sub DaabázovýSouborToolStripMenuItem_Click(ByVal sender As _ System.Object, ByVal e As System.EventArgs) Handles DaabázovýSouborToolStripMenuItem.Click

        On Error Resume Next

        A6 = New TriDatabaze

        Me.Menu.GetMainMenu() 'Navrat k základnímu Menu

        Me.Width = A6.Width + 100 'Určení velikosti Mdi formuáře

        Me.Height = A6.Height + 150

        A6.MdiParent = Me 'určení formuláře jako dítětš

        A6.Show() 'Zobrazeni formuáře

        A2.Close() 'Zavření ostatních

        A3.Close()

        A4.Close()

        A1.Close()

        A5.Close()

        A7.Close()

    End Sub

 

    Private Sub DatabázovýSouborSVyužitímDědičnostiToolStripMenuItem_Click  (ByVal sender As System.Object, ByVal e As System.EventArgs) Handles _ DatabázovýSouborSVyužitímDědičnostiToolStripMenuItem.Click

        On Error Resume Next

        A7 = New ucitel

        Me.Menu.GetMainMenu() 'Navrat k základnímu Menu

        Me.Width = A7.Width + 100 'Určení velikosti Mdi formuáře

        Me.Height = A7.Height + 150

        A7.MdiParent = Me 'určení formuláře jako dítětš

        A7.Show() 'Zobrazeni formuáře

        A2.Close() 'Zavření ostatních

        A3.Close()

        A4.Close()

        A1.Close()

        A5.Close()

        A6.Close()

    End Sub

End Class

·         Třída TextovySoubor

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 


Public Class TextovySoubor

    'Procedura pro "Uložení textu"

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As _ System.EventArgs) Handles Button1.Click

        On Error GoTo Chyba 'Zachycení chyby způsbené opětovným otevřením souboru

Navrat: FileOpen(1, "Text.txt", OpenMode.Append) 'Otevření souboru

        PrintLine(1, TextBox1.Text) ' Zápis

        FileClose(1)

        TextBox1.Clear()

        Exit Sub

Chyba:  FileClose(1) 'Činnost při chybě

        GoTo Navrat

    End Sub

    'Procedura skok na začátek souboru

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As _ System.EventArgs) Handles Button2.Click

        TextBox2.Clear()

        On Error Resume Next

        FileClose(1)

    End Sub

    'Procedura "Čtení po jednotlivých záznamech

    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As _ System.EventArgs) Handles Button3.Click

        TextBox2.Clear()

        On Error Resume Next 'Zachycení chyby způsbené opětovným otevřením souboru

        FileOpen(1, "Text.txt", OpenMode.Input) 'Otevření pro čtení

        Input(1, TextBox2.Text) 'Čtení  záznamu ze souboru

              If EOF(1) Then

                Input(1, TextBox2.Text)

                MsgBox("Konec souboru")

                FileClose(1)

        End If

    End Sub

    'Procedura pro "Čtení celého souboru

    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As _ System.EventArgs) Handles Button4.Click

        Dim CelyText, RadekTextu As String

        TextBox2.Clear()

        On Error GoTo Chyba 'Zachycení chyby způsbené opětovným otevřením souboru

Navrat: FileOpen(1, "Text.txt", OpenMode.Input) 'Otevření souboru pro čtení

        Do Until EOF(1) 'Cyklus načtení všech řádek souboru

            RadekTextu = LineInput(1)

            CelyText = CelyText & RadekTextu & vbCrLf

        Loop

        TextBox2.Text = CelyText 'Zápis celého souboru do TextBoxu2   

        Exit Sub

Chyba:  FileClose(1) 'Činnost při chybě

        GoTo Navrat

    End Sub

    'Procedura mazání souboru

    Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As _  System.EventArgs) Handles Button5.Click

        On Error GoTo Chyba

Navrat: FileOpen(1, "Text.txt", OpenMode.Output) 'Destruktivní otevření souboru starý soubor se vymaže

        FileClose(1)

        Exit Sub

Chyba:  FileClose(1)

        GoTo Navrat

    End Sub

End Class

·         Třida SouborRTF

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 


Public Class SouborRTF

    Dim soubor As String

    'Procedura pro otevření souboru

    Private Sub OtevřeníToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles OtevřeníToolStripMenuItem.Click

        'Otevření dialogu pro otevření soubiru využívá se object OpenFileDialog

        OpenFileDialog1.Filter = "Text files (*.txt)|*.txt|Ritchtext file (*.rtf)|*.rtf"

        OpenFileDialog1.ShowDialog()

        Soubor = OpenFileDialog1.FileName

        RichTextBox1.Clear()

        If OpenFileDialog1.FilterIndex.ToString = 2 Then RichTextBox1.LoadFile(Soubor, RichTextBoxStreamType.RichText)

        If OpenFileDialog1.FilterIndex.ToString = 1 Then RichTextBox1.LoadFile(Soubor, RichTextBoxStreamType.PlainText)

 

    End Sub

    'Procedura pro zápis souboru na disk

    Private Sub UloženíToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles UloženíToolStripMenuItem.Click

        'Otevření dialogu pro zápis do souboru využívá se objekt  SaveFileDialog

        SaveFileDialog1.Filter = "Text files (*.txt)|*.txt|Ritchtext file (*.rtf)|*.rtf"

        If (soubor Is Nothing) Then

            SaveFileDialog1.ShowDialog()

            soubor = SaveFileDialog1.FileName

        End If

        If SaveFileDialog1.FilterIndex.ToString = 1 Then RichTextBox1.SaveFile(soubor, RichTextBoxStreamType.PlainText)

        If SaveFileDialog1.FilterIndex.ToString = 2 Then RichTextBox1.SaveFile(soubor, RichTextBoxStreamType.RichText)

    End Sub

    'Procedura pro zápis souboru "jako"

    Private Sub UloženíjakoToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles UloženíjakoToolStripMenuItem.Click

        'Otevření dialogu pro zápis do souboru využívá se objekt  SaveFileDialog

        SaveFileDialog1.Filter = "Text files (*.txt)|*.txt|Ritchtext file (*.rtf)|*.rtf"

        SaveFileDialog1.ShowDialog()

        soubor = SaveFileDialog1.FileName

        If SaveFileDialog1.FilterIndex.ToString = 1 Then RichTextBox1.SaveFile(soubor, RichTextBoxStreamType.PlainText)

        If SaveFileDialog1.FilterIndex.ToString = 2 Then RichTextBox1.SaveFile(soubor, RichTextBoxStreamType.RichText)

    End Sub

    'Procedura pro zápis pro zavření souboru

    Private Sub ZavřeníToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ZavřeníToolStripMenuItem.Click

        If Not (soubor Is Nothing) Then

            SaveFileDialog1.Filter = "Text files (*.txt)|*.txt|Ritchtext file (*.rtf)|*.rtf"

            If SaveFileDialog1.FilterIndex.ToString = 1 Then RichTextBox1.SaveFile(soubor, RichTextBoxStreamType.PlainText)

            If SaveFileDialog1.FilterIndex.ToString = 2 Then RichTextBox1.SaveFile(soubor, RichTextBoxStreamType.RichText)

            RichTextBox1.Clear()

        Else

            Dim a, b As Object

            UloženíToolStripMenuItem_Click(a, b)

        End If

        Me.Hide()

    End Sub

    'Procedura pro nastavení fontu

    Private Sub FontToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles FontToolStripMenuItem.Click

        FontDialog1.ShowDialog()

        RichTextBox1.SelectionFont = FontDialog1.Font

    End Sub

    'Procedura pro kopírování textu

    Private Sub KopirovatToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles KopirovatToolStripMenuItem.Click

        RichTextBox1.Copy()

    End Sub

    'Procedura pro vložní textu

    Private Sub VložitToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles VložitToolStripMenuItem.Click

        RichTextBox1.Paste()

    End Sub

    'Procedura pro vyjmutí textu

 

    Private Sub VyjmoutToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles VyjmoutToolStripMenuItem.Click

        RichTextBox1.Cut()

    End Sub

End Class

 

·         Třída DvouPrimPris

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 


Public Class DvouPrimPris

    Structure Zamestnanec ' deklarace typu

        <VBFixedString(20)> Dim Jmeno As String

        <VBFixedString(25)> Dim Prijmeni As String

        <VBFixedString(50)> Dim Ulice As String

        <VBFixedString(5)> Dim Cislo As String

        <VBFixedString(7)> Dim PSC As String

        <VBFixedString(40)> Dim Obec As String

        <VBFixedString(20)> Dim Telefon As String

        <VBFixedString(60)> Dim Email As String

        <VBFixedString(10)> Dim Ident_cislo As String

    End Structure

    ' Událost načtení formuláře ve které se otevře soubor "Soubor_S_Primim_Pristupem" pep čtení a psaní s přímím přístupem

    Private Sub DvouPrimPris_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        On Error Resume Next

        FileOpen(1, "Soubor_S_Primim_Pristupem.vbk", OpenMode.Random, OpenAccess.ReadWrite, , 250)

    End Sub

    'Procedura  pro zjištění konce souboru

    Private Sub Konec_souboru(ByVal Cislo_souboru As Byte, ByRef Pocet_záznamů As Long)

        Dim b As Zamestnanec

        Pocet_záznamů = 0

        Seek(1, 1)

        Do

            FileGet(1, b)

            If b.Jmeno = "" Then

                Pocet_záznamů = 0

            Else

                Pocet_záznamů = Pocet_záznamů + 1

            End If

        Loop Until EOF(Cislo_souboru)

    End Sub

    'Procedura ppro zobrazení obsahu proměnné typu vOsoba do textboxů

    Private Sub Zobraz(ByVal Osoba As Zamestnanec)

        TextBox1.Text = Osoba.Jmeno

        TextBox2.Text = Osoba.Prijmeni

        TextBox3.Text = Osoba.Ulice

        TextBox4.Text = Osoba.Cislo

        TextBox5.Text = Osoba.PSC

        TextBox6.Text = Osoba.Obec

        TextBox7.Text = Osoba.Ident_cislo

        TextBox8.Text = Osoba.Email

        TextBox9.Text = Osoba.Telefon

    End Sub

    'Událost "Ulož"

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        Dim Osoba As Zamestnanec ' Deklarace proměnné typu zaměstnanec

        Static Pocet As Long

        Osoba.Jmeno = TextBox1.Text ' Vložení položek do proměnné Osoba

        Osoba.Prijmeni = TextBox2.Text

        Osoba.Ulice = TextBox3.Text

        Osoba.Cislo = TextBox4.Text

        Osoba.PSC = TextBox5.Text

        Osoba.Obec = TextBox6.Text

        Osoba.Ident_cislo = TextBox7.Text

        Osoba.Email = TextBox8.Text

        Osoba.Telefon = TextBox9.Text

        Konec_souboru(1, Pocet)     'Nalezení konce souboru pmocí procedury "Konec_souboru"

        FilePut(1, Osoba, Pocet + 1) ' Uložení proměnné osoba do souboru "ji.vbk" za konec souboru

        TextBox1.Clear()

        TextBox2.Clear()

        TextBox3.Clear()

        TextBox4.Clear()

        TextBox5.Clear()

        TextBox6.Clear()

        TextBox7.Clear()

        TextBox8.Clear()

        TextBox9.Clear()

    End Sub

    'Událost "Změň"

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click

        Dim Osoba As Zamestnanec

        Osoba.Jmeno = TextBox1.Text ' Vložení položek do proměnné Osoba

        Osoba.Prijmeni = TextBox2.Text

        Osoba.Ulice = TextBox3.Text

        Osoba.Cislo = TextBox4.Text

        Osoba.PSC = TextBox5.Text

        Osoba.Obec = TextBox6.Text

        Osoba.Ident_cislo = TextBox7.Text

        Osoba.Email = TextBox8.Text

        Osoba.Telefon = TextBox9.Text

        FilePut(1, Osoba, Seek(1) - 1)

    End Sub

    ' Událost konec programu

    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click

        FileClose(1)

        End

    End Sub

    'Tlačítko "<<" - záčátek souboru

    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click

        Dim Osoba As Zamestnanec

        FileGet(1, Osoba, 1)

        Zobraz(Osoba)

    End Sub

    'Tlačítko "<" - návrat o jeden záznam zpět

    Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click

        Dim k, t As Long

        Dim osoba, a As Zamestnanec

        k = Seek(1) - 2

        Try

            FileGet(1, osoba, k)

            Zobraz(osoba)

        Catch

            MsgBox("Začátek souboru")

        End Try

    End Sub

    'Tlačítko ">" - posun o jeden záznam ke konci souboru

    Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click

        Dim Osoba As Zamestnanec

        FileGet(1, Osoba)

        Zobraz(Osoba)

       If EOF(1) Then MsgBox("Konec souboru")

    End Sub

    'Tlačítko ">>" - posun na konec souboru

    Private Sub Button7_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button7.Click

        Dim osoba As Zamestnanec

        Dim k As Long

        On Error Resume Next

        Konec_souboru(1, k)

        FileGet(1, osoba, k)

        Zobraz(osoba)

    End Sub

End Class

·         Třída  DvouDatabase

 

    

 

 

 

 

 

 

 

 

 

 

 

 

 

 

Public Class DvouDatabase

    Dim k As New DataSet    'Ze třídy Dataset se vytvoří objekt k

    Dim vCisloZaznamu As Integer

    Dim Cislo_Radku As Integer

    'Procedura pro zápis hodnot z databáze do textboxů

    Public Sub cti(ByVal radek As Long)

        Dim a As String

      Try

        TextBox1.Text = k.Tables(0).Rows(radek).Item(1).ToString

        TextBox2.Text = k.Tables(0).Rows(radek).Item(2).ToString

        TextBox3.Text = k.Tables(0).Rows(radek).Item(3).ToString

        TextBox4.Text = k.Tables(0).Rows(radek).Item(4).ToString

        TextBox5.Text = k.Tables(0).Rows(radek).Item(5).ToString

        TextBox6.Text = k.Tables(0).Rows(radek).Item(6).ToString

        TextBox7.Text = k.Tables(0).Rows(radek).Item(7).ToString

        TextBox8.Text = k.Tables(0).Rows(radek).Item(8).ToString

        TextBox9.Text = k.Tables(0).Rows(radek).Item(9).ToString

      Catch

        Msgbox “V databázi nejsou žádné záznamy“

      End try

End Sub

    'Procedura pro vymazábí textboxů

    Public Sub Vymaz()

        Dim a As Object

        Dim i As Integer

        Dim m As New System.Windows.Forms.TextBox

        For Each a In Me.Controls 'Probíhá přes kolekci všech objektů vlořených do formuláře

            If m.GetType Is a.GetType Then 'Vybírá textboxy

                Me.Controls(i).Text = "" 'Maže textboxy

            End If

            i = i + 1

        Next

    End Sub

    Private Sub DvouDatabase_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        OleDbDataAdapter1.Fill(k) 'Ppřečte se databze do objektu k

        Cislo_Radku = 0

        cti(0) 'Zobrazí se hodnoty prvního řádku v Textboxech

    End Sub

 

    Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click

        Cislo_Radku = Cislo_Radku + 1 'Zvýší se číslo řádku o 1

        If Cislo_Radku > k.Tables(0).Rows.Count - 1 Then

            MsgBox("Jste na posledním záznamu")

            Vymaz()  'Vymažou se Textboxy

        Else

            cti(Cislo_Radku) 'Zobrazí se hodnoty řádku  Cislo_Radku v Textboxech

        End If

    End Sub

 

    Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click

        Cislo_Radku = Cislo_Radku - 1 'Sníží se číslo řádku o 1

        If Cislo_Radku < 0 Then

            MsgBox("Jste na prvnim záznamu")

        Else

            cti(Cislo_Radku) 'Zobrazí se hodnoty řádku  Cislo_Radku v Textboxech

        End If

    End Sub

 

    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click

        Cislo_Radku = 0

        cti(0)  'Zobrazí se hodnoty prvního řádku v Textboxech

    End Sub

 

    Private Sub Button7_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button7.Click

        Cislo_Radku = k.Tables(0).Rows.Count - 1 ' k.Tables(0).Rows.Count dává počet řádků v databázi

        cti(Cislo_Radku) 'Zobrazí se hodnoty posledního řádku v Textboxech

    End Sub

  

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        k.Tables(0).Rows.Add(1, TextBox1.Text, TextBox2.Text, TextBox3.Text, TextBox4.Text, TextBox5.Text, TextBox6.Text, TextBox7.Text, TextBox8.Text, TextBox9.Text)

        OleDbDataAdapter1.Update(k)

    End Sub

   

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click

        k.Tables(0).Rows(Cislo_Radku).BeginEdit() 'Umožmí editovat řádky Tabulky

        k.Tables(0).Rows(Cislo_Radku).Item(1) = TextBox1.Text 'Zapis hodnot z Textboxů dořádku tabulky

        k.Tables(0).Rows(Cislo_Radku).Item(2) = TextBox2.Text

        k.Tables(0).Rows(Cislo_Radku).Item(3) = TextBox3.Text

        k.Tables(0).Rows(Cislo_Radku).Item(4) = TextBox4.Text

        k.Tables(0).Rows(Cislo_Radku).Item(5) = TextBox5.Text

        k.Tables(0).Rows(Cislo_Radku).Item(6) = TextBox6.Text

        k.Tables(0).Rows(Cislo_Radku).Item(7) = TextBox7.Text

        k.Tables(0).Rows(Cislo_Radku).Item(8) = TextBox8.Text

        k.Tables(0).Rows(Cislo_Radku).Item(9) = TextBox9.Text

        k.Tables(0).Rows(Cislo_Radku).EndEdit() 'Ukončení editace

        OleDbDataAdapter1.Update(k) 'Zapsání do databáze

    End Sub

 

    Private Sub Button3_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click

        End 'Ukončení programu

         End Sub

  End Class

·         Třída střední vrstvy Osoba4

Option Explicit On

Imports System

Imports System.IO

Public Class Osoba4          ' Název tríddy

    Public Sub New()         ' konstruktor

    End Sub

    Public Structure vOsoba ' deklarace typu vnitřní paměti

        <VBFixedString(20)> Dim vJmeno As String

        <VBFixedString(25)> Dim vPrijmeni As String

        <VBFixedString(50)> Dim vUlice As String

        <VBFixedString(5)> Dim vCislo As String

        <VBFixedString(7)> Dim vPSC As String

        <VBFixedString(40)> Dim vObec As String

        <VBFixedString(20)> Dim vTelefon As String

        <VBFixedString(60)> Dim vEmail As String

        <VBFixedString(10)> Dim vIdent_cislo As String

    End Structure

    Private k As vOsoba 'deklarace  vnitřní paměti  třídy osoby4

    Dim vJmenoSouboru As String 'deklarace souboru do kterého bude ukládána jednotlivé objekty = konkrétní osoby

    Public Sub Otevri_soubor(ByVal cislo_souboru As Byte, ByRef Delka_zaznamu As Integer) 'Metoda pro otevření souboru s přímým přístupem

        On Error Resume Next

        FileOpen(cislo_souboru, vJmenoSouboru, OpenMode.Random, OpenAccess.ReadWrite, , Delka_zaznamu)

    End Sub

    Public Sub Uloz_zaznam(ByVal cislo_souboru As Byte, ByVal ParamArray Cislo_zaznamu() As Integer)  'Metoda pro uložení záznamu

        ReDim Preserve Cislo_zaznamu(1) 'Deklarace velikosti pole

        Dim pocet_zaznamu As Long 'Deklarace proměné do ktere metoda Konec_souboru načte počet záznamů

        If k.vJmeno = "" Or k.vPrijmeni = "" Then

            MsgBox("Musíte zadat jméno nebo příjmení")

            Exit Sub

        End If

        Konec_souboru(1, pocet_zaznamu) 'Volání veřejné metody Konec_souboru

        If Cislo_zaznamu(0) <> 0 Then pocet_zaznamu = Cislo_zaznamu(0) - 1 'Odstíní případ, kdy není zadán zápis určitého záznamu - umožňuje polymorfní chování

        FilePut(cislo_souboru, k, pocet_zaznamu + 1) 'uloží konkrétní osobu do souboru

    End Sub

    Public Sub Cti_zazanam(ByVal Cislo_souboru As Integer, ByVal ParamArray Cislo_zaznamu() As Integer) 'Metoda pro ctení záznamu ze souboru s polymorfnim chováním

        ReDim Preserve Cislo_zaznamu(1) 'Deklarace velikosti pole

        If Cislo_zaznamu(0) <> 0 Then 'Odstíní případ, kdy není zadáno čtení určitého záznamu - umožňuje polymorfní chování

            FileGet(Cislo_souboru, k, Cislo_zaznamu(0))

        Else

            FileGet(Cislo_souboru, k)

        End If

    End Sub

    Public Sub Konec_souboru(ByVal cislo_souboru As Integer, ByRef Pocet_zaznamu As Long) 'Metoda pro zjištění konce souboru

        Pocet_zaznamu = 0

        Dim b As New vOsoba()

        Seek(cislo_souboru, 1)

        Do

            FileGet(cislo_souboru, b)

            If b.vJmeno.ToString = "" Then

                Pocet_zaznamu = 0 'začátek souboru

            Else

                Pocet_zaznamu = Pocet_zaznamu + 1 'Ostatní záznamy v souboru

            End If

        Loop Until EOF(cislo_souboru) 'Cyklus končí kdzž při čtení dojdeme n a konec souboru

    End Sub

 

    Public Property Jmeno() As String 'Rozhraní pro čtení a zápis do paměti objektu

        Get

            Jmeno = k.vJmeno

        End Get

        Set(ByVal Value As String)

            k.vJmeno = Value

        End Set

    End Property

    Public Property Prijmeni() As String 'Rozhraní pro čtení a zápis do paměti objektu

        Get

            Prijmeni = k.vPrijmeni

        End Get

        Set(ByVal Value As String)

            k.vPrijmeni = Value

        End Set

    End Property

    Public Property Cislo() As String 'Rozhraní pro čtení a zápis do paměti objektu

        Get

            Cislo = k.vCislo

        End Get

        Set(ByVal Value As String)

            k.vCislo = Value

        End Set

    End Property

 

    Public Property PSC() As String 'Rozhraní pro čtení a zápis do paměti objektu

        Get

            PSC = k.vPSC

        End Get

        Set(ByVal Value As String)

            k.vPSC = Value

        End Set

    End Property

    Public Property Obec() As String 'Rozhraní pro čtení a zápis do paměti objektu

        Get

            Obec = k.vObec

        End Get

        Set(ByVal Value As String)

            k.vObec = Value

        End Set

    End Property

    Public Property Telefon() As String 'Rozhraní pro čtení a zápis do paměti objektu

        Get

            Telefon = k.vTelefon

        End Get

        Set(ByVal Value As String)

            k.vTelefon = Value

        End Set

    End Property

    Public Property E_Mail() As String 'Rozhraní pro čtení a zápis do paměti objektu

        Get

            E_Mail = k.vEmail

        End Get

        Set(ByVal Value As String)

            k.vEmail = Value

        End Set

    End Property

    Public Property Ulice() As String 'Rozhraní pro čtení a zápis do paměti objektu

        Get

            Ulice = k.vUlice

        End Get

        Set(ByVal Value As String)

            k.vUlice = Value

        End Set

    End Property

    Public Property Osoba_val() As vOsoba 'Rozhraní pro čtení a zápis do paměti objektu

        Get

            Osoba_val = k

        End Get

        Set(ByVal Value As vOsoba)

            k = Value

        End Set

    End Property

    Public Property JmenoSouboru() As String 'Rozhraní pro čtení a zápis do paměti objektu

        Get

            JmenoSouboru = vJmenoSouboru

        End Get

        Set(ByVal Value As String)

            vJmenoSouboru = Value

        End Set

    End Property

    Public Function Cislo_zaznamu(ByVal cislo_souboru As Integer) As Long 'Rozhraní pro čtení z  paměti objektu

        Cislo_zaznamu = Seek(cislo_souboru)

    End Function

    Public Property Ident_cislo() As String 'Rozhraní pro čtení a zápis do paměti objektu

        Get

            Ident_cislo = k.vIdent_cislo

        End Get

        Set(ByVal Value As String)

            k.vIdent_cislo = Value

        End Set

    End Property

End Class

·         Třida TriPrimPris

 

 

Public Class TriPrimPris

    Dim pamet As New Osoba4 'Vytváření objektu střední vrstvy

    'Procedura načtení formuláře

    Private Sub Ucitel3_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        pamet.JmenoSouboru = "Ji.vbk" 'Nastavení cesty objektu střední vrstvy do souboru

        pamet.Otevri_soubor(1, 250) 'Otevření logického kanálu mezi objektem střední vrstvy a souborem

    End Sub

    ' Tlačítko "Ulož"

    Private Sub Button1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button1.Click

        pamet.Jmeno = TextBox1.Text   'Zaslání dat do objekru střední vrstvy

        pamet.Prijmeni = TextBox2.Text '                "

        pamet.Ulice = TextBox3.Text    '                "

        pamet.Cislo = TextBox4.Text    '                "

        pamet.Obec = TextBox5.Text      '               "

        pamet.PSC = TextBox6.Text      '                "

        pamet.Telefon = TextBox8.Text  '                "

        pamet.E_Mail = TextBox9.Text   '                "

        pamet.Ident_cislo = TextBox7.Text  '           "

        pamet.Uloz_zaznam(1) ' uložení dat z objektu střední vrstvy do souboru

        TextBox1.Clear()

        TextBox2.Clear()

        TextBox3.Clear()

        TextBox4.Clear()

        TextBox5.Clear()

        TextBox6.Clear()

        TextBox7.Clear()

        TextBox8.Clear()

        TextBox9.Clear()

    End Sub

    'Tlačítko "Konec"

    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click

        End  'Ukončení programu

    End Sub

    'Procedura ppro zobrazení obsahu proměnné typu vOsoba do textboxů

    Private Sub Zobraz()

        TextBox1.Text = pamet.Jmeno.ToString

        TextBox2.Text = pamet.Prijmeni.ToString

        TextBox3.Text = pamet.Ulice.ToString

        TextBox4.Text = pamet.Cislo.ToString

        TextBox5.Text = pamet.PSC.ToString

        TextBox6.Text = pamet.Obec.ToString

        TextBox8.Text = pamet.Telefon.ToString

        TextBox9.Text = pamet.E_Mail.ToString

        TextBox7.Text = pamet.Ident_cislo.ToString

    End Sub

    'Tlačítko "<<" - záčátek souboru

    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click

        pamet.Cti_zazanam(1, 1) 'Objekt střední vrsvy přecte první záznam ze souboru a předá ho do proměné k

        Zobraz() 'Zobrazení přečtených dat

    End Sub

    'Tlačítko "<" - návrat o jeden záznam zpět

    Private Sub Button5_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button5.Click

        On Error Resume Next 'Chrání proceduru před chybo čtení ze souboru před začátkem souboru

        Dim c As Long

        c = pamet.Cislo_zaznamu(1) 'Objekt střední vrstvy zašle čislo záznamu na kterém stojí ukazatel souboru

        Select Case c 'Úprav pro speciální případ návrat z druhého na první záznam

            Case 2

                pamet.Cti_zazanam(1, 1)  'Čtení prvního záznamu

            Case Is > 2

                pamet.Cti_zazanam(1, c - 2)  'Čtení druhého a dalších záznamů

        End Select

        Zobraz() 'Zobrazení přečtených dat

    End Sub

    'Tlačítko ">" - posun o jeden záznam ke konci souboru

    Private Sub Button6_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button6.Click

        Dim k As Osoba4.vOsoba ' Vytvoření proměnné dle  Public struktury vOsoba definované v objektu střední vrstvy

        pamet.Cti_zazanam(1) 'Čtení dalšího záznamu

        Zobraz() 'Zobrazení přečtených dat

    End Sub

    'Tlačítko ">>"

    Private Sub Button7_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button7.Click

        Dim a As Long

        pamet.Konec_souboru(1, a) 'Střední vrstva vrací zprávu o počtu záznamů v souboru

        pamet.Cti_zazanam(1, a) 'Čtení posledního záznamu

        Zobraz() 'Zobrazení přečtených dat

    End Sub

    'Tlačítko "Změň"

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click

        pamet.Jmeno = TextBox1.Text    'Načtení změn do objektu střední vrsvy

        pamet.Prijmeni = TextBox2.Text

        pamet.Ulice = TextBox3.Text

        pamet.Cislo = TextBox4.Text

        pamet.Obec = TextBox5.Text

        pamet.PSC = TextBox6.Text

        pamet.Telefon = TextBox8.Text

        pamet.E_Mail = TextBox9.Text

        pamet.Ident_cislo = TextBox7.Text

        pamet.Uloz_zaznam(1, pamet.Cislo_zaznamu(1) - 1) 'Uloženi změn provedených vobjektu střední vrstvy do souboru

    End Sub

    'Událost zavření formuláře

    Private Sub osoba3_Closed(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Closed

        pamet = Nothing  'zrušení objektu

    End Sub

End Class

·         Třída střední vrstvy Osoba1

Tato třída se připojuje pomocí knihocny  MojePripojeniNet kterou  je možno stáhnout z Internetu  a rozbalit zip uložit na počítači  na kterém se program odlaďuje. Knihovnu je potom třeba připojit pomocí AddReference  Vysvětlení je na adrese http://boss.ped.muni.cz/vyuka/material/puvodni/PNet.htm#_Toc146515390

Imports System.Windows.Forms.Form

Imports System.IO

Public Class osoba1 'Třída osoba1

    Dim vJmenoDatabaze As String 'Vnitřní proměnné třídy

    Dim pp As Collection

    Dim k As New System.Data.DataSet

    Dim ID As String

    Public vis As Boolean

    Public Property Jmeno_Databaze() As String 'Vlasnosti třidy

        Get

            Jmeno_Databaze = vJmenoDatabaze

        End Get

        Set(ByVal value As String)

            vJmenoDatabaze = value

        End Set

    End Property

    Dim Moje As System.Windows.Forms.Form

    Public Property Formular() As System.Windows.Forms.Form

        Get

            Formular = Moje

        End Get

        Set(ByVal value As Form)

            Moje = value

        End Set

    End Property

    Dim vCisloZaznamu As Long

    Public Property CisloZaznamu() As Long

        Get

            CisloZaznamu = vCisloZaznamu

        End Get

        Set(ByVal value As Long)

            vCisloZaznamu = value

        End Set

    End Property

 

    Public Pdatabaze As Object

    Dim ppp As Array

    'Procedura pro uložení záznamu

    Public Sub Uloz(ByVal JmenoT As String)

        Pdatabaze = New MojePripojeniNet.N1.MojePripojení 'Vytvorení objektu Pdatabaze z trídy MojePripojení

        pp = Nothing 'vyprázdnění kolekce

        pp = New Collection 'Vytvoření klekce

        Dim m As New System.Windows.Forms.TextBox

        Dim i As Short

        Dim i1 As Short

        Dim k, l As String

        Dim a As Object

        For Each a In Moje.Controls

            If m.GetType Is a.GetType Then 'Načtení obsahu textboxů do klekce pp

                i1 = i1 + 1

                pp.Add(Moje.Controls.Item(i).Text)

                l = pp.Item(i1)

            End If

            i = i + 1

        Next

        i1 = pp.Count

        For Each a In pp 'Vytvoření řetězce pro zobrazení v Msgboxu

            k = k + Chr(13) + (pp.Item(i1))

            i1 = i1 - 1

        Next

 

        MsgBox(k + Chr(13) + (i1 - 1).ToString) 'Zobrazení hodnot pro uložení v MSgboxu

        i1 = 0

        uloz1(vJmenoDatabaze, JmenoT) 'Uložení záznamů

    End Sub

    'Procedura pro uložení hodnot do tatabáze

    Private Sub uloz1(ByVal JmenoDatabáze As String, ByVal JmenoT As String)

        Pdatabaze = New MojePripojeniNet.N1.MojePripojení

        Dim pocet As Short = CType(pp.Count, Short) 'Počet zaoisovaných hodnot

        Dim po As Byte

        Dim iSql, sql2, k2, Psql As String

        Dim p As Object

        Dim Tabulky As New Collection

        Dim i As Short = 1

        Dim vys As Boolean

 

        Pdatabaze.JmenaTabulek(JmenoDatabáze, Tabulky) 'Zjištění kolekce tabulek v databázi

        zjisti(JmenoT, vys) 'Zjištění existuje -li tabulka daného jména

        If vys = False Then 'Jesstli ne tak se vytvoří

            'Generování příkazu SQL pro vytvoření tabulky

            iSql = "Create Table " + JmenoT + " ( "

            For po = 1 To pocet

                iSql = iSql + " Pole" + po.ToString + " varchar(30),"

            Next

            iSql = iSql + "Pole" + (pocet + 1).ToString + " varchar(20));"

            REM System.Diagnostics.Debug.Write(iSql)

            Pdatabaze.VytvorTabulku(JmenoDatabáze, iSql) 'Vytvoření tabulky

            ID = 1

 

        Else 'Jesstli existuje tak se zapíše

            Try 'Zjišťovaní automatického klíče

                ID = (k.Tables(0).Rows((k.Tables(0).Rows.Count) - 1).Item(pp.Count)) + 1

                'Klíč neexistuje pak catch

            Catch

               Dim Pdatabaze = New MojePripojeniNet.N1.MojePripojení                       

 Dim k1 As New DataSet

                Psql = "SELECT " + JmenoT + ".* FROM " + JmenoT + ";"

                Pdatabaze.SQL = Psql

                Pdatabaze.spojení(vJmenoDatabaze, k1)

               Try

                    ID = (k1.Tables(0).Rows((k1.Tables(0).Rows.Count) - 1).Item(pp.Count)) + 1

                    k1 = Nothing

                Catch

                End Try

            End Try

        End If

        'Generování příkazu pro vložení řádku

        For po = 0 To pocet - 1

            k2 = k2 + "Pole" + (po + 1).ToString + ","

        Next

        k2 = k2 + "Pole" + (pocet + 1).ToString + " )"

        sql2 = "Insert InTo " + JmenoT + "( " + k2 + " values  ( "

        For i = pocet To 1 Step -1

            If i > 1 Then sql2 = sql2 + "'" + pp.Item(i) + "'" + "," Else sql2 = sql2 + "'" + pp.Item(i) + "'" + "," + "'" + ID + "'" + ");"

        Next

        Pdatabaze.VlozRadek(JmenoDatabáze, sql2) 'Vložení řádku

        Pdatabaze = Nothing

 

    End Sub

    Public Sub cti(ByVal JmenoT As String, ByRef PocetZaznamu As Long)

        Pdatabaze = New MojePripojeniNet.N1.MojePripojení

        Dim vSql As String

        Dim vys As Boolean

        Dim i, i1 As Integer

        Dim a As Object

        Dim ppp As New Collection

        Dim m As New System.Windows.Forms.TextBox

        REM   zjisti(JmenoT, vys)

        vSql = "SELECT " + JmenoT + ".* FROM " + JmenoT + ";"

        Pdatabaze.SQL = vSql

        Try

            Pdatabaze.spojení(vJmenoDatabaze, k)

            i1 = k.Tables(0).Columns.Count - 1

            PocetZaznamu = k.Tables(0).Rows.Count

 

            For Each a In Formular.Controls

                If m.GetType Is a.GetType Then

                    Try

                        Formular.Controls(i).Text = k.Tables(0).Rows(vCisloZaznamu).Item(i1 - 1)

 

                    Catch

                        If vCisloZaznamu > 0 Then

                            MsgBox("Jste na posledním záznamu")

 

                            Vymaz()

                        Else

                            MsgBox("Jste na prvním záznamu")

                        End If

                        Exit Sub

                    End Try

                    i1 = i1 - 1

                End If

                i = i + 1

            Next

 

        Catch

        End Try

        Pdatabaze = Nothing

    End Sub

    Public Sub Vymaz()

        Dim a As Object

        Dim i As Integer

        Dim m As New System.Windows.Forms.TextBox

        For Each a In Formular.Controls

            If m.GetType Is a.GetType Then

                Formular.Controls(i).Text = ""

            End If

            i = i + 1

        Next

    End Sub

    Public Sub Zmena(ByVal JmenoT As String)

        Pdatabaze = New MojePripojeniNet.N1.MojePripojení

        Dim po As String

        Dim a As Object

        Dim i, l, i1 As Integer

        Dim vSql1 As String = "UPDATE " + JmenoT + " SET "

        Dim m As New System.Windows.Forms.TextBox

        l = k.Tables(0).Columns.Count - 1

        i1 = l + 1

        For Each a In Formular.Controls

            If m.GetType Is a.GetType Then

                If Formular.Controls(i).Text.Length > 0 Then

                    vSql1 = vSql1 + "pole" + l.ToString + " = " + " '" + Formular.Controls(i).Text + " '" + ","

                End If

                l = l - 1

            End If

            i = i + 1

        Next

        ID = k.Tables(0).Rows(vCisloZaznamu).Item(k.Tables(0).Columns.Count - 1)

        po = "Pole" + i1.ToString

        vSql1 = vSql1.Substring(0, vSql1.Length - 1) + " WHERE (((" + po + ")= " + "'" + ID + "'" + "));"

        System.Diagnostics.Debug.Write(vSql1)

        Pdatabaze.Update(vJmenoDatabaze, vSql1)

        Pdatabaze = Nothing

    End Sub

    Public Sub zjisti(ByVal JmenoT As String, ByRef vys As Boolean)

        Dim Tabulky As New Collection

        Dim p As Object

        Dim i As Integer = 1

        vys = True

        Try

            Pdatabaze.JmenaTabulek(vJmenoDatabaze, Tabulky)

        Catch

            vys = False

        End Try

        For Each p In Tabulky

            If JmenoT = Tabulky.Item(i) Then

                vys = True

                Exit For

            Else

                vys = False

            End If

            i = i + 1

        Next

    End Sub

End Class

·         Třida Tridatabaze

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 


Public Class TriDatabaze

    Dim osoba As New osoba1

    Public vtab As String

    Public Jmeno_Databaze As String

    Dim a As Long

 

    Private Sub osoba_Activated(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Activated

        Static k As Boolean = False

        osoba.Formular = Me

        osoba.CisloZaznamu = 0

        REM   If k Then

        osoba.cti(vtab, a)

        REM k = True

        REM   End If

    End Sub

 

    Private Sub Button1_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        osoba.Jmeno_Databaze = Jmeno_Databaze

        osoba.Formular = Me

        osoba.Uloz(vtab)

        osoba.Vymaz()

        osoba.CisloZaznamu = a + 1

    End Sub

 

    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click

        End

    End Sub

 

    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click

        osoba.Jmeno_Databaze = Jmeno_Databaze

        osoba.Formular = Me

        osoba.CisloZaznamu = 0

        osoba.cti(vtab, a)

    End Sub

 

    Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click

        osoba.Jmeno_Databaze = Jmeno_Databaze

        osoba.Formular = Me

        osoba.CisloZaznamu = osoba.CisloZaznamu + 1

        osoba.cti(vtab, a)

    End Sub

 

    Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click

        osoba.Jmeno_Databaze = Jmeno_Databaze

        osoba.Formular = Me

        osoba.CisloZaznamu = osoba.CisloZaznamu - 1

        osoba.cti(vtab, a)

    End Sub

 

    Private Sub Button7_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button7.Click

        osoba.Jmeno_Databaze = Jmeno_Databaze

        osoba.Formular = Me

        osoba.CisloZaznamu = a - 1

        osoba.cti(vtab, a)

    End Sub

 

 

    Private Sub Button2_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button2.Click

        osoba.Zmena(vtab)

    End Sub

 

    Private Sub osoba_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load

        vtab = "Data1"

        Jmeno_Databaze = "osoba.mdb"

        osoba.Jmeno_Databaze = Jmeno_Databaze

    End Sub

End Class

 

·         Třída Učitel – dědí třídu soubory.TriDatabaze

 

 

 

 

 

 

 

 

 

 

 

 

 

 


Public Class ucitel

    Inherits soubory.TriDatabaze

    Private Sub ucitel_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        vtab = "Data2"

        Jmeno_Databaze = "osoba.mdb"

        TriDatabaze.Jmeno_Databaze = Jmeno_Databaze

    End Sub

End Class

4.    Mapy

·         Třída MapyMenu

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 


Public Class MapyMenu

    Public M1 As Image

    Public m2 As Image

    Public Pomer As Integer

    Public typ As Byte

    Dim a As New Test

        Private Sub MapyMenu_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load

        Me.Width = a.Width + 50 'nastaveni velikosti formuláře podle formuláře a

        Me.Height = a.Height + 100 'nastaveni velikosti formuláře podle formuláře a

        a.MdiParent = Me     'nastaveni formuláře do Mdiconteinaru

      MenuStrip1.Select()

    End Sub

    Private Sub TvorbaTestuToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TvorbaTestuToolStripMenuItem.Click

        Try ' test není-li otevřen formulář pro "Zadávání testu"

            a.Close()

            a = New Test

            a.MdiParent = Me

        Catch

            a.MdiParent = Me

        End Try

        typ = 1 'parametr udávající způsob otevření

        TextBox1.Clear() 'vymazání hesla

        TextBox1.Visible = True

        Label1.Visible = True

        TextBox1.Select()

    End Sub

 

    Private Sub TestToolStripMenuItem_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles TestToolStripMenuItem.Click

        Try 'test není-li otevřen formulář pro "Řešení testu"

            a.Close()

            a = New Test

            a.MdiParent = Me

        Catch

            a.MdiParent = Me

        End Try

        typ = 2 'parametr udávající způsob otevření

        TextBox1.Clear() 'vymazání hesla

        TextBox1.Visible = True 'zobrazení textboxu pro zápis  hesla

        Label1.Visible = True 'zobrazení Label1

        TextBox1.Select()

    End Sub

 

 

    Private Sub TextBox1_KeyUp(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles TextBox1.KeyUp

        If e.KeyData = Keys.Enter Then 'kontola hesla

            If TextBox1.Text = "student" Then

                If typ = 1 Then 'bylo zvoleno "Zadávání testu"

                    M1 = Image.FromFile("CR.jpg") 'načtení obrázku

                    Pomer = CType(M1.Height / M1.Width, Integer) 'výpočet pměru stran obrázku

                    a.PictureBox1.Height = a.PictureBox1.Height * Pomer ' nastaveni výšky pctureboxu v pomru obrázku

                    a.Show() 'zobrzení formuláře

                    TextBox1.Clear() 'vymazání textboxu pro heslo

                    TextBox1.Visible = False 'schování texboxu

                    Label1.Visible = False

                    Exit Sub

                End If

                If typ = 2 Then 'bylo zvoleno "Řešení testu"

                    M1 = Image.FromFile("CR1.jpg") 'načtení obrázku

                    Pomer = CType(M1.Height / M1.Width, Integer) 'výpočet pměru stran obrázku

                    a.PictureBox1.Height = a.PictureBox1.Height * Pomer ' nastaveni výšky pctureboxu v pomru obrázku

                    a.Show()

                    TextBox1.Clear()  'vymazání textboxu pro heslo

                    TextBox1.Visible = False 'schování texboxu

                    Label1.Visible = False

                    Exit Sub

                End If

                If typ = 3 Then End 'ukončení programu

            Else

                MsgBox("Heslo je nesprávné")

            End If

        End If

    End Sub

 

    Private Sub KonecToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles KonecToolStripMenuItem.Click

        typ = 3 'uknčení programu

        TextBox1.Clear()

        TextBox1.Visible = True

        Label1.Visible = True

        TextBox1.Select()

    End Sub

End Class

·         Třída Test

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 


Tato třída se připojuje pomocí knihocny  MojePripojeniNet kterou  je možno stáhnout z Internetu  a rozbalit zip uložit na počítači  na kterém se program odlaďuje. Knihovnu je potom třeba připojit pomocí AddReference  Vysvětlení je na adrese http://boss.ped.muni.cz/vyuka/material/puvodni/PNet.htm#_Toc146515390 do adresáře Debug projektu uložte obr Cr a CR1 a databazi Mapy všechny tyto soubory stáhnete  z internetu.

 

Public Class Test

    Dim Prip As New MojePripojeniNet.N1.MojePripojení

    Dim vysledek As String

    Dim pocet, blok As Integer

    Dim k1 As New DataSet

    Sub napln_dataset(ByRef k As DataSet) 'procedura pro naplnění Datasetu

        Dim i As Integer

        Prip.SQL = "SELECT mapa.Místo, mapa.x1, mapa.Y1 FROM mapa;" 'Dotaz SQL

        Prip.spojení("mapy.mdb", k) 'Naplnění Datasetu

        ListBox1.Items.Clear()

        For i = 0 To k.Tables(0).Rows.Count - 1

            ListBox1.Items.Add(k.Tables(0).Rows(i).Item(0)) 'Naplnění Listboxu

        Next i

    End Sub

 

    Private Sub Test_Activated(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Activated

        Me.PictureBox1.Image = MapyMenu.M1

    End Sub

    Private Sub Test_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        napln_dataset(k1) 'načtení dat z databáse

        Select Case MapyMenu.typ

            Case 1 'bylo zvoleno "Zadávání testu"

                Me.Text = "Zadání testu"

                TextBox1.Visible = True 'otevření nástrojů pro ukládání udajů

                Button1.Visible = True

                Button2.Visible = True

                Label4.Text = "X"

                Label5.Text = "Y"

            Case 2 'bylo zvoleno "Řešení testu"

                pocet = k1.Tables(0).Rows.Count 'Zjišršní počtu záznamů v databázi

                Me.Text = "Řešení testu"

                TextBox1.Visible = False 'zavření nástrojů pro ukládání udajů

                Label4.Text = "Správně"

                Label5.Text = "Špatně"

                Button1.Visible = False

                Button2.Visible = False

        End Select

    End Sub

    'Procedura pro vložení záznamu

    Private Sub Button1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button1.Click

        Dim k2 As New DataSet

        'vložení záznamu

        Prip.VlozRadek("mapy.mdb", "mapa", TextBox1.Text, Label2.Text, Label3.Text)

        napln_dataset(k2) 'obnovení dat v Listboxu

        TextBox1.Clear()

        Label2.Text = ""

        Label3.Text = ""

        TextBox1.Clear()

    End Sub

    'Procedura pro vymazání záznamu

    Private Sub Button2_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button2.Click

        Dim vSQL As String

        Dim k2 As New DataSet

        'příkaz v jazyce SQL pro vymazání záznamu

        vSQL = "DELETE mapa.Místo, mapa.x1, mapa.Y1 FROM mapa WHERE (mapa.Místo = " + "'" + CType(ListBox1.SelectedItem, String) + "'" + ");"

        Prip.Update("mapy.mdb", vSQL) 'vymazání záznamu

        napln_dataset(k2) 'obnovení dat v Listboxu

        TextBox1.Clear()

    End Sub

    'Procedura pro přípravu záznamu ("Zadávání testu"),nebo pro vyhodnocrní odpovědi "Řešení testu"

    Private Sub PictureBox1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown

        Dim i As Integer

        Dim DX, DY As Double

        If MapyMenu.typ = 1 Then

            napln_dataset(k1) 'obnovení dat v Listboxu

            Label2.Text = e.X.ToString 'zapsání  x polohy kursoru do Label

            Label3.Text = e.Y.ToString 'zapsání y polohy kursoru do Label

        End If

        For i = 0 To k1.Tables(0).Rows.Count - 1 'porovnání polohy kurzoru z hodnotami v databázi

            DX = Int(Val(k1.Tables(0).Rows(i).Item(1)))

            DY = Int(Val(k1.Tables(0).Rows(i).Item(2)))

            If ((DX - 5) < e.X) And ((DX + 5) > e.X) And ((DY - 5) < e.Y) And ((DY + 5) > e.Y) Then

                TextBox1.Text = CType(k1.Tables(0).Rows(i).Item(0), String)

                Exit For 'ukončení smyčky je li polha kurzoru v zadaném intervalu

            Else

                TextBox1.Text() = ""

            End If

        Next i

        If MapyMenu.typ = 2 Then 'vyhodnocení odpovědi

            If vysledek = "" Then

                MsgBox("Musíš vybrat město")

                Exit Sub

            End If

            If blok = 1 Then 'udává je-li při vyhodnocování odpovídáno po prvé

                If TextBox1.Text Like vysledek Then 'odpověď je správná

                    Label2.Text = Str(Val(Label2.Text) + 1)

                    Label6.BackColor = System.Drawing.Color.Green

                    Label6.Text = "Správně, vybral jste město " + TextBox1.Text + " a označil " + TextBox1.Text

                    Label6.Visible = True

                Else

                    Label3.Text = Str(Val(Label3.Text) + 1) 'odpověď je nesprávná

                    Label6.BackColor = System.Drawing.Color.Red

                    Label6.Text = "Špatně, vybral jste město  " + vysledek + " a označil " + TextBox1.Text

                    Label6.Visible = True

                End If

            Else

                'udává je-li při vyhodnocování odpovídáno po druhé nebo nebylo li město vybráno

                MsgBox("musíš označit město v Listboxu")

 

                Label6.Visible = False

            End If

            blok = blok + 1

        End If

    End Sub

    Private Sub ListBox1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles ListBox1.Click

        Label6.Visible = False

        If MapyMenu.typ = 2 Then

            blok = 1

            vysledek = CType(ListBox1.SelectedItem, String)

            ListBox1.Items(ListBox1.SelectedIndex) = ""

            If Val(Label3.Text) + Val(Label3.Text) = k1.Tables(0).Rows.Count Then

                MsgBox("Musíš skončit vyčerpal jsi počet otázek")

                PictureBox1.Enabled = False

            End If

        End If

    End Sub

End Class

5.    Testy

Do adresáře Debug tohoto  projektu uložte obr  IMG-BRIG.JPG  , lev.jpg a osel.jpg databazi Test.mdb všechny tyto soubory stáhnete  z internetu.

Třída ProgramTesty

 

 

 

 

 

 


Public Class ProgramTesty

    Dim A1 As New Form

    Public He As String

    Private Sub TestSTvořenouOdpovědíToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TestSTvořenouOdpovědíToolStripMenuItem.Click

        Dim k As Boolean

        heslo(k)

        If TextBox1.Text <> "student" Then

            MsgBox("Nesprávné heslo")

            Exit Sub

        End If

        Label1.Visible = False

        TextBox1.Visible = False

        On Error Resume Next

        A1.Close()

        A1 = New T1

        Me.Width = A1.Width + 100 'Určení velikosti Mdi formuáře

        Me.Height = A1.Height + 110

        A1.MdiParent = Me 'určení formuláře jako dítětš

        A1.Show() 'Zobrazeni formuáře

    End Sub

    Private Sub TestSTvorenouOdpovědíToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TestSTvorenouOdpovědíToolStripMenuItem.Click

        Dim k As Boolean

        heslo(k)

        If TextBox1.Text <> "student" Then

            MsgBox("Nesprávné heslo")

            Exit Sub

        End If

        Label1.Visible = False

        TextBox1.Visible = False

        On Error Resume Next

        A1.Close()

        A1 = New T11

        Me.Width = A1.Width + 100 'Určení velikosti Mdi formuáře

        Me.Height = A1.Height + 110

        A1.MdiParent = Me 'určení formuláře jako dítětš