Příklady Visual Basic 6.0

Jiří Strach

2002

Příklad kalkulátor

 Tento program je příklad na sestrojení kalkulátoru

 

Option Explicit ´Nastvuje nutnost deklarace proměnných

Dim a As Integer

Private Sub Command1_Click() ´kód pro nastavení matematické operace

Select Case a

Case 1

Command1.Caption = "-"

a = 2

Case 2

Command1.Caption = "x"

a = 3

Case 3

Command1.Caption = ":"

a = 4

Case 4

Command1.Caption = "+"

a = 1

End Select

End Sub

 Private Sub Command2_Click() ´Kód pro provedení matematické operace

Select Case a

Case 1

Text3.Text = Val(Text1.Text) + Val(Text2.Text)

Case 2

Text3.Text = Val(Text1.Text) - Val(Text2.Text)

Case 3

Text3.Text = Val(Text1.Text) * Val(Text2.Text)

Case 4

Text3.Text = Val(Text1.Text) / Val(Text2.Text)

End Select

End Sub

 

Private Sub Form_Load()

a = 1 ´Nastavení operace +

End Sub

 

Private Sub Text1_Click() ´Vymazání textboxu

Text1.Text = ""

End Sub

 

Private Sub Text1_DragDrop(Source As Control, X As Single, Y As Single)

If TypeOf Source Is TextBox Then ´Procedura umožňující přetahování obsahu Texboxu

Text1.Text = Source.Text

End If

End Sub

Private Sub Text2_Click()

Text2.Text = ""

End Sub

Ukládání do souboru

Program procvičuje uložení dat do souboru

Option Explicit

Dim A As String * 20, B As Integer, c As Single

 Private Sub Command1_Click()

On Error GoTo 2

1 Open "k1.txt" For Append As #1´Otevření souboru pro připisování

Print #1, Text1.Text ´Zápis do souboru

Print #1, Val(Text2.Text)

Print #1, Val(Text3.Text)

Exit Sub

2 Close #1

GoTo 1

End Sub

 Private Sub Command2_Click()

On Error GoTo 1

Input #1, A ´Čtení ze souboru

Input #1, B

Input #1, c

Text1.Text = A

Text2.Text = Str(B)

Text3.Text = Str(c)

1 End Sub

Private Sub Command3_Click()

On Error GoTo 2

1 Open "k1.txt" For Input As #1 ´Otevření souboru pro čtení

Exit Sub

2 Close #1

GoTo 1

End Sub

 

Program procvičuje uložení dat do souboru s přímým přístupem

Kody ve formuláři soubor1 – soubor.frm

 

Option Explicit

Dim n As M

 Private Sub Command1_Click()

Dim j As Integer

konec j ´Volání procedury s parametrem z modulu soubor.bas

n.b = Text1.Text ´Ukládání do položky b proměnné n

n.c = Val(Text2.Text)

n.d = Val(Text3.Text)

If j = 1 Then

Put #1, 1, a ´Uložení proměnné a do souboru

Else

Put #1, , n

End If

End Sub

 Private Sub Command2_Click()

Get #1, , n ´ Čtení záznamu ze souboru do proměnné n

Text1.Text = n.b ´Zápis položky b proměnné a do textboxu

Text2.Text = n.c

Text3.Text = n.d

End Sub

 Private Sub Command3_Click() ´Skok na první záznam v souboru

Seek #1, 1

End Sub

 Private Sub Form_Load()

Open "k.txt" For Random Access Read Write As #1 ´Otevření souboru pro přímý přístup

End Sub

 Kód modulu soubor1.bas

 Public Type M

Setřídění číselného pole

Příklad procvičuje setřídění pole čísel generovaných generátorem náhodných čísel.

Option Explicit

 

Private Sub Form_Load()

Dim i As Integer, A As Integer

For i = 1 To 30

Randomize ´Generování pole

A = Int((100 * Rnd) + 1)

List1.AddItem A

Next

 

End Sub

Private Sub Command1_Click() ´Třídění pole “bublinková metoda”

Dim Vymena As String, i As Integer, K As Integer

For i = 1 To 30

For K = 30 To i Step -1

If Val(List1.List(K)) < Val(List1.List(K - 1)) Then

Vymena = List1.List(K)

List1.List(K) = List1.List(K - 1)

List1.List(K - 1) = Vymena

End If

Next K

Next i

End Sub

Private Sub Command2_Click()

Dim i As Integer, A As Integer

List1.Clear

For i = 1 To 30

Randomize

A = Int((100 * Rnd) + 1)

List1.AddItem A

Next

End Sub

Seznam

Příklad na seznam s automatickým zatříděním záznamů

Kód formuláře seznam2 – seznam2.frm

 Option Explicit

 Private Sub Command1_Click()

If MySize <> 0 Then 'Testování prázdného seznamu

Vyhledej ´ Volání procedury pro určení místa připojení

pripoj

Else

První ´Zápis prvního záznamu

End If

Command2_Click ´Výpis setříděného záznamu

End Sub

 Private Sub Command2_Click() 'Výpis setříděného záznamu

On Error GoTo 2

Dim i As Integer

i = 1

Seek #1, 1

List2.Clear

List1.Clear

Do While Not EOF(1) ´Výpis nesetříděného záznamu

Get #1, , k

List2.AddItem Trim(k.Polozka) & Str(k.Predek) & Str(k.Naslednik)

Loop

Get #1, 1, k

i = k.Predek

Do ´Výpis setříděného záznamu

Get #1, i, k

List1.AddItem k.Polozka

i = k.Naslednik

Loop While i <> 0

2 End Sub

 Private Sub Command3_Click() ´Smazání souboru

Close #1

Kill "seznam1.ttt"

Open "seznam1.ttt" For Random Access Read Write As #1

MySize = 0

End Sub

 Private Sub Form_Load()

Dim i As Integer

Open "seznam1.ttt" For Random Access Read Write As #1 ´Otevření souboru

MySize = 2

End Sub

 Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer) ´Reakce na Enter

If KeyCode = 13 Then

Command1_Click

Text1.Text = ""

End If

End Sub

 

Kód modulu seznam3 – seznam3.bas

Option Explicit

Public Type Prvek ´Deklarace uživatelského typu

Polozka As String * 30

Predek As Integer

Naslednik As Integer

End Type

Public Zacatek As Integer

Public Konec As Integer

Public Pocet

Public Sem As Integer

Public k As Prvek

Public k1 As Prvek

Public k2 As Prvek

Public MySize As Integer

 Public Sub parametry() ´Procedura pro načtení parametrů souboru

Get #1, 1, k

Pocet = Val(k.Polozka)

Konec = k.Naslednik

Zacatek = k.Predek

Get #1, Konec, k1

End Sub

 Public Sub vyhledej() ´Procedura pro vyhledání místa připojení

Dim i As Integer

Sem = 0

parametry

i = Zacatek

Get #1, i, k

Do While Not k.Naslednik = 0

Get #1, i, k

If seznam2.Text1.Text < k.Polozka Then Exit Do

i = k.Naslednik

Sem = i

Loop

End Sub

 Public Sub pripoj()

Vyhledej ´Volání procedury

If k1.Polozka < seznam2.Text1.Text Then ´Připojení na konec

k1.Naslednik = Pocet + 1

Put #1, Konec, k1

k.Polozka = seznam2.Text1.Text

k.Predek = Konec

k.Naslednik = 0

Konec = Pocet + 1

Put #1, Pocet + 1, k

Else If Sem = 0 Then ´Připojení na začátek

Get #1, Zacatek, k1

k1.Predek = Pocet + 1

Put #1, Zacatek, k1

k.Polozka = seznam2.Text1.Text

k.Naslednik = Zacatek

k.Predek = 0

Put #1, Pocet + 1, k

Zacatek = Pocet + 1

Else

Get #1, Sem, k1 ´Připojení uvnitř souboru

Get #1, k1.Predek, k2

k.Polozka = seznam2.Text1.Text

k.Naslednik = Sem

k.Predek = k1.Predek

k1.Predek = Pocet + 1

k2.Naslednik = Pocet + 1

Put #1, Sem, k1

Put #1, Pocet + 1, k

Put #1, k.Predek, k2

End If

End If

Get #1, 1, k

k.Polozka = Str(Pocet + 1)

k.Predek = Zacatek

k.Naslednik = Konec

Put #1, 1, k

End Sub

 Public Sub prvni() ´Vytvoření záznamu pro ukládání parametrů

k1.Polozka = Str(2)

k1.Predek = 2

k1.Naslednik = 2

Put #1, 1, k1

k.Polozka = seznam2.Text1.Text

k.Predek = 0

k.Naslednik = 0

Put #1, 2, k

MySize = 2

End Sub

 

Mapy

Příklad projektu výukového programu mapy . V příkladu je ukázáno využití MIDi Formuláře a možnosti detekce bodů v mapě.

Option Explicit

Dim a As Object, b As Object ´Deklarace instance

 

Private Sub MDIForm_Load() ´Otevření souboru

Open "mapa1.txt" For Random Access Read Write As #1

End Sub

 

 

Private Sub mKonec_Click(Index As Integer) ´Konec práce aplikace

End

End Sub

 

 

Private Sub mTvorba_Click(Index As Integer) ´Volba mapy a dosazení do instance b

On Error Resume Next

Mn = 1

Seek #1, 1

Set b = New Mapa

b.Show

 

a.Visible = False

End Sub

 

Private Sub mVyuka_Click(Index As Integer) ´Volba mapy a dosazení do instance a

On Error Resume Next

Mn = 2

Seek #1, 1

Set a = New Mapa

a.Show

b.Visible = False

End Sub

 

Option Explicit

Dim i As Integer

Dim Jmeno, X1, Y1

Dim M(0 To 50) As a

Dim j As Integer

Private Sub Combo1_Click()

On Error GoTo 2

Text3.Text = Combo1

For i = 0 To 100

If M(i).Jmeno = Text3.Text Then Exit For

Next

Text1.Text = M(i).X1

Text2.Text = M(i).Y1

Label1.Visible = False

Label2.Visible = False

2 End Sub

 Private Sub Command1_Click()

Dim n As a

n.Jmeno = Text3.Text

n.X1 = Text1.Text

n.Y1 = Text2.Text

Mapa.Print j

If j = 1 Then

Put #1, 1, n

j = j + 1

Else

Put #1, , n

End If

Combo1.AddItem n.Jmeno

End Sub

 

Private Sub Form_Activate()

 

On Error GoTo 2

i = 0

Do While Not EOF(1)

Get #1, , M(i)

Combo1.AddItem M(i).Jmeno

i = i + 1

Loop

j = i

If Mn = 1 Then

Combo1 = M(0).Jmeno

Text1.Visible = True

Text2.Visible = True

Text3.Visible = True

Command1.Visible = True

ElseIf Mn = 2 Then

Text1.Visible = False

Text2.Visible = False

Text3.Visible = False

Command1.Visible = False

End If

2 End Sub

Private Sub Form_Load()

If Mn = 2 Then

Image1.Picture = LoadPicture("cr1.bmp")

End If

If Mn = 1 Then

Image1.Picture = LoadPicture("cr.bmp")

End If

End Sub

 Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Text1.Text = X

Text2.Text = Y

For i = 0 To 40

If (((M(i).X1 + 100) >= X) And ((M(i).X1) - 100) < X) And _

(((M(i).Y1 + 100) >= Y) And ((M(i).Y1) - 100) < Y) Then Exit For

Next

Text3.Text = M(i).Jmeno

If Text3.Text = Combo1 And Mn = 2 Then

Label1.Visible = True

Label1.BackColor = &HC000&

Label1.Caption = "Správně"

Label2.Visible = True

Label2.Caption = Text3.Text

ElseIf Text3.Text <> Combo1 And Mn = 2 Then

Label1.Visible = True

Label1.BackColor = &HC0&

Label1.Caption = "Špatně"

Label2.Visible = False

End If

End Sub

Modul mapy.bas

Option Explicit

Public Type a

Jmeno As String * 30

X1 As Integer

Y1 As Integer

End Type

Public Mn As Integer

 

Public Sub konec(j As Integer)

Dim r As a

j = 0

Do While Not EOF(1) ' Loop until end of file.

Get #1, , r ' Read next record.

j = j + 1

Loop

End Sub