Курсовая работа: Создание базы данных о студентах ВУЗа
End If
Open OpenFile For Random As 1 Len = Len(Zapis)
For i = 0 To lstZapis(1).ListCount - 1
Zapis.Студент = lstZapis(0).List(i)
Zapis.Группа = lstZapis(1).List(i)
Zapis.Курс = lstZapis(2).List(i)
Zapis.Работа = lstZapis(3).List(i)
Zapis.Дата_сдачи = lstZapis(4).List(i)
Zapis.Оценка = lstZapis(5).List(i)
Zapis.Дата_выдачи = lstZapis(6).List(i)
Put #1, i + 1, Zapis
Next
Close #1
End If
End If
If OpenFile <> "" Then Me.Caption = strName + " - " + OpenFile
End Sub
Public Sub Edit(strType As String, lngN As Long)
If strType = "Add" Then
frmAdd.Show 1
End If
If strType = "Del" Then
If MsgBox("Вы действительно хотите удалить эту запись?", vbQuestion + vbYesNo) = vbNo Then Exit Sub
For i = 0 To 6
lstZapis(i).RemoveItem (lngN)
Next
End If
If strType = "Edt" Then
lngNumberOfEdit = lngN
frmEdit.txt1.Text = lstZapis(0).List(lngN)
frmEdit.txt2.Text = lstZapis(1).List(lngN)
frmEdit.txt3.Text = lstZapis(2).List(lngN)
frmEdit.txt4.Text = lstZapis(3).List(lngN)
frmEdit.txt5.Text = lstZapis(4).List(lngN)
frmEdit.txt6.Text = lstZapis(5).List(lngN)
frmEdit.txt7.Text = lstZapis(6).List(lngN)
frmEdit.Show 1
End If
End Sub
Public Sub Search(strType As String)
Dim strЗапрос As String
Dim m As Byte
Dim boolF As Boolean
For i = 0 To 6
frmSearch.lstZapis(i).Clear
frmSearch.lstNumbers.Clear
Next
strЗапрос = ""
intPole = -1
If strType = "Fst" Then
strSearch = InputBox("Введите первую букву записи выделенного поля (регистр не учитывается)", "Поиск по первой букве", "а")
For i = 0 To 6
If optPole(i).Value = True Then intPole = i
Next
If intPole = -1 Then MsgBox "Не задано поле для поиска", vbCritical + vbOKOnly, strName: Exit Sub
For i = 0 To lstZapis(intPole).ListCount - 1
If UCase(Left(lstZapis(intPole).List(i), 1)) = UCase(strSearch) Then
For j = 0 To 6
frmSearch.lstZapis(j).AddItem lstZapis(j).List(i)
Next
frmSearch.lstNumbers.AddItem i
End If
Next
If strSearch <> "" Then frmSearch.Show 1
End If
End Sub
Public Sub Help()
frmHelp.Show
End Sub
Public Sub Sort(strType As String, pole As Long)
Dim lng1 As Long
Dim lng2 As Long
If strType = "Up" Then
For lng1 = 0 To lstZapis(pole).ListCount - 1
For lng2 = lng1 To lstZapis(pole).ListCount - 1
If pole <> 4 And pole <> 6 Then
If lstZapis(pole).List(lng1) > lstZapis(pole).List(lng2) Then
Call Замена(lng1, lng2)
End If
Else
If Data_Sort(lstZapis(pole).List(lng1), lstZapis(pole).List(lng2)) = 1 Then
Call Замена(lng1, lng2)
End If
End If
Next
Next
End If
If strType = "Dwn" Then
For lng1 = 0 To lstZapis(pole).ListCount - 1
For lng2 = lng1 To lstZapis(pole).ListCount - 1
If pole <> 4 And pole <> 6 Then
If lstZapis(pole).List(lng1) < lstZapis(pole).List(lng2) Then
Call Замена(lng1, lng2)
End If
Else
If Data_Sort(lstZapis(pole).List(lng1), lstZapis(pole).List(lng2)) = 2 Then
Call Замена(lng1, lng2)
End If
End If
Next
Next
End If
End Sub
Public Sub Format(strType As String)
If strType = "Font" Or strType = "Size" Then
cdl1.Flags = cdlCFScreenFonts
cdl1.Action = 4
For i = 0 To 6
If cdl1.FontSize <> 0 Then lstZapis(i).FontSize = cdl1.FontSize
If Trim(cdl1.FontName) <> "" Then lstZapis(i).FontName = cdl1.FontName
lstZapis(i).FontBold = cdl1.FontBold
lstZapis(i).FontItalic = cdl1.FontItalic
lstZapis(i).FontStrikethru = cdl1.FontStrikethru
lstZapis(i).FontUnderline = cdl1.FontUnderline
Next
End If
If strType = "Color" Then
cdl1.Action = 3
For i = 0 To 6
lstZapis(i).ForeColor = cdl1.Color
Next
End If
End Sub
Public Function Quite() As Boolean
If MsgBox("Вы уверены, что хотите выйти?" + vbNewLine + "Все несохраненные данные будут потеряны", vbQuestion + vbYesNo, strName) = vbYes Then Quite = True Else Quite = False
End Function
Private Sub chkDop_Click()
If chkDop.Value = 0 Then
boolDop = False
frmDatabase.Width = 8625
frmDatabase.Picture = imgMain1.Picture
chkDop.Width = 529
lstZapis(6).Visible = False
optPole(6).Visible = False
mnuLongest.Visible = False
mnuTwoMonth.Visible = False
StatusBar1.Panels(1).Width = 500
Else
boolDop = True
frmDatabase.Picture = imgMain0.Picture
frmDatabase.Width = 10050
chkDop.Width = 617
lstZapis(6).Visible = True
optPole(6).Visible = True
mnuLongest.Visible = True
mnuTwoMonth.Visible = True
StatusBar1.Panels(1).Width = 600
End If
End Sub
Private Sub cmdTool_Click(Index As Integer)
If Index = 0 Then Call Create
If Index = 1 Then Call Open_File
If Index = 2 Then Call Save(0)
If Index = 5 Then
If lstZapis(1).ListIndex <> -1 Then Call Edit("Del", lstZapis(1).ListIndex)
End If
If Index = 4 Then
If lstZapis(1).ListIndex <> -1 Then Call Edit("Edt", lstZapis(1).ListIndex)
End If
If Index = 3 Then Call Edit("Add", 0)
If Index = 7 Then Call Search("Fst")
If Index = 6 Then
If lstZapis(0).ListCount > 0 Then frmDiagramms.Show
End If
If Index = 8 Then Call Help
If Index = 10 Then
For i = 0 To 6
If optPole(i).Value = True Then Call Sort("Up", i)
Next
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
