Создание базы данных о студентах ВУЗа
Курсовой проект - Компьютеры, программирование
Другие курсовые по предмету Компьютеры, программирование
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
""ThenfrmSearch.Show1">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 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 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
0ThenlstZapis(i).FontSize=cdl1.FontSize"> If cdl1.FontSize <> 0 Then lstZapis(i).FontSize = cdl1.FontSize
""ThenlstZapis(i).FontName=cdl1.FontName"> 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
0ThenfrmDiagramms.Show"> 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), ls