49028 (Создание базы данных о студентах ВУЗа), страница 4

2016-07-30СтудИзба

Описание файла

Документ из архива "Создание базы данных о студентах ВУЗа", который расположен в категории "". Всё это находится в предмете "информатика" из 1 семестр, которые можно найти в файловом архиве . Не смотря на прямую связь этого архива с , его также можно найти и в других разделах. Архив можно найти в разделе "курсовые/домашние работы", в предмете "информатика, программирование" в общих файлах.

Онлайн просмотр документа "49028"

Текст 4 страницы из документа "49028"

End If

If Index = 11 Then

For i = 0 To 6

If optPole(i).Value = True Then Call Sort("Dwn", i)

Next

End If

If Index = 9 Then

If Quite = True Then End

End If

For i = 0 To 11

cmdTool(i).Default = False

Next

End Sub

Private Sub Form_Load()

Call init

mnuLongest.Visible = True

mnuTwoMonth.Visible = True

End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)

For i = 0 To 6

optPole(i).Value = False

Next

If Button = 2 Then

PopupMenu mnuFormat

End If

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

If Quite = False Then Cancel = 1

End Sub

Private Sub Form_Unload(Cancel As Integer)

End

End Sub

Private Sub lstZapis_Click(Index As Integer)

For i = 0 To 6

lstZapis(i).ListIndex = lstZapis(Index).ListIndex

Next

End Sub

Private Sub lstZapis_DblClick(Index As Integer)

If lstZapis(1).ListIndex <> -1 Then Call Edit("Edt", lstZapis(1).ListIndex)

End Sub

Private Sub lstZapis_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)

If KeyCode = 46 Then

If lstZapis(1).ListIndex <> -1 Then Call Edit("Del", lstZapis(1).ListIndex)

End If

If KeyCode = 13 Then

If lstZapis(1).ListIndex <> -1 Then Call Edit("Edt", lstZapis(1).ListIndex)

End If

End Sub

Private Sub lstZapis_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)

If Button = 1 Then

For i = 0 To 6

lstZapis(i).ListIndex = lstZapis(Index).ListIndex

Next

End If

If Button = 2 Then

PopupMenu mnuEdit

End If

End Sub

Private Sub mnuAbout_Click()

frmAbout.Show 1

End Sub

Private Sub mnuAdd_Click()

Call Edit("Add", 0)

End Sub

Private Sub mnuChange_Click()

Call Edit("Edt", lstZapis(0).ListIndex)

End Sub

Private Sub mnuColor_Click()

Call Format("Color")

End Sub

Private Sub mnuCreate_Click()

Call Create

End Sub

Private Sub mnuDelete_Click()

Call Edit("Del", lstZapis(0).ListIndex)

End Sub

Private Sub mnuEdit_Click()

If lstZapis(1).ListIndex = -1 Then

mnuDelete.Enabled = False

mnuChange.Enabled = False

Else

mnuDelete = True

mnuChange.Enabled = True

End If

End Sub

Private Sub mnuDown_Click()

For i = 0 To 6

If optPole(i).Value = True Then Call Sort("Dwn", i)

Next

End Sub

Private Sub mnuExit_Click()

If Quite = True Then End

End Sub

Private Sub mnuFirst_Click()

Call Search("Fst")

End Sub

Private Sub mnuFont_Click()

Call Format("Font")

End Sub

Private Sub mnuHelper_Click()

frmHelp.Show

End Sub

Private Sub mnuLongest_Click()

Dim max As Long

For j = 0 To 6

frmSearch.lstZapis(j).Clear

Next

frmSearch.lstNumbers.Clear

max = 0

For i = 0 To lstZapis(0).ListCount - 1

If Date_raz(lstZapis(4).List(i), lstZapis(6).List(i)) > max Then max = Date_raz(lstZapis(4).List(i), lstZapis(6).List(i))

Next

For i = 0 To lstZapis(0).ListCount - 1

If Date_raz(lstZapis(4).List(i), lstZapis(6).List(i)) = max Then

For j = 0 To 6

frmSearch.lstZapis(j).AddItem lstZapis(j).List(i)

Next

frmSearch.lstNumbers.AddItem i

End If

Next

frmSearch.Show 1

End Sub

Private Sub mnuOpen_Click()

Call Open_File

End Sub

Private Sub mnuSave_Click()

Call Save(0)

End Sub

Private Sub mnuSaveAs_Click()

Call Save(1)

End Sub

Private Sub mnuSearch_Click()

If lstZapis(1).ListIndex = -1 Then

mnuZap1.Enabled = False

mnuZap2.Enabled = False

mnuZap4.Enabled = False

Else

mnuZap1.Enabled = True

mnuZap2.Enabled = True

mnuZap4.Enabled = True

End If

End Sub

Private Sub mnuSize_Click()

Call Format("Size")

End Sub

Private Sub mnuTwoMonth_Click()

For i = 0 To 6

frmSearch.lstZapis(i).Clear

Next

frmSearch.lstNumbers.Clear

For i = 0 To lstZapis(0).ListCount - 1

If Date_raz(lstZapis(4).List(i), lstZapis(6).List(i)) > 60 Then

For j = 0 To 6

frmSearch.lstZapis(j).AddItem lstZapis(j).List(i)

Next

frmSearch.lstNumbers.AddItem i

End If

Next

frmSearch.Show 1

End Sub

Private Sub mnuUp_Click()

For i = 0 To 6

If optPole(i).Value = True Then Call Sort("Up", i)

Next

End Sub

Private Sub mnuZap1_Click()

Dim strStud As String

strStud = lstZapis(0).Text

For i = 0 To 6

frmSearch.lstZapis(i).Clear

Next

frmSearch.lstNumbers.Clear

For i = 0 To lstZapis(1).ListCount - 1

If lstZapis(0).List(i) = strStud Then

For j = 0 To 6

frmSearch.lstZapis(j).AddItem lstZapis(j).List(i)

Next

frmSearch.lstNumbers.AddItem i

End If

Next

frmSearch.Show 1

End Sub

Private Sub mnuZap2_Click()

Dim strMounth As String

Dim strGroop As String

For i = 0 To 6

frmSearch.lstZapis(i).Clear

Next

frmSearch.lstNumbers.Clear

strGroop = lstZapis(1).Text

strMounth = InputBox("Введите номер месяца", "За какой месяц?", Mid(Date, 4, 2))

If Number(strMounth, False, True, 1, 12) = False Then

MsgBox NumError, vbCritical + vbOKOnly, strName

Exit Sub

End If

For i = 0 To lstZapis(0).ListCount - 1

If lstZapis(1).List(i) = strGroop Then

If (CInt(Mid(lstZapis(4).List(i), 4, 2)) = CInt(strMounth)) And (lstZapis(1).List(i) = strGroop) Then

For j = 0 To 6

frmSearch.lstZapis(j).AddItem lstZapis(j).List(i)

Next

frmSearch.lstNumbers.AddItem i

End If

End If

Next

frmSearch.Show 1

End Sub

Private Sub mnuZap3_Click()

Dim stud As String

Dim n As Integer

Dim k

k = 0

'Подготовка формы поиска

For n = 0 To 6

frmSearch.lstZapis(n).Clear

Next

frmSearch.lstNumbers.AddItem i

'Выбор студента

For i = 0 To lstZapis(0).ListCount - 1

k = 0: lstDates.Clear

stud = lstZapis(0).List(i)

'Внесение всех его дат сдачи в список дат

For j = 0 To lstZapis(0).ListCount - 1

If lstZapis(0).List(j) = stud Then lstDates.AddItem lstZapis(4).List(i)

Next

'Проверка дат на совпадение

For n = 0 To lstDates.ListCount - 1

For j = 0 To lstDates.ListCount - 1

'Если совпадает, увеличиваем счетчик на 1

If lstDates.List(n) = lstDates.List(j) And n <> j Then k = k + 1

Next

Next

'Если больше 2-х одинаковых, вносим в результат

If k > 2 Then

For n = 0 To 6

frmSearch.lstZapis(n).AddItem lstZapis(n).List(i)

Next

frmSearch.lstNumbers.AddItem i

End If

Next

frmSearch.Show 1

End Sub

Private Sub mnuZap4_Click()

Dim strKurs As String

strKurs = lstZapis(2).Text

For i = 0 To 6

frmSearch.lstZapis(i).Clear

Next

frmSearch.lstNumbers.Clear

For i = 0 To lstZapis(1).ListCount - 1

If (lstZapis(5).List(i) = "4" Or lstZapis(5).List(i) = "5") And (lstZapis(2).List(i) = strKurs) Then

For j = 0 To 6

frmSearch.lstZapis(j).AddItem lstZapis(j).List(i)

Next

frmSearch.lstNumbers.AddItem i

End If

Next

frmSearch.Show 1

End Sub

Public Sub Замена(lngЧто As Long, lngНа As Long)

Dim str1 As String

Dim int3 As Byte

For int3 = 0 To 6

str1 = lstZapis(int3).List(lngНа)

lstZapis(int3).List(lngНа) = lstZapis(int3).List(lngЧто)

lstZapis(int3).List(lngЧто) = str1

Next

End Sub

Public Function ОтрезИмя(Путь As String) As String

Dim b As String

j = 1

Do While Left$(Right$(Путь, j), 1) <> "\"

j = j + 1

Loop

ОтрезИмя = Left$(Путь, Len(Путь) - j + 1)

'n = n + 1

End Function

Public Function Data_Sort(dat1 As String, dat2 As String) As Byte

If CInt(Right$(dat1, 4)) > CInt(Right$(dat2, 4)) Then Data_Sort = 1

If CInt(Right$(dat1, 4)) < CInt(Right$(dat2, 4)) Then Data_Sort = 2

If CInt(Right$(dat1, 4)) = CInt(Right$(dat2, 4)) Then

If CInt(Mid$(dat1, 4, 2)) > CInt(Mid$(dat2, 4, 2)) Then Data_Sort = 1

If CInt(Mid$(dat1, 4, 2)) < CInt(Mid$(dat2, 4, 2)) Then Data_Sort = 2

If CInt(Mid$(dat1, 4, 2)) = CInt(Mid$(dat2, 4, 2)) Then

If CInt(Left$(dat1, 2)) > CInt(Left$(dat2, 2)) Then Data_Sort = 1

If CInt(Left$(dat1, 2)) < CInt(Left$(dat2, 2)) Then Data_Sort = 2

If CInt(Left$(dat1, 2)) = CInt(Left$(dat2, 2)) Then Data_Sort = 3

End If

End If

End Function

frmAdd

Dim bool5 As Boolean

Dim bool7 As Boolean

Private Sub Calendar1_Click()

If bool5 = True Then Me.txt5.Text = CStr(Calendar1.Day) + "." + CStr(Calendar1.Month) + "." + CStr(Calendar1.Year): bool5 = False

If bool7 = True Then Me.txt7.Text = CStr(Calendar1.Day) + "." + CStr(Calendar1.Month) + "." + CStr(Calendar1.Year): bool7 = False

Me.Width = 6135

Me.Picture = imgMain0.Picture

If Mid$(txt5.Text, 2, 1) = "." Then txt5.Text = "0" + txt5.Text

If Mid$(txt7.Text, 2, 1) = "." Then txt7.Text = "0" + txt7.Text

If Mid$(txt5.Text, 5, 1) = "." Then txt5.Text = Left(txt5.Text, 3) + "0" + Right(txt5.Text, 6)

If Mid$(txt7.Text, 5, 1) = "." Then txt7.Text = Left(txt7.Text, 3) + "0" + Right(txt7.Text, 6)

End Sub

Private Sub cmdAdd_Click()

If txt1.Text <> "" And txt2.Text <> "" And txt3.Text <> "" And txt4.Text <> "" And txt4.Text <> "" Then

'If Number(txt2.Text, False, True, 0, 120) = False Then

'MsgBox NumError, vbCritical + vbOKOnly, "Неверно введена группа"

'Exit Sub

'End If

If Number(txt6.Text, False, True, 0, 5) = False Then

MsgBox NumError, vbCritical + vbOKOnly, "Неверно введена оценка"

Exit Sub

End If

If (Not IsDate(txt5.Text)) Or (Not IsDate(txt7.Text)) Then

MsgBox "Дата выдачи или дата сдачи записана неверно", vbCritical + vbOKOnly, "Неверно введена дата"

Exit Sub

End If

If Date_raz(txt5.Text, txt7.Text) < 0 Then

MsgBox "Дата выдачи больше даты сдачи", vbCritical + vbOKOnly, "Неверно введена дата"

Exit Sub

End If

frmDatabase.lstZapis(0).AddItem txt1.Text

frmDatabase.lstZapis(1).AddItem txt2.Text

frmDatabase.lstZapis(2).AddItem txt3.Text

frmDatabase.lstZapis(3).AddItem txt4.Text

frmDatabase.lstZapis(4).AddItem txt5.Text

frmDatabase.lstZapis(5).AddItem txt6.Text

frmDatabase.lstZapis(6).AddItem txt7.Text

Unload Me

End If

End Sub

Private Sub Form_Load()

For i = 0 To intВсегоПолей

Me.lbl(i).Caption = strПоле(i)

Next

Me.Icon = frmDatabase.imlButtons.ListImages(6).Picture

End Sub

Private Sub txt5_Click()

bool5 = True

bool7 = False

Me.Width = 9840

Me.Picture = imgMain1.Picture

End Sub

Private Sub txt7_Click()

bool7 = True

bool5 = False

Me.Width = 9840

Me.Picture = imgMain1.Picture

End Sub

frmEdit

Dim bool5 As Boolean

Dim bool7 As Boolean

Private Sub Calendar1_Click()

If bool5 = True Then Me.txt5.Text = CStr(Calendar1.Day) + "." + CStr(Calendar1.Month) + "." + CStr(Calendar1.Year): bool5 = False

If bool7 = True Then Me.txt7.Text = CStr(Calendar1.Day) + "." + CStr(Calendar1.Month) + "." + CStr(Calendar1.Year): bool7 = False

Me.Width = 6135

Me.Picture = imgMain0.Picture

If Mid$(txt5.Text, 2, 1) = "." Then txt5.Text = "0" + txt5.Text

If Mid$(txt7.Text, 2, 1) = "." Then txt7.Text = "0" + txt7.Text

If Mid$(txt5.Text, 5, 1) = "." Then txt5.Text = Left(txt5.Text, 3) + "0" + Right(txt5.Text, 6)

If Mid$(txt7.Text, 5, 1) = "." Then txt7.Text = Left(txt7.Text, 3) + "0" + Right(txt7.Text, 6)

End Sub

Private Sub cmdEdit_Click()

If txt1.Text <> "" And txt2.Text <> "" And txt3.Text <> "" And txt4.Text <> "" And txt4.Text <> "" Then

'If Number(txt2.Text, False, True, 0, 120) = False Then

'MsgBox NumError, vbCritical + vbOKOnly, "Неверно введена группа"

'Exit Sub

'End If

If Number(txt6.Text, False, True, 0, 5) = False Then

MsgBox NumError, vbCritical + vbOKOnly, "Неверно введена оценка"

Exit Sub

End If

If (Not IsDate(txt5.Text)) Or (Not IsDate(txt7.Text)) Then

MsgBox "Дата выдачи или дата сдачи записана неверно", vbCritical + vbOKOnly, "Неверно введена дата"

Exit Sub

Свежие статьи
Популярно сейчас
Зачем заказывать выполнение своего задания, если оно уже было выполнено много много раз? Его можно просто купить или даже скачать бесплатно на СтудИзбе. Найдите нужный учебный материал у нас!
Ответы на популярные вопросы
Да! Наши авторы собирают и выкладывают те работы, которые сдаются в Вашем учебном заведении ежегодно и уже проверены преподавателями.
Да! У нас любой человек может выложить любую учебную работу и зарабатывать на её продажах! Но каждый учебный материал публикуется только после тщательной проверки администрацией.
Вернём деньги! А если быть более точными, то автору даётся немного времени на исправление, а если не исправит или выйдет время, то вернём деньги в полном объёме!
Нет! Мы не выполняем работы на заказ, однако Вы можете попросить что-то выложить в наших социальных сетях.
Добавляйте материалы
и зарабатывайте!
Продажи идут автоматически
4098
Авторов
на СтудИзбе
667
Средний доход
с одного платного файла
Обучение Подробнее