|
Создание базы данных о студентах ВУЗа |
rmDatabase.lstZapis(1).AddItem txt2.TextfrmDatabase.lstZapis(2).AddItem txt3.TextfrmDatabase.lstZapis(3).AddItem txt4.TextfrmDatabase.lstZapis(4).AddItem txt5.TextfrmDatabase.lstZapis(5).AddItem txt6.TextfrmDatabase.lstZapis(6).AddItem txt7.TextUnload MeEnd IfEnd SubPrivate Sub Form_Load()For i = 0 To intВсегоПолейMe.lbl(i).Caption = strПоле(i)NextMe.Icon = frmDatabase.imlButtons.ListImages(6).PictureEnd SubPrivate Sub txt5_Click()bool5 = Truebool7 = FalseMe.Width = 9840Me.Picture = imgMain1.PictureEnd SubPrivate Sub txt7_Click()bool7 = Truebool5 = FalseMe.Width = 9840Me.Picture = imgMain1.PictureEnd SubfrmEditDim bool5 As BooleanDim bool7 As BooleanPrivate Sub Calendar1_Click()If bool5 = True Then Me.txt5.Text = CStr(Calendar1.Day) + "." + CStr(Calendar1.Month) + "." + CStr(Calendar1.Year): bool5 = FalseIf bool7 = True Then Me.txt7.Text = CStr(Calendar1.Day) + "." + CStr(Calendar1.Month) + "." + CStr(Calendar1.Year): bool7 = FalseMe.Width = 6135Me.Picture = imgMain0.PictureIf Mid$(txt5.Text, 2, 1) = "." Then txt5.Text = "0" + txt5.TextIf Mid$(txt7.Text, 2, 1) = "." Then txt7.Text = "0" + txt7.TextIf 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 SubPrivate 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 IfIf Number(txt6.Text, False, True, 0, 5) = False ThenMsgBox NumError, vbCritical + vbOKOnly, "Неверно введена оценка"Exit SubEnd IfIf (Not IsDate(txt5.Text)) Or (Not IsDate(txt7.Text)) ThenMsgBox "Дата выдачи или дата сдачи записана неверно", vbCritical + vbOKOnly, "Неверно введена дата"Exit SubEnd IfIf Date_raz(txt5.Text, txt7.Text) < 0 ThenMsgBox "Дата выдачи больше даты сдачи", vbCritical + vbOKOnly, "Неверно введена дата"Exit SubEnd IffrmDatabase.lstZapis(0).List(lngNumberOfEdit) = txt1.TextfrmDatabase.lstZapis(1).List(lngNumberOfEdit) = txt2.TextfrmDatabase.lstZapis(2).List(lngNumberOfEdit) = txt3.TextfrmDatabase.lstZapis(3).List(lngNumberOfEdit) = txt4.TextfrmDatabase.lstZapis(4).List(lngNumberOfEdit) = txt5.TextfrmDatabase.lstZapis(5).List(lngNumberOfEdit) = txt6.TextfrmDatabase.lstZapis(6).List(lngNumberOfEdit) = txt7.TextUnload MeEnd IfEnd SubPrivate Sub Form_Load()Me.Icon = frmDatabase.imlButtons.ListImages(5).PictureFor i = 0 To intВсегоПолейMe.lbl(i).Caption = strПоле(i)NextEnd SubPrivate Sub txt5_Click()bool5 = Truebool7 = FalseMe.Width = 9840Me.Picture = imgMain1.PictureEnd SubPrivate Sub txt7_Click()bool7 = Truebool5 = FalseMe.Width = 9840Me.Picture = imgMain1.PictureEnd SubfrmSearchPrivate Sub cmdSave_Click()Call Save(1)End SubPrivate Sub Form_Activate()If lstZapis(0).ListCount = 0 Then cmdSave.Enabled = False Else cmdSave.Enabled = TrueStatusBar1.Panels(2).Text = lstZapis(0).ListCountEnd SubPrivate Sub Form_Load()For i = 0 To intВсегоПолейMe.lbl(i).Caption = strПоле(i)NextMe.Icon = frmDatabase.imlButtons.ListImages(7).PictureEnd SubPrivate Sub lstZapis_Click(Index As Integer)For i = 0 To 6lstZapis(i).ListIndex = lstZapis(Index).ListIndexNextlstNumbers.ListIndex = lstZapis(Index).ListIndexEnd SubPrivate Sub lstZapis_DblClick(Index As Integer)For i = 0 To 6frmDatabase.lstZapis(i).ListIndex = lstNumbers.TextNextUnload MeEnd SubPrivate Sub lstZapis_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)If Button = 1 ThenFor i = 0 To 6lstZapis(i).ListIndex = lstZapis(Index).ListIndexNextlstNumbers.ListIndex = lstZapis(Index).ListIndexEnd IfEnd SubPublic Sub Save(intSaveAs As Byte)Dim strФильтр As StringIf 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 #1Else 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 IfEnd IfIf OpenFile <> "" Then Me.Caption = strName + " - " + OpenFileEnd SubPublic Function ОтрезИмя(Путь As String) As StringDim b As Stringj = 1Do While Left$(Right$(Путь, j), 1) <> "\"j = j + 1LoopОтрезИмя = Left$(Путь, Len(Путь) - j + 1)'n = n + 1End FunctionfrmDiagrammsDim lngAll As LongDim lngPoKursu As LongDim intGroops As IntegerPrivate Sub cboОценка_Click()Dim k As IntegerlstKol.ClearpicStolb.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 NextlstKol.AddItem kNextCall Stolb(lstGroops.ListCount)End SubPrivate Sub cmdDiags_Click(Index As Integer)If Index = 0 Then fraRound.Visible = True: fraStolb.Visible = False: fraGraf.Visible = FalseIf Index = 1 Then fraRound.Visible = False: fraStolb.Visible = True: fraGraf.Visible = FalseIf Index = 2 Then fraRound.Visible = False: fraStolb.Visible = False: fraGraf.Visible = TrueEnd SubPrivate Sub Form_Load()Dim bt As BooleanDim gr As IntegerDim k As IntegerintGrad = 90lstKurs.ClearlstGroops2.ClearlstGroops.ClearFor i = 0 To frmDatabase.lstZapis(1).ListCount - 1bt = 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 IfNextMe.Icon = frmDatabase.imlButtons.ListImages(8).PicturelstKurs.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 NextlstKurs2.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 - 1lstGroops2.AddItem lstGroops.List(i)Next'Заполнение количества должниковFor i = 0 To lstGroops2.ListCount - 1k = 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 Nextlstkol2.AddItem kNextCall GrafEnd SubPublic Sub Round(ob_kol As Long, kol1 As Long)Dim i As IntegerpicRound.Scale (-100, 100)-(100, -100)picRound.FillColor = vbGreenpicRound.Circle (0, 0), 80, , -0.0007, -kol1 * 6.28 / ob_kol, 0.5picRound.FillColor = vbRedpicRound.Circle (0, 0), 80, , -kol1 * 6.28 / ob_kol, -6.28, 0.5For i = 0 To 7 picRound.Circle (0, -i), 80, , 3.14, 6.28, 0.5NextpicRound.Circle (0, -7), 80, , 3.14, 6.28, 0.5picRound.Line (-80, 0)-(-80, -7)picRound.Line (80, 0)-(80, -7)lblPersent.Caption = CStr(Int(kol1 * 100 / ob_kol)) + " %"End SubPrivate Sub lstGroops_Click()If lstKol.ListCount <> 0 Then lstKol.ListIndex = lstGroops.ListIndexEnd SubPrivate Sub lstGroops_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)If lstKol.ListCount <> 0 Then lstKol.ListIndex = lstGroops.ListIndexEnd SubPrivate Sub lstGroops2_Click()If lstkol2.ListCount <> 0 Then lstkol2.ListIndex = lstGroops2.ListIndexEnd SubPrivate Sub lstGroops2_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)If lstkol2.ListCount <> 0 Then lstkol2.ListIndex = lstGroops2.ListIndexEnd SubPrivate Sub lstKol_Click()If lstGroops.ListCount <> 0 Then lstGroops.ListIndex = lstKol.ListIndexEnd SubPrivate Sub lstKol_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)If lstGroops.ListCount <> 0 Then lstGroops.ListIndex = lstKol.ListIndexEnd SubPrivate Sub lstkol2_Click()If lstGroops2.ListCount <> 0 Then lstGroops2.ListIndex = lstkol2.ListIndexEnd SubPrivate Sub lstkol2_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)If lstGroops2.ListCount <> 0 Then lstGroops2.ListIndex = lstkol2.ListIndexEnd SubPrivate Sub lstKurs_Click()If lstKurs2.ListCount <> 0 Then lstKurs2.ListIndex = lstKurs.ListIndexIf lstKurs.Text = "По всем курсам" Then picRound.Cls lblPersent.Visible = False lbl(0).Caption = "По каждому курсу" lngAll = frmDatabase.lstZapis(1).ListCountIf lstKurs.ListCount > 1 Then Call AllKursElse 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 IfEnd SubPrivate Sub lstKurs_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)If lstKurs2.ListCount <> 0 Then lstKurs2.ListIndex = lstKurs.ListIndexEnd SubPublic Sub AllKurs()Dim i As IntegerDim ob As IntegerDim current As Singlecurrent = -0.0007ob = CInt(lstKurs2.List(lstKurs2.ListCount - 1))picRound.Cls'Построение диаграммыpicRound.Scale (-100, 100)-(100, -100)picRound.FillColor = 2For i = 0 To lstKurs2.ListCount - 2picRound.FillColor = QBColor(i + 10)picRound.Circle (0, 20), 80, , current, current - CInt(lstKurs2.List(i)) * 6.28 / ob, 0.5current = 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.5NextEnd SubPublic Sub Stolb(Групп As Integer)Dim intStWidth As Integer 'Ширина 1 столбцаDim ed As Integer 'picStolb.scaleheight/Максимальное значение - это одна единица графикаDim max As IntegerConst dw As Byte = 10 'Промежуток между столбцамиintStWidth = Int(picStolb.ScaleWidth / Групп) - dwmax = CInt(lstKol.List(0))For i = 0 To lstKol.ListCount - 1If CInt(lstKol.List(i)) > max Then max = CInt(lstKol.List(i))Nexted = 0If max <> 0 Then ed = picStolb.ScaleHeight / max'9*ed - высота, равная 9 единицамFor i = 0 To Групп - 1picStolb.Line (0 + i * (intStWidth + dw), picStolb.ScaleHeight)-(intStWidth + i * (intStWidth + dw), picStolb.ScaleHeight - CInt(lstKol.List(i)) * ed), QBColor(i + 10), BFNext'Установка надписей с названими группFor i = 0 To Групп - 1picStolb.CurrentX = ((intStWidth - Len(lstGroops.List(i))) / 2) + (dw + intStWidth) * ipicStolb.CurrentY = picStolb.ScaleHeight - 25picStolb.Print lstGroops.List(i)NextEnd SubPublic Sub Graf()Dim intX0 As IntegerDim edx As IntegerDim edy As IntegerDim intY0 As IntegerintX0 = lnOX.X1edx = Int((lnOX.X2 - intX0) / lstGroops2.ListCount) - 10intY0 = lnOX.Y1: edy = lstkol2.List(0)If edy = 0 ThenExit SubEnd IfFor i = 0 To lstkol2.ListCount - 1If CInt(lstkol2.List(i)) > edy Then edy = CInt(lstkol2.List(i))Nextedy = Int((intY0 - lnOY.Y1) / edy) - 5'Установка делений по оси уFor i = 1 To lstkol2.ListCountpicGraf.Line (intX0 - 3, intY0 - CInt(lstkol2.List(i - 1)) * edy)-(intX0 + 3, intY0 - CInt(lstkol2.List(i - 1)) * edy)picGraf.CurrentX = intX0 - 12picGraf.CurrentY = intY0 - edy * CInt(lstkol2.List(i - 1)) - 5picGraf.Print lstkol2.List(i - 1)Next'Установка делений по оси хFor i = 1 To lstGroops.ListCountpicGraf.Line (intX0 + i * edx, intY0 - 3)-(intX0 + i * edx, intY0 + 3)picGraf.CurrentX = intX0 + i * edx - Int(Len(lstGroops2.List(i - 1)) / 2)picGraf.CurrentY = intY0 + 5picGraf.Print lstGroops2.List(i - 1)Next'Установка точек и их соединениеpicGraf.DrawWidth = 5picGraf.PSet (intX0 + edx, intY0 - CInt(lstkol2.List(0)) * edy), vbRedFor i = 2 To lstGroops2.ListCountpicGraf.DrawWidth = 5picGraf.PSet (intX0 + i * edx, intY0 - CInt(lstkol2.List(i - 1)) * edy), vbRedpicGraf.DrawWidth = 2picGraf.Line (intX0 + (i - 1) * edx, intY0 - CInt(lstkol2.List(i - 2)) * edy)-(intX0 + i * edx, intY0 - CInt(lstkol2.List(i - 1)) * edy), vbRedNextEnd SubfrmAboutOption Explicit' Reg Key Security Options...Const READ_CONTROL = &H20000Const KEY_QUERY_VALUE = &H1Const KEY_SET_VALUE = &H2Const KEY_CREATE_SUB_KEY = &H4Const KEY_ENUMERATE_SUB_KEYS = &H8Const KEY_NOTIFY = &H10Const KEY_CREATE_LINK = &H20Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _ KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _ KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL ' Reg Key ROOT Types...Const HKEY_LOCAL_MACHINE = &H80000002Const ERROR_SUCCESS = 0Const REG_SZ = 1 ' Unicode nul terminated stringConst REG_DWORD = 4 ' 32-bit numberConst gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"Const gREGVALSYSINFOLOC = "MSINFO"Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"Const gREGVALSYSINFO = "PATH"Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As LongPrivate Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As LongPrivate Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As LongPrivate Sub cmdSysInfo_Click() Call StartSysInfoEnd SubPrivate Sub cmdOK_Click() Unload MeEnd SubPrivate Sub Form_Load() Me.Caption = "О программе " + strName lblDescription.Caption = strDescription lblDisclaimer.Caption = strDisclaimerMe.Icon = frmDatabase.imlButtons.ListImages(12).PictureEnd SubPublic Sub StartSysInfo() On Error GoTo SysInfoErr Dim rc As Long Dim SysInfoPath As String ' Try To Get System Info Program Path\Name From Registry... If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then ' Try To Get System Info Program Path Only From Registry... ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then ' Validate Existance Of Known 32 Bit File Version If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then SysInfoPath = SysInfoPath & "\MSINFO32.EXE" ' Error - File Can Not Be Found... Else GoTo SysInfoErr End If ' Error - Registry Entry Can Not Be Found... Else GoTo SysInfoErr End If Call Shell(SysInfoPath, vbNormalFocus) Exit SubSysInfoErr: MsgBox "System Information Is Unavailable At This Time", vbOKOnlyEnd SubPublic Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean Dim i As Long ' Loop Counter Dim rc As Long ' Return Code Dim hKey As Long ' Handle To An Open Registry Key Dim hDepth As Long ' Dim KeyValType As Long ' Data Type Of A Registry Key Dim tmpVal As String ' Tempory Storage For A Registry Key Value Dim KeyValSize As Long ' Size Of Registry Key Variable '------------------------------------------------------------ ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...} '------------------------------------------------------------ rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Error... tmpVal = String$(1024, 0) ' Allocate Variable Space KeyValSize = 1024 ' Mark Variable Size '------------------------------------------------------------ ' Retrieve Registry Key Value... '------------------------------------------------------------ rc = RegQueryValueEx(hKey, SubKeyRef, 0, _ KeyValType, tmpVal, KeyValSize) ' Get/Create Key Value If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Errors If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ' Win95 Adds Null Terminated String... tmpVal = Left(tmpVal, KeyValSize - 1) ' Null Found, Extract From String Else ' WinNT Does NOT Null Terminate String... tmpVal = Left(tmpVal, KeyValSize) ' Null Not Found, Extract String Only End If '------------------------------------------------------------ ' Determine Key Value Type For Conversion... '------------------------------------------------------------ Select Case KeyValType ' Search Data Types... Case REG_SZ ' String Registry Key Data Type KeyVal = tmpVal ' Copy String Value Case REG_DWORD ' Double Word Registry Key Data Type For i = Len(tmpVal) To 1 Step -1 ' Convert Each Bit KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' Build Value Char. By Char. Next KeyVal = Format$("&h" + KeyVal) ' Convert Double Word To String End Select GetKeyValue = True ' Return Success rc = RegCloseKey(hKey) ' Close Registry Key Exit Function ' Exit GetKeyError: ' Cleanup After An Error Has Occured... KeyVal = "" ' Set Return Val To Empty String GetKeyValue = False ' Return Failure rc = RegCloseKey(hKey) ' Close Registry KeyEnd FunctionfrmHelpPrivate Sub Form_Load()Browser.Navigate ("file://localhost/" + App.Path + "/Help/Main.html")End SubPrivate Sub imgAbout_Click()Browser.Navigate ("file://localhost/" + App.Path + "/Help/About.html")End SubPrivate Sub imgAdd_Click()Browser.Navigate ("file://localhost/" + App.Path + "/Help/Add.html")End SubPrivate Sub imgDel_Click()Browser.Navigate ("file://localhost/" + App.Path + "/Help/Del.html")End SubPrivate Sub imgDiags_Click()Browser.Navigate ("file://localhost/" + App.Path + "/Help/Diags.html")End SubPrivate Sub imgEdt_Click()Browser.Navigate ("file://localhost/" + App.Path + "/Help/Edt.html")End SubPrivate Sub imgErrors_Click()Browser.Navigate ("file://localhost/" + App.Path + "/Help/Errors.html")End SubPrivate Sub imgExit_Click()Browser.Navigate ("file://localhost/" + App.Path + "/Help/Exit.html")End SubPrivate Sub imgMain_Click()Browser.Navigate ("file://localhost/" + App.Path + "/Help/Main.html")End SubPrivate Sub imgNew_Click()Browser.Navigate ("file://localhost/" + App.Path + "/Help/New.html")End SubPrivate Sub imgOpen_Click()Browser.Navigate ("file://localhost/" + App.Path + "/Help/Open.html")End SubPrivate Sub imgSave_Click()Browser.Navigate ("file://localhost/" + App.Path + "/Help/Save.html")End SubPrivate Sub imgSearch_Click()Browser.Navigate ("file://localhost/" + App.Path + "/Help/Search.html")End SubPrivate Sub imgSort_Click()Browser.Navigate ("file://localhost/" + App.Path + "/Help/Sort.html")End SubmodAbout'----------------------------------------'Оперативное изменение программы:'----------------------------------------'1) Поменять ниже стоящие константы и массив с названиями всех полей. Если полей больше 7, то добавить новые поля на формах'frmDatabase, frmAdd, frmEdit, а также изменить их обработку (ну там по коду все понятно где надо добавлять)'если полей меньше 7, то те же действия, но в другую сторону :-)'2) Поменять иконки в имидж-листе на форме frmDatabase. Они распространяются сразу на всю программу'----------------------------------------Option ExplicitPublic Const strName = "MyDataBase" 'Название программы. Также поменять в меню: разработать - MyDataBase свойстваPublic Const strDescription = "Программа MyDataBase предназначена для работы с базой данных о студентах, выполняющих лабораторные работы." + vbNewLine + "Автор программы Масляев Евгений. Студент 2-ого курса ИТД КФ МГТУ им. Н. Э. Баумана." + vbNewLine + "Дизайнер: Серегин Арсеий. Студент 2-ого курса ФКДиР МГУП. Год создания программы: 2006" 'Краткое описаниеPublic Const strDisclaimer = "Авторские права на расширения файлов защищены...производителями Microsoft Access :-)" 'ПредупреждениеPublic Const strРасширение = "mdb" 'Расширение файлов программыPublic Const intВсегоПолей As Integer = 6 'Количество полей одной записиPublic strПоле(intВсегоПолей) As StringPublic Sub init()'Названия всех полей strПоле(0) = "Студент" strПоле(1) = "Группа" strПоле(2) = "Название курса" strПоле(3) = "Название работы" strПоле(4) = "Дата сдачи" strПоле(5) = "Оценка" strПоле(6) = "Дата выдачи"'------------------------------------------For i = 0 To intВсегоПолейfrmDatabase.optPole(i).Caption = strПоле(i)NextfrmDatabase.Caption = strNamefrmDatabase.Icon = frmDatabase.imlButtons.ListImages(12).PictureEnd SubmodDataOption ExplicitPublic i As LongPublic j As LongPublic lngNumberOfEdit As LongPublic strSearch As StringPublic intPole As IntegerPublic OpenFile As StringPublic Zapis As DataBasePublic boolDop As Boolean'поменять тип в соответствии с заданиемPublic Type DataBaseСтудент As String * 50Группа As String * 8Курс As String * 50Работа As String * 50Дата_сдачи As String * 50Оценка As ByteДата_выдачи As String * 50End TypePublic Function Date_raz(date1 As String, date2 As String) As LongDim ldate1 As LongDim ldate2 As Longldate1 = CLng(Left(date1, 2)) + 30 * CLng(Mid(date1, 4, 2)) + 365 * CLng(Right(date1, 4))ldate2 = CLng(Left(date2, 2)) + 30 * CLng(Mid(date2, 4, 2)) + 365 * CLng(Right(date2, 4))Date_raz = ldate1 - ldate2End FunctionmodInspectOption ExplicitPublic NumError As StringPublic Const numNumeric As String = "Введено нечисловое значение"Public Const numДробь As String = "Введено дробное значение"Public Const numUpLim As String = "Введено слишком большое значение"Public Const numDownLim As String = "Введено слишком маленькое значение"Public Function Number(str As String, Дробь As Boolean, Limits As Boolean, DownLim As Double, UpLim As Double) As BooleanDim i As ByteDim c As String * 1Dim boolДробь As BooleanboolДробь = FalseIf Not IsNumeric(str) Then Number = False: NumError = numNumeric: Exit FunctionFor i = 1 To Len(str)c = Mid$(str, i, 1)If c = "," Or c = "." Then boolДробь = TrueNextIf boolДробь = True And Дробь = False Then Number = False: NumError = numДробь: Exit FunctionIf Limits = True ThenIf CDbl(str) > UpLim Then Number = False: NumError = numUpLim: Exit FunctionIf CDbl(str) < DownLim Then NumError = numDownLim: Exit FunctionEnd IfNumError = ""Number = TrueEnd FunctionПРИЛОЖЕНИЕ 2Формы программыfrmStartrmDatabasefrmAddfrmEditfrmDiagrammsfrmSearchfrmHelpfrmAbout
Страницы: 1, 2, 3, 4, 5
|
|
|
© 2003-2013
Рефераты бесплатно, курсовые, рефераты биология, большая бибилиотека рефератов, дипломы, научные работы, рефераты право, рефераты, рефераты скачать, рефераты литература, курсовые работы, реферат, доклады, рефераты медицина, рефераты на тему, сочинения, реферат бесплатно, рефераты авиация, рефераты психология, рефераты математика, рефераты кулинария, рефераты логистика, рефераты анатомия, рефераты маркетинг, рефераты релиния, рефераты социология, рефераты менеджемент. |
|
|