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
End If
If Date_raz(txt5.Text, txt7.Text) < 0 Then
MsgBox "Дата выдачи больше даты сдачи", vbCritical + vbOKOnly, "Неверно введена дата"
Exit Sub
End If
frmDatabase.lstZapis(0).List(lngNumberOfEdit) = txt1.Text
frmDatabase.lstZapis(1).List(lngNumberOfEdit) = txt2.Text
frmDatabase.lstZapis(2).List(lngNumberOfEdit) = txt3.Text
frmDatabase.lstZapis(3).List(lngNumberOfEdit) = txt4.Text
frmDatabase.lstZapis(4).List(lngNumberOfEdit) = txt5.Text
frmDatabase.lstZapis(5).List(lngNumberOfEdit) = txt6.Text
frmDatabase.lstZapis(6).List(lngNumberOfEdit) = txt7.Text
Unload Me
End If
End Sub
Private Sub Form_Load()
Me.Icon = frmDatabase.imlButtons.ListImages(5).Picture
For i = 0 To intВсегоПолей
Me.lbl(i).Caption = strПоле(i)
Next
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
frmSearch
Private Sub cmdSave_Click()
Call Save(1)
End Sub
Private Sub Form_Activate()
If lstZapis(0).ListCount = 0 Then cmdSave.Enabled = False Else cmdSave.Enabled = True
StatusBar1.Panels(2).Text = lstZapis(0).ListCount
End Sub
Private Sub Form_Load()
For i = 0 To intВсегоПолей
Me.lbl(i).Caption = strПоле(i)
Next
Me.Icon = frmDatabase.imlButtons.ListImages(7).Picture
End Sub
Private Sub lstZapis_Click(Index As Integer)
For i = 0 To 6
lstZapis(i).ListIndex = lstZapis(Index).ListIndex
Next
lstNumbers.ListIndex = lstZapis(Index).ListIndex
End Sub
Private Sub lstZapis_DblClick(Index As Integer)
For i = 0 To 6
frmDatabase.lstZapis(i).ListIndex = lstNumbers.Text
Next
Unload Me
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
lstNumbers.ListIndex = lstZapis(Index).ListIndex
End If
End Sub
Public Sub Save(intSaveAs As Byte)
Dim strФильтр As String
If intSaveAs = 0 And OpenFile <> "" Then
If Dir(OpenFile) = Right$(OpenFile, Len(OpenFile) - Len(ОтрезИмя(OpenFile))) Then
KillOpenFile
Else
OpenFile = ""
MsgBox "Сохраненный файл был удален или поврежден. Попробуйте сохранить еще раз", vbCritical + vbOKOnly, strName
Exit Sub
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
Else
strФильтр = "Файлы " + strName + " (*." + strРасширение + ")|*." + strРасширение + "|"
cdl1.Filter = strФильтр
cdl1.Action = 2
If cdl1.FileName <> "" Then
OpenFile = cdl1.FileName
If Dir(OpenFile) = Right$(OpenFile, Len(OpenFile) - Len(ОтрезИмя(OpenFile))) Then
IfMsgBox("Файл уже существует. Перезаписать?", vbQuestion + vbYesNo, strName) = vbNo Then Exit Sub
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 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
frmDiagramms
Dim lngAll As Long
Dim lngPoKursu As Long
Dim intGroops As Integer
Private Sub cboОценка_Click()
Dim k As Integer
lstKol.Clear
picStolb.Cls
'Подсчет количества студентов каждой группы, получивших заданную оценку
For i = 0 To lstGroops.ListCount - 1
k = 0
For j = 0 To frmDatabase.lstZapis(1).ListCount - 1
If frmDatabase.lstZapis(1).List(j) = lstGroops.List(i) And frmDatabase.lstZapis(5).List(j) = cboОценка.Text Then k = k + 1
Next
lstKol.AddItem k
Next
Call Stolb(lstGroops.ListCount)
End Sub
Private Sub cmdDiags_Click(Index As Integer)
If Index = 0 Then fraRound.Visible = True: fraStolb.Visible = False: fraGraf.Visible = False
If Index = 1 Then fraRound.Visible = False: fraStolb.Visible = True: fraGraf.Visible = False
If Index = 2 Then fraRound.Visible = False: fraStolb.Visible = False: fraGraf.Visible = True
End Sub
Private Sub Form_Load()
Dim bt As Boolean
Dim gr As Integer
Dim k As Integer
intGrad = 90
lstKurs.Clear
lstGroops2.Clear
lstGroops.Clear
For i = 0 To frmDatabase.lstZapis(1).ListCount - 1
bt = True
For j = 0 To lstKurs.ListCount - 1
If lstKurs.List(j) = frmDatabase.lstZapis(2).List(i) Then bt = False
Next
If bt = True Then
lstKurs.AddItem frmDatabase.lstZapis(2).List(i)
bt = False
End If
Next
Me.Icon = frmDatabase.imlButtons.ListImages(8).Picture
lstKurs.AddItem "По всем курсам"
'Заполнение по всем курсам лист-бокса с количеством работ lstKurs2
lstKurs2.Clear
For j = 0 To lstKurs.ListCount - 2
lngPoKursu = 0
For i = 0 To frmDatabase.lstZapis(2).ListCount - 1
If frmDatabase.lstZapis(2).List(i) = lstKurs.List(j) Then lngPoKursu = lngPoKursu + 1
Next
lstKurs2.AddItem lngPoKursu
Next
lstKurs2.AddItem CStr(frmDatabase.lstZapis(0).ListCount)
'Подсчет количества групп
For i = 0 To frmDatabase.lstZapis(0).ListCount - 1
gr = -1
For j = 0 To lstGroops.ListCount - 1
If lstGroops.List(j) = frmDatabase.lstZapis(1).List(i) Then gr = j
Next
If gr = -1 Then lstGroops.AddItem frmDatabase.lstZapis(1).List(i)
Next
'Копирование лист-бокса групп
For i = 0 To lstGroops.ListCount - 1
lstGroops2.AddItem lstGroops.List(i)
Next
'Заполнение количества должников
Fori = 0 TolstGroops2.ListCount - 1
k = 0
For j = 0 To frmDatabase.lstZapis(1).ListCount - 1
If frmDatabase.lstZapis(1).List(j) = lstGroops2.List(i) Then
If Date_raz(frmDatabase.lstZapis(4).List(j), frmDatabase.lstZapis(6).List(j)) > 30 Then k = k + 1
End If
Next
lstkol2.AddItem k
Next
Call Graf
End Sub
Public Sub Round(ob_kol As Long, kol1 As Long)
Dim i As Integer
picRound.Scale (-100, 100)-(100, -100)
picRound.FillColor = vbGreen
picRound.Circle (0, 0), 80, , -0.0007, -kol1 * 6.28 / ob_kol, 0.5
picRound.FillColor = vbRed
picRound.Circle (0, 0), 80, , -kol1 * 6.28 / ob_kol, -6.28, 0.5
For i = 0 To 7
picRound.Circle (0, -i), 80, , 3.14, 6.28, 0.5
Next
picRound.Circle (0, -7), 80, , 3.14, 6.28, 0.5
picRound.Line (-80, 0)-(-80, -7)
picRound.Line (80, 0)-(80, -7)
lblPersent.Caption = CStr(Int(kol1 * 100 / ob_kol)) + " %"
End Sub
Private Sub lstGroops_Click()
If lstKol.ListCount <> 0 Then lstKol.ListIndex = lstGroops.ListIndex
End Sub
Private Sub lstGroops_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
If lstKol.ListCount <> 0 Then lstKol.ListIndex = lstGroops.ListIndex
End Sub
Private Sub lstGroops2_Click()
If lstkol2.ListCount <> 0 Then lstkol2.ListIndex = lstGroops2.ListIndex
End Sub
Private Sub lstGroops2_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
If lstkol2.ListCount <> 0 Then lstkol2.ListIndex = lstGroops2.ListIndex
End Sub
Private Sub lstKol_Click()
If lstGroops.ListCount <> 0 Then lstGroops.ListIndex = lstKol.ListIndex
End Sub
Private Sub lstKol_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
If lstGroops.ListCount <> 0 Then lstGroops.ListIndex = lstKol.ListIndex
End Sub
Private Sub lstkol2_Click()
If lstGroops2.ListCount <> 0 Then lstGroops2.ListIndex = lstkol2.ListIndex
End Sub
Private Sub lstkol2_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
If lstGroops2.ListCount <> 0 Then lstGroops2.ListIndex = lstkol2.ListIndex
End Sub
Private Sub lstKurs_Click()
If lstKurs2.ListCount <> 0 Then lstKurs2.ListIndex = lstKurs.ListIndex
If lstKurs.Text = "По всем курсам" Then
picRound.Cls
lblPersent.Visible = False
lbl(0).Caption = "По каждому курсу"
lngAll = frmDatabase.lstZapis(1).ListCount
If lstKurs.ListCount > 1 Then Call AllKurs
Else
picRound.Cls
lblPersent.Visible = True
lbl(0).Caption = "От всех работ выбранный курс составляет:"
lngPoKursu = 0
lngAll = frmDatabase.lstZapis(1).ListCount
For i = 0 To frmDatabase.lstZapis(2).ListCount - 1
If frmDatabase.lstZapis(2).List(i) = lstKurs.Text Then lngPoKursu = lngPoKursu + 1
Next
Call Round(lngAll, lngPoKursu)
End If
End Sub
Private Sub lstKurs_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
If lstKurs2.ListCount <> 0 Then lstKurs2.ListIndex = lstKurs.ListIndex
End Sub
Public Sub AllKurs()
Dim i As Integer
Dim ob As Integer
Dim current As Single
current = -0.0007
ob = CInt(lstKurs2.List(lstKurs2.ListCount - 1))
picRound.Cls
'Построение диаграммы
picRound.Scale (-100, 100)-(100, -100)
picRound.FillColor = 2
For i = 0 To lstKurs2.ListCount - 2
picRound.FillColor = QBColor(i + 10)
picRound.Circle (0, 20), 80, , current, current - CInt(lstKurs2.List(i)) * 6.28 / ob, 0.5
current = current - CInt(lstKurs2.List(i)) * 6.28 / ob
'Легенда
picRound.Line (-90 + Int(i / 3) * 80, -60 - 15 * (i - Int(i / 3) * 3))-(-100 + Int(i / 3) * 80, -50 - 15 * (i - Int(i / 3) * 3)), QBColor(i + 10), BF