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

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

Kill OpenFile

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

If MsgBox("Файл уже существует. Перезаписать?", 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

'Заполнение количества должников

For i = 0 To lstGroops2.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

'Надпись легенды

picRound.Print " " + Left(lstKurs.List(i), 3) + " " + CStr(Int((CInt(lstKurs2.List(i)) * 100 / ob))) + "%"

Next

'Оформление диаграммы

For i = 0 To 7

picRound.Circle (0, -i + 20), 80, , 3.14, 6.28, 0.5

Next

End Sub

Public Sub Stolb(Групп As Integer)

Dim intStWidth As Integer 'Ширина 1 столбца

Dim ed As Integer 'picStolb.scaleheight/Максимальное значение - это одна единица графика

Dim max As Integer

Const dw As Byte = 10 'Промежуток между столбцами

intStWidth = Int(picStolb.ScaleWidth / Групп) - dw

max = CInt(lstKol.List(0))

For i = 0 To lstKol.ListCount - 1

If CInt(lstKol.List(i)) > max Then max = CInt(lstKol.List(i))

Next

ed = 0

If max <> 0 Then ed = picStolb.ScaleHeight / max

'9*ed - высота, равная 9 единицам

For i = 0 To Групп - 1

picStolb.Line (0 + i * (intStWidth + dw), picStolb.ScaleHeight)-(intStWidth + i * (intStWidth + dw), picStolb.ScaleHeight - CInt(lstKol.List(i)) * ed), QBColor(i + 10), BF

Next

'Установка надписей с названими групп

For i = 0 To Групп - 1

picStolb.CurrentX = ((intStWidth - Len(lstGroops.List(i))) / 2) + (dw + intStWidth) * i

picStolb.CurrentY = picStolb.ScaleHeight - 25

picStolb.Print lstGroops.List(i)

Next

End Sub