Лекции.Орг


Поиск:




Создание файла прямого доступа




Задание: Проверка приборов

Программный код:

 

Dim s As Stud

Dim namefayl As String

Private Sub CmdNew_Click()

Text1.SetFocus

nfayl1 = FreeFile

info = InputBox("Ввести запись? у/п")

If info = "y" Then

Open namefayl For Random As #nfayl1

nz = nz + 1

s.fio = Text1.Text

s.adr = Text4.Text

s.dat = Val(Text5.Text)

s.gr = Text6.Text

's.bal = Val(Text7.Text)

Put #nfayl1, nz, s

'Debug.Print s.fio, s.adr, s.dat, s.gr, s.bal

MsgBox "Запись введена!", vbExclamation

List1.AddItem s.fio

Close nfayl1

End If

End Sub

Private Sub CmdВывод_Click()

'Dim st As String

nfayl1 = FreeFile

Open namefayl For Random As #nfayl1

Do While Not EOF(nfayl1)

Get #nfayl1,, s

Debug.Print s.fio; s.adr; s.dat; s.gr; s.bal

'st = st & s.fio & s.adr & CStr(s.dat) & CStr(s.gr) & CStr(s.bal) & Chr(13)

List1.AddItem s.fio

Loop

'MsgBox st

Close nfayl1

End Sub

Private Sub CmdДобавить_Click()

nfayl2 = FreeFile

Open namefayl For Random As #nfayl2

Do While Not EOF(nfayl2)

Get #nfayl2,, s

Loop

m = Seek(nfayl2)

s.fio = Text1.Text

s.adr = Text4.Text

s.dat = Val(Text5.Text)

s.gr = Text6.Text

's.bal = Val(Text7.Text)

Put #nfayl2, m, s

'Debug.Print s.fio, s.adr, s.dat, s.gr, s.bal

MsgBox "Запись добавлена!", vbExclamation

List1.AddItem s.fio

Close nfayl2

Text1.Text = ""

Text4.Text = ""

Text5.Text = ""

Text6.Text = ""

'Text7.Text = ""

Text1.SetFocus

End Sub

Private Sub CmdПоиск_Click()

Dim f As String

Dim nz As Integer

nz = 0

nfayl2 = 1

Open namefayl For Random As #nfayl2

f = InputBox("Поиск по первой букве фамилии")

Debug.Print "Результаты поиска"

Do While Not EOF(nfayl2)

Get #nfayl2,, s

'Debug.Print s.fio s.adr s.dat s.gr s.bal

If Left(f, 1) = Left(s.fio, 1) Then

'Debug.Print s.fio; s.adr; s.dat; s.gr; s.bal

Text2.Text = Text2.Text & s.fio & s.adr & s.dat & s.gr & s.bal & Chr(13) & Chr(10)

nz = Loc(nfayl2)

v = MsgBox("Удалить?", vbYesNo)

If v = vbYes Then

s.fio = "": s.adr = "": s.gr = "": s.bal = 0

Put #nfayl2, nz, s

'List1.RemoveItem (nz - 1)

End If

End If

Loop

If nz = 0 Then MsgBox "Запись не найдена!", vbExclamation

Close

End Sub

Private Sub CmdСброс_Click()

Text1.Text = ""

Text4.Text = ""

Text5.Text = ""

Text6.Text = ""

'Text7.Text = ""

Text1.SetFocus

Text2.Text = ""

List1.Clear

End Sub

Private Sub CmdУдалить_Click()

nfayl1 = 1

nfayl2 = 2

Open namefayl For Random As #nfayl1

Open "D:\A.txt" For Random As #nfayl2

Do While Not EOF(nfayl1)

Get #nfayl1,, s

If Left(s.fio, 1) <> " " Then

n = n + 1

Put #nfayl2, n, s

'Debug.Print s.fio; s.adr; s.dat; s.gr; s.bal

'Debug.Print n

End If

Loop

'nz = List1.Listindex

'List1.RemoveItem nz

MsgBox "Запись удалена!"

Close

Kill namefayl

Name "D:\A.txt" As namefayl

Text2.Text = ""

End Sub

Private Sub Command6_Click()

End

End Sub

'Private Sub UpDown1_Change()

'Text7.Text = Str(UpDown1.Value)

'End Sub

'Private Sub Text7_Change()

'UpDown1.Value = Val(Text7.Text)

'End Sub

Private Sub Form_Load()

info = InputBox("Создать новый файл у/п?")

If info = "y" Then

CmdNew.Enabled = True

End If

MsgBox "Введите имя файла!"

namefayl = Text3.Text

End Sub

 

Скриншоты:





Поделиться с друзьями:


Дата добавления: 2016-11-12; Мы поможем в написании ваших работ!; просмотров: 330 | Нарушение авторских прав


Поиск на сайте:

Лучшие изречения:

Что разум человека может постигнуть и во что он может поверить, того он способен достичь © Наполеон Хилл
==> читать все изречения...

968 - | 881 -


© 2015-2024 lektsii.org - Контакты - Последнее добавление

Ген: 0.008 с.