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

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

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

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

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

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

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

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