Главная Учебники - Разные Лекции (разные) - часть 33
|
Калужский филиал Факультет"Фундаментальных Наук" Кафедра "Программного обеспечения ЭВМ, информационных технологий и прикладной математики" (ФН1-КФ) РАСЧЕТНО-ПОЯСНИТЕЛЬНАЯ ЗАПИСКА К КУРСОВОЙ РАБОТЕ На тему «Создание базы данных» По курсу «ИНФОРМАТИКА» Калуга Курсовой проект представляет собой программное обеспечение для работы с базами данных в сфере образования. Программа содержит необходимые средства для создания, редактирования, обработки и хранения записей о студентах, обучающихся в учебном заведении: 1. Удобный и интуитивно понятный интерфейс, позволяющий легко вводить, редактировать и удалять данные. 2. Контроль ввода, помогающий избежать ошибок при добавлении или редактировании записей. 3. Возможность сортировки данных по возрастанию/убыванию в любом из полей таблицы. 4. Поиск необходимых данных по часто используемым параметрам (запросы) или по первой букве записи из выбранного поля. 5. Горячие клавиши, позволяющие быстро выполнять часто используемые действия, а также, панель инструментов, предназначенная для той же цели. 6. Возможность построения диаграмм для наглядного представления сведений, приведенных в базе данных. 7. Справочная система, помогающая вам быстро найти ответ на интересующий вас вопрос. АННОТАЦИЯ СОДЕРЖАНИЕ 1.ИССЛЕДОВАТЕЛЬСКАЯ ЧАСТЬ 1.1 Постановка задачи 1.2 Общие сведения 1.3 Элементы языка 1.4 Встроенные элементы управления 2. КОНСТРУКТОРСКАЯ ЧАСТЬ 2.1 Общие сведения 2.2 Функциональное назначение 2.3 Описание логической структуры программы 2.3.1 Загрузка программы 2.3.2 Создание новой базы данных 2.3.3 Открытие базы данных 2.3.4 Сохранение базы данных 2.3.5 Закрытие программы 2.3.6 Добавление данных 2.3.7 Удаление данных 2.3.8 Изменение данных 2.3.9 Формат данных 2.3.10 Поиск данных 2.3.11 Построение диаграмм 2.3.12 Сортировка 2.3.13 Справка и информация о программе 3. ТЕХНОЛОГИЧЕСКАЯ ЧАСТЬ 3.1. Руководство системного программиста. 3.1.1 Составные части программного продукта 3.1.2 Запуск и выполнение 3.1.3 Системные требования 3.1.4 Комплект ПО 3.1.5 Тестирование программы 3.2 Руководство оператора 3.2.1 Назначение программы 3.2.2 Краткое описание алгоритма работы с программой 3.2.3 Создание базы данных 3.2.4 Открытие базы данных 3.2.5 Сохранение базы данных 3.2.6 Удаление записи 3.2.7 Редактирование записи 3.2.8 Добавление записи 3.2.9 Поиск записей 3.2.10 Построение диаграмм 3.2.11 Сортировка 3.2.12 Выход из программы 3.2.12 Информация о программе 3.2.14 Сообщения программы ПРИЛОЖЕНИЕ Код программы ПРИЛОЖЕНИЕ Формы программы
1. Используя средства языка программирования создать файл, элементами которого являются записи, определенные таблицей вашего варианта.
2. Создать файл из 10 – 15 записей. Предусмотреть возможность редактирования файловой информации (добавление, удаление, замену всей записи и одного из полей записи). 3. Создать запросы, согласно вашему варианту. 4. Разработать интерфейс пользователя для реализации выше перечисленных функций. 5. Создать файл справочной службы и подключить его к интерфейсу. 6. Подготовить расчетно-пояснительную записку (см. методические указания). 7. Основные алгоритмы работы программы вынести на лист А1. 8. Создать заставку-презентацию данного программного продукта с использованием графических средств VB. 2. Запросы: - сколько лабораторных работ сдано студентом, фамилия которого указанна в запросе; - сколько лабораторных работ было сдано студентами выбранной группы за прошедший месяц; - получить список студентов (с указанием студента, названием курса, названием лабораторной работы, оценки), сдавших в один день более двух работ; - получить список студентов (с указанием студента, группы, названием лабораторной работы), сдавших лабораторные работы по указанному курсу с оценкой хорошо и отлично. 3. Добавляемый столбец «Дата выдачи лабораторной работы». 4. Дополнительные запросы: - получить список (с указанием студента, группы, названием курса, названием лабораторной работы) не сдавших работы, выданные в течение двух месяцев; - получить сведения о студенте и лабораторной работе, сдаваемой самое длительное время. 5. Диаграммы: Построить круговую диаграмму, иллюстрирующую: - какую часть от всех сданных лабораторных работ, составляют работы по выбранному курсу? - Сведения о количестве сданных лабораторных работ по каждому курсу. Изобразить в виде графика: - Данные о количестве студентов каждой группы, имеющих задолжность по сдаче лабораторных работ больше одного месяца; Изобразить в виде столбчатой диаграммы: - Данные о количестве студентов разных групп, получивших выбранную в запросе оценку. VisualBasic – достаточно мощный язык: с его помощью, вероятно, можно решить любую задачу программирования, какую только можно вообразить.VisualBasic- самая быстрая и самая легкая система создания приложений для MicrosoftWindows. Являетесь ли вы опытным профессионалом или только начинающим программистом для Windows, VisualBasic предоставит полный набор инструментов для легкого и быстрого написания приложений. Последняя версия языка Visual Basic 6 представляет собой интегрированную среду разработки — IDE (Integrated Development Environment). Она включает в себя набор инструментов, облегчающих и значительно ускоряющих процесс разработки готового приложения. IDEVisualBasic предоставляет удобный интерфейс для разработки программ. Она не только форматирует текст программы и исправляет некоторые ошибки, но также позволяет быстро получить информацию об используемых объектах и функциях – достаточно лишь ввести их имена. Существует также множество возможностей для отладки программы (диалоговые окна Watch, Immediate, пошаговое выполнение). Можно даже изменять код в процессе работы программы. По сравнению с другими языками, VisualBasic намного легче для изучения. Наличие типа Variant позволяет создавать универсальные функции и процедуры, обрабатывающие разнотипные данные. Также очень удобно работать с динамическими строками и массивами. Программист может создавать собственные типы данных на основе существующих и объекты. Но возможности объектно-ориентированного программирования в VisualBasic ограничены по сравнению с C++, Delphi и некоторыми другими языками, что, несомненно, является одним из его недостатков. Многие независимые разработчики, как, например известная своими программами в области бухгалтерского учета фирма “1С”, приобретают лицензии на использование языка VisualBasic в качестве внутреннего языка своих приложений. Поэтому в настоящее время Basic уже не считается учебным языком знание VisualBasic и его диалектов (VBA, VBScript) становится необходимостью для современного программиста любого уровня. Простота и мощность языка Visual Basic 6 позволили сделать его встроенным языком для приложений Microsoft Office. Еще одна версия языка – VBScript – используется для написания скриптов и сценариев. Поэтому в настоящее время Basic уже не считается учебным языком — знание Visual Basic и его диалектов (VBA, VBScript) становится необходимостью для современного программиста любого уровня. В данной курсовой работе использовались следующие элементы языка: переменные различных типов (Boolean, Integer, String, Long, Single), собственные типы данных, альтернативные операторы условия (одноальтернативные, двуальтернативные), операторы цикла (с предусловием, с постусловием, с параметром), процедуры и функции (встроенные и собственные). Синтаксис операторов, процедур и функций: 1) Одноальтернативный оператор условия If <условие> Then <оператор> 2) Двухальтернативный оператор условия Однострочная форма: If <условие> Then <оператор1> Else <оператор2> Расширенная форма записи: If <условие> Then <операторы 1> Else <операторы 2> End If 3) Цикл с параметром: For <счётчик>=<начало> to <конец> [step <шаг>] операторы Next [<счётчик>] 4) Циклы с предусловием и постусловием: 1 вариант Do [{while/until} <условие>] операторы Loop 2 вариант Do Операторы Loop [{while/until} <условие>] 5) процедуры, функции и модули процедура: [Private.][Public.] Sub <имя> ([список формальных параметров]) тело процедуры End Sub функция: [Private.][Public.] Function <имя> ([список формальных параметров]) As<тип> тело функции End Function Модуль: В модуле описываются типы, переменные, процедуры и функции, которые могут быть доступны всем формам и другим модулям программы, а так же могут описываться процедуры и функции, которые используются только другими процедурами и функциями данного модуля. · Элемент управления Label (метка) создает на форме надпись, например название текстового поля.
· Элемент управления PictureBox используется как контейнер для других элементов, а также для вывода на экран изображений. · Элемент управления CommandButton (кнопка) вызывает событие Click при щелчке на нем левой кнопкой мыши. Они используются для выполнения каких-либо действий. · Элемент управления CheckBox– создает ячейку, которая может быть помечена пользователем как имеющая значение истина или ложь. Этот элемент управления может иметь три состояния. Пользователь может установить неопределенное значение для объекта CheckBox: не ложь и не истина. · Элемент управления Frame является контейнером и служит для объединения других элементов в группу. Это дает возможность управлять объектами как единым целым. · Элемент управления TextBox(Текстовое поле) используется для отображения информации, вводимой пользователем во время выполнения, или присвоенной свойству Text элемента управления во время разработки или выполнения. Текстовое поле следует использовать для редактируемого текста, но его можно сделать и только читаемым (read-only), установив значение свойства Locked (Заблокирован) равным True. Текстовые поля также позволяют отображать несколько строк, переносить текст в размерах элемента управления и добавить базовое форматирование. · Элемент управления ComboBox (раскрывающийся список) объединяет в себе список и текстовое поле. Пользователь может ввести данные в поле или выбрать их из списка. ComboBox занимает в форме меньше места, но в отличие от ListBox, в нем нельзя выбрать несколько элементов сразу. · Элемент управления ListBox(Список) отображает список, из которого пользователь может выбрать один или несколько элементов. Элементы управления ListBox предоставляют пользователю список возможных вариантов выбора. По умолчанию варианты выбора отображаются вертикально в одном столбце, хотя можно задать и несколько столбцов отображения. Если число элементов в списке превышает число элементов, которые могут быть отображены в списке, на этом элементе управления автоматически появляются полосы прокрутки. Пользователь в дальнейшем может прокручивать список вверх-вниз, вправо-влево, а так же в обе стороны, если предусмотрены обе полосы прокрутки. · Элемент управления Timer (Таймер) независимы от пользователя, и их можно использовать для программирования действий, которые должны выполняться периодически. Их типичное применение-определение времени выполнения некоторого действия. · Элемент управления ToolBar (Панель инструментов) используется для создания кнопок, обеспечивающих быстрый доступ к существующим пунктам меню, и для наглядности приложения. · Элемент управления Calendar (Календарь) представляет собой календарь, с помощью которого можно выбирать дату. В его верхнем правом углу расположены раскрывающиеся списки, в которых можно выбрать год и месяц соответственно. В другой его части имеется возможность выбора числа и дня недели. · Элемент управления StatusBar (Строка состояния) используется в приложении для информирования пользователя о текущем состоянии приложения. · Элемент управления OptionButton представляет собой ячейку выбора. Из всех таких ячеек, размещенных на одном объекте, пользователь может выбрать только одну или не выбрать ни одной. · Элемент WebBrowser используется для отображения web-страниц на форме. Для этого в данном проекте используется его метод navigate(<адрес файла>). · Элемент управления Image. Прямоугольная область, в которую можно поместить изобажение. Так же может использоваться для хранения изображения внутри программы. · Элемент управления ImageList используется как контейнер для изображений, которые потом могут применяться для оформления программы. Программный продукт представляет собой исполняемый файл MyDataBase.exe, созданный при компиляции проекта, написанного на языке VisualBasic 6.0 и файлы справки (web-страницы и изображения). Для систем, на которых не установлен пакет VisualBasic 6.0, может так же понадобиться библиотека MSVBVM60.DLL. При создании программы использовалось следующее программное обеспечение: 1. Microsoft Visual Basic 6.0 2. Microsoft Word 2003 3. Графическиередакторы MS Paint, Adobe Photoshop 7.0, Macromedia Dreamweaver 8. После запуска программы первой загружается форма frmStart (Приложение 2. с.61), так как она является объектом запуска. При ее загрузке запускается процедура Private Sub Form_Load() (Приложение 1. с.62), которая устанавливает начальное значение переменной х, используемой в таймере анимации, равным нулю. Далее происходит запуск заставки. Запускается процедура таймера: Private Sub tmrAni_Timer() (Приложение 1. с.33). Это таймер, управляющий анимацией. Он работает, используя переменную х. По значению переменной программа определяет какое изображение следует отобразить на экране. После завершения работы таймера, управление передается форме frmDatabase (главная форма программы. Приложение 2. с.62). При ее запуске, выполняется ее процедура Private Sub Form_Load() (Приложение 1. с.39) При входе в базу данных выполняется процедура init из модуля modAbout (Приложение 1. с.58), которая используется в процедуре Form_Load главной формы программы. Она устанавливает начальные значения переменных, создает надписи с названиями полей и применяет дизайн форм программы. Форма загрузилась – база данных уже создана. Если в процессе работы потребуется создать новую базу данных, например, при помощи меню «Файл -> Создать (Ctrl+N)», то запускается процедура Create() (Приложение 1. с.33), которая запрашивает подтверждение создания базы, после чего очищает все поля таблицы и устанавливает занчение переменной OpenFile=””, что означает, что на данный момент нет активного файла, с которым производится работа. Его можно будет создать при сохранении базы, либо открыть.
Управление получит процедура Open_File() (Приложение 1. с.33). С помощью элемента ComonDialog будет создано окно открытия файла, в котором вам будет предложено выбрать файл расширения *.mdb (MyDataBase). Далее процедура из файла считывает информацию и размещает ее в listBox-элементах главной формы.
OpenFile принимает значение, равное имени выбранного файла.
Управление получит процедура Save(intSave As Byte) (Приложение 1. с.34). Если переменная
OpenFile пуста, то в процедуру будет передан параметр «1», обозначающий то, что необходимо сохранить базу в новый файл. С помощью элемента ComonDialog будет создано окно сохранения файла, в котором вам будет предложено ввести имя и выбрать путь для нового файла (можно без расширения, программа создаст его автоматически). Сразу же после выбора имени, информация считывается из listBox-элементов главной формы и помещается в указанный файл. Если же OpenFileне пуста, то старый файл будет удален, а на его место будет записан новый с тем же именем, но с новой информацией. В процедуру в этом случае передается «0». При выборе меню «Файл -> Сохранить как (Ctrl+S)» в любом случае передается параметр «1».
Управление получит
Form_QueryUnload(CancelAsInteger, UnloadModeAsInteger) (Приложение 1. с.39). События, описанные в этой процедуре, выполняются при попытке закрыть форму. Если параметр Cancel этой процедуры будет равен 1, то происходит отмена выхода и форма не закрывается. Это лежит в основе процесса выхода из программы. В случае отрицательного ответа на предложенное сообщение выход осуществлен не будет. Завершение работы программы происходит только при подтверждении выхода.
Если запись выделена, то управление получит Процедура Edit("Add", 0) (Приложение 1. с.35). Эти параметры обозначают, что необходимо добавить запись. Второй параметр для добавления записи не имеет значения. Он нужен при редактировании. Затем будет показана форма добавления записи
frmAdd (Приложение 2. с.62), в которой необходимо заполнить правильно все поля. Ввод контролируется модулем modInspect (Приложение 1. с.60) и функцией Date_raz(date1 AsString, date2 AsString) AsLong из модуля modData (Приложение 1. с.59), которая возвращает число, равное разности сумм произведений <число>+<месяц>*30+<год*365> двух дат, передаваемых в качестве параметров При нажатии кнопки «Добавить». В случае правильного ввода, запись появится в listbox-элементах главной формы. Если запись выделена, управление получит Процедура Edit("Del", lstZapis(0).ListIndex). Эти параметры обозначают, что необходимо удалить запись с номером выделенной записи. После подтверждения удаления запись будет удалена из всех полей таблицы.
Если запись выделена, управление получит Процедура Edit("Edt", lstZapis(0).ListIndex). Эти параметры обозначают, что необходимо редактировать запись с номером выделенной записи. Затем будет показана форма редактирования записи
frmEdit (Приложение 2. с.63) (она очень похожа на форму добавления записи, но в ней уже заполнены все поля), в которой вы можете изменить значение одного или нескольких полей данной записи (Ввод контролируется теми же модулями, что и при добавлении). Нажмите кнопку «Изменить». В случае правильного ввода, запись изменится в listbox-элементах главной формы. Изменение формата текста производится в меню «Формат». Выбрав нужный подпункт, вы можете изменить шрифт и цвет текста. Шрифт изменяется в пределах тех значений, которые допускает операционная система, так как производится с помощью вызова стандартного диалога загрузки шрифта (вызов производит CommonDialog). Вся введенная информация изменит свой шрифт на выбранный. Для изменения цвета символов CommonDialog вызывает окно с палитрой, где можно выбрать цвет заливки символов, а затем нажать кнопку «ОК» или «Отмена» (в этом случае цвет будет выбран стандартный, то есть, черный). PublicSubSearch(strTypeAsString) (Приложение 1. с.35) – это процедура поиска. Если strType=fst, то производится поиск по первой букве в выбранном поле, а результат помещается в таблицу формы результатов frmSearch(Приложение 2. с.64), после чего процедура выводит эту форму на экран. При загрузке формы поиска в строку состояния записывается количество записей в таблице. Кроме того, возможен поиск по запросам. Для каждого запроса отведена своя процедура, выполняющая свою конкретную задачу. На той же форме результатов будет показан результат поиска по выбранному запросу, а внизу, на StatusBar – количество найденных записей. При двойном щелчке на записи в поле поиска, она выделяется в основной форме, а форма поиска выгружается.
Сначала загружается форма диаграмм
frmDiagramms (Приложение 2. с.63), на которой с помощью кнопки выбирается тип диаграммы, а затем с помощью ComboBox или ListBox параметры, по которым необходимо построить диаграмму. Диаграммы строятся внути PictureBox-элементов, для каждого вида диаграмм отдельных. Для каждого вида диаграмм вызывается своя процедура: Graf() (Приложение 1. с.54) – для графика, Round(ob_kol As Long, kol1 As Long) (Приложение 1. с.53) – для круговых. Параметр ob_kol обозначает общее количество записей (100%), а kol1 – текущее количество, для построения сектора; Stolb(Групп As Integer) – для столбчатых, где Групп – это количество групп, которое нужно для определения ширины столбцов.
Для сортировки данных по определенному столбцу
используется стандартное сравнение VisualBasic и функции больше (>) и меньше (<). Для сортировки по датам используется функция Date_raz(date1 AsString, date2 AsString) AsLong из модуля modData, которая описана выше. «Справка – О программе». Перейдя по этому меню, вы попадаете на форму frmAbout (Приложение 2. с.65), где написано о программе, версии, разработчике и авторских правах. Это стандартный AboutDialogVisualBasic. Также с помощью стандартных средств Visual Basic реализована кнопка «О системе» на этой форме, собирающая информацию о вашем компьютере. Справка представляет собой «сайт» (HTML-страницы, соединенные ссылками и файлы с изображениями), который отображается в компоненте Web-browser на форме. · Файл проекта MyDataBase.vbp · Файлымодулей: modAbout.bas, modData.bas, modInspect.bas · Файлыформ: frmAbout.frm (Опрограмме), frmAdd.frm (Добавлениезаписи), frmDatabase.frm (Окностаблицей), frmDiagramms.frm (Формадиаграмм), frmEdit.frm(Редактированиезаписи), frmHelp.frm (Справочнаясистема), frmSearch.frm (Формарезультатовпоиска), frmStart.frm (Стартоваязаставка). · Файлысправки: Sort.html, Save.html, Open.html, New.html, Exit.html, Edt.html, Add.html, Del.html, Diags.html, Search.html, Main.html, About.html, Errors.html · Всего при создании проекта было разработано 8 форм, 3 модуля, 13 файлов справки и 1 база данных. При разработке использовалась среда Visual Basic 6.0. · Готовая программа представляет собой файл MyDataBase.exe, который и необходимо запустить. Если в системе установлены все требуемые файлы и библиотеки, то появится окно заставки, и программа начнет свою работу. · Операционная система Windows 95/NT/98/ME/2000/XP · Оперативная память не ниже 32Мб · Видеокарта SVGA · Клавиатура, мышь · 3 MB места на жестком диске (если все необходимые компоненты были установлены ранее, достаточно 2 MB) В комплект программного обеспечения входит исполняемый файл MyDataBase.exe и выше указанные файлы справки и картинки: Menu_File.JPG, Menu_Search.JPG, Menu_Edit.JPG, Menu_Format.JPG, Menu_Sort.JPG, Open_Dialog.JPG, Msg_Open.JPG, Msg_New.JPG, Msg_Exit.JPG, frmEdit.JPG, frmAdd.JPG, Msg_Del.JPG, frmDiags.JPG, frmSearch.JPG, frmDatabase.JPG, Menu_Help.JPG, frmAbout.JPG, ErrSearch.JPG, NumError.JPG, Drob.JPG, Min.JPG, Max.JPG, DateError.JPG. · Запустите файл MyDataBase.exe · Выберите пункт «Открыть» в меню Файл или кнопку «Открыть» на панели инструментов. В появившемся диалоговом окне выберите имя открываемого файла. Таблица базы данных будет загружена из выбранного файла. Также вы можете сформировать свою базу данных путем добавления записей. · Выберите пункт «Добавить запись» в меню «Редактировать». Появится окно Добавления записи. Заполните поля записи, например: СтудентМасляев Евгений ГруппаИТД-31 Название курсаИнформатика Название работы Дата выдачи09.09.2006 Оценка5 Дата сдачи20.11.2006 · Нажмите кнопку «Добавить». В основном окне базы данных окне появится запись. · Выберите пункт «Файл->Сохранить как» в меню или нажмите кнопку «Сохранить» на панели инструментов. В появившемся окне выберите имя нового файла. База данных сохранится в новом файле. Имя текущего файла, с которым в данный момент происходит работа, написано в заголовке окна. · Выберите пункт «Создать» в меню для создания новой базы и очистки полей · Снова откройте созданный вами файл по выше описанному алгоритму. Если после выше перечисленных действий в открывшейся базе данных будет находиться выше представленная запись, то создание, сохранение и открытие базы данных надо полагать успешным. Проектявляетсяпрограммнымобеспечением для создания баз данных о работах студентов университета. Программа выводит информацию в табличной форме, позволяет добавлять, изменять, удалять, сортироватьданные о студентах, записанные в базе данных, а так же выводить данные по запрашиваемомуусловию, производить поиск по первой букве и строить диаграммы отношений. Исполняемый файл – Database.exe Для открытия файла выберите пункт меню Файл –> Открыть. Для создания резервной копии – пункт меню Файл –> Сохранить как Для добавления записи – меню Редактировать –> Добавить Для удаления записи ее необходимо выделить и выбрать меню Редактировать–> Удалить или нажать кнопку Delete на клавиатуре. Удаление нужно подтвердить нажатием кнопки «Да» в окне сообщения. Для выполнения запросов предназначено меню «Запросы». Выберите «Поиск–> По запросу –> <Нужный запрос>», и программа осуществит поиск по выбранному условию и выведет результаты на форму поиска. Сортировка выполняется при выборе сортировка в меню базы данных. Выберите поле для сортировки, а затем вид сортировки в пункте «Сортировка» или на панели инструментов. Для поиска данных по первой букве выберите меню «Поиск –> По первой букве». Введите букву в появившееся окно и нажмите «Ok». Найденная информация будет отображена на форме поиска. Для получения справки и информации о программе выберите меню «Справка». Многие пункты меню дублируются на панели инструментов. Далее каждое действие будут описано более подробно. Если вам требуется создать новую базу данных, нет необходимости удалять записи одну за одной, а можно просто нажать на кнопку "Создать базу" на панели инструментов, перейти по меню "Файл -> Создать" (Рис.1) Рис.1 И или нажать горячую комбинацию клавиш Ctrl+N. Если файл был сохранен до этого, то программа просто очистит таблицу, и ваши данные останутся в неизменном виде. Если же файл сохранен не был, то данные в предыдущей таблице вернутся в состояние предыдущего сохранения файла или будут удалены, если этот файл не существует. В любом случае, вы получите сообщение о том, что необходимо подтвердить действие (Рис.2), и, в случае отрицательного ответа, операция будет отменена. Рис.2 Открыть уже сохраненный файл можно, используя кнопку на панели задач или меню "Файл -> Открыть". (Рис.3) Рис.3 Ответьте положительно на следующее сообщение (Рис.4), если файл уже сохранен. Рис.4 При нажатии на кнопку на экране появится диалоговое окно для выбора файла. Рис.5 Выберите нужный файл, нажмите кнопку "Открыть", и его содержимое появится в таблице на главной форме. Сохранить данные в MyDataBase можно путем нажатия на кнопку с изображением дискеты на панели инструментов или перейдя в меню "Файл -> Сохранить" или "Файл -> Сохранить как". (Рис.6) Рис.6 При нажатии кнопки на панели инструментов, программа выполняет пункт "Сохранить как", то есть, сохранить в новый файл, если база сохраняется в первый раз. При этом требуется в появившемся диалоге ввести имя и выбрать путь к новому файлу. Если текущая база уже была сохранена ранее, то нажатие на кнопку сохранения приведет к изменению текущего файла в соответствии с таблицей записей. Пункт меню "Файл -> Сохранить как" сохраняет базу в новый файл в любом случае. Сохранение файла - очень важный момент. Сохраняйте файлы чаще, чтобы не потерять важные данные, ведь в представленной программе есть все необходимые средства для того, чтобы сделать этот процесс как можно более быстрым и удобным. Выделите запись, щелкнув на ней левой кнопкой мыши, и нажмите клавишу delete. Ответив "Да" на сообщение о подтверждении (Рис.7), вы удалите выбранную запись из базы. Рис.7 Также можно удалить запись через контекстное меню, кнопку на панели инструментов или меню "Редактировать -> Удалить запись". Меню "Редактировать -> Изменить запись" (Рис.8) Рис.8 Аналогичная кнопка на панели инструментов, контекстное меню или двойной щелчок мышью на записи обеспечивает доступ к форме редактирования. (Приложение 2. с.63). Выглядит она так же, как и форма для добавления записи, но в ней изначально заполнены все поля. Изменив значения в одном или нескольких полях, вы пройдете аналогичный контроль ввода, как и при добавлении записи, и выбранная запись изменится в главной таблице. Вы можете добавить новую запись в базу данных. Для этого необходимо выбрать пункт меню "Редактировать -> Добавить запись", щелкнуть на кнопке "Добавить запись" на панели инструментов или выбрать пункт "Добавить запись" в контекстном меню, которое появляется при щелчке правой кнопкой мыши на таблице с данными. При выборе данного пункта появится форма для добавления записи, в которую необходимо ввести данные, которые после проверки на правильность ввода будут внесены в таблицу. (Приложение 2. с.62) Когда все поля будут заполнены, нажмите "Добавить". Вы можете быстро найти интересующие вас данные по заданным критериям поиска. Выделите любое поле, щелкнув по его заголовку левой кнопкой мыши, а затем нажмите на кнопку с изображением лупы или перейдите в меню "Поиск -> По первой букве", (структура меню поиска показана на рисунке 9) Рис.9 В появившееся окно введите букву (регистр не учитывается) и нажмите "Ок". На экране появится форма с результатами поиска по первой букве в выделенном поле. (Приложение 2. с.64). Внизу на этой форме, на строке состояния написано количество найденных записей. На каждую запись можно перейти в главной таблице, щелкнув дважды на ней на форме поиска. Кроме поиска по первой букве, в программе предусмотрен поиск по часто используемым в сфере работы программы параметрам (запросам). Перейдите в меню "Поиск -> По запросу", и вы увидите список доступных запросов для поиска. Выбрав один из них, вы получите результат на той же форме, что и в первом случае. Замечание: Для данного вида поиска может потребоваться выделение записи. Диаграммы необходимы для наглядного представления данных, содержащихся в таблице. В данной программе доступны 3 вида диаграмм: столбчатые, круговые и графики. Чтобы увидеть диаграмму, необходимо щелкнуть на соответствующей кнопке на панели инструментов. Откроется форма диаграмм. (Приложение 2. с.63). Далее нажмите кнопку с изображением того типа диаграмм, который хотите увидеть. Сформируйте запрос путем выбора из предложенных слева списков определенных значений, например, название группы или оценку. Вы получите диаграмму по выбранному запросу. Для осуществления сортировки необходимо выделить поле щелчком на его заголовке и нажать на кнопку "Сортировка" на панели инструментов или перейти в меню "Сортировка". (Рис.10) Рис.10 Данные в таблице будут отсортированы по данному полю (по возрастанию или убыванию в зависимости от вашего выбора). Если поле содержит текст, он будет отсортирован в алфавитном порядке. Цифры - от меньшего к большему, а даты - в хронологическом порядке. Перейдите в меню "Файл -> Выход" (Рис.11) Рис.11 Нажмите на кнопку "Выход" на панели инструментов или закройте главную форму программы крестиком в правом верхнем углу, как обычное окно Windows и ответьте положительно на запрос подтверждения (Рис.12) для завершения работы с программой. Рис.12 Несохраненные данные будут потеряны. В случае отрицательного ответа выход будет отменен. При переходе по меню "Справка -> О программе" (Рис.13) Рис.13 Вы получаете доступ к форме "О программе MyDataBase" (Приложение 2. с.65). На ней кратко описана цель проекта, фамилия разработчика и об авторских правах.
1. Не задано поле для поиска
. Это означает, что вы обратились к поиску по первой букве, но не выделили поле. Поиск по первой букве не может быть осуществлен при не выбранном поле. Выбрать его можно, щелкнув по заголовку поля. При этом заголовок поля примет вид нажатой кнопки. Чтобы снять выделение поля, щелкните мышью на свободном месте главной формы. Заголовок вернется в нормальное состояние. Искать данные по первой букве можно только тогда, когда выделено одно из полей. 2. Введено нечисловое, дробное, слишком большое или слишком маленькое значение. При добавлении или изменении записи может возникнуть эта ошибка. Она означает, что в поле "Оценка" введено не число. Оценка - это натуральное число в диапозоне от 0 (студент не явился) до 5 (отлично). Если оценка введена больше 5, то возникнет ошибка: Границы ввода определяются контролем ввода. Правила ввода вы можете посмотреть на примере формы добавления записи. 3. Дата выдачи больше даты сдачи. При добавлении или редактировании записей таблицы вы не можете указать дату выдачи работы более позднюю, чем дату сдачи. Студенты редко сдают работы раньше получения заданий. ЛИТЕРАТУРА 1. С.В. Глушаков А.С. Сурядный программирование на VB6.0 «Фолио» 2002г. 2. С.И. Воронцов Microsoft Visual Basic 5.0 «Солон» 1998г. DimxAsByte Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 27 Then Call Terminate End Sub Private Sub Form_Load() x = 0 End Sub Private Sub tmrAni_Timer() If x <= 18 Then imgAnim.Picture = img(x).Picture x = x + 1 If x = 40 Then Me.Picture = img(19).Picture: imgAnim.Visible = False If x = 60 Then Call Terminate End Sub Public Sub Terminate() tmrAni.Enabled = False frmDatabase.Show Unload Me End Sub frmDatabase Option Explicit Public Sub Create() IfMsgBox("Несохраненные данные будут потеряны. Создать новую базу?", vbQuestion + vbYesNo, strName) = vbNo Then Exit Sub For i = 0 To 6 lstZapis(i).Clear Next OpenFile = "" Me.Caption = strName End Sub Public Sub Open_File() Dim strФильтр As String IfMsgBox("Несохраненные данные будут потеряны. Открыть файл?", vbQuestion + vbYesNo, strName) = vbNo Then Exit Sub For i = 0 To 6 lstZapis(i).Clear Next OpenFile = "" strФильтр = "Файлы " + strName + " (*." + strРасширение + ")|*." + strРасширение + "|" cdl1.Filter = strФильтр cdl1.Action = 1 If cdl1.FileName <> "" Then OpenFile = cdl1.FileName Open OpenFile For Random As 1 Len = Len(Zapis) For i = 1 To FileLen(OpenFile) / Len(Zapis) Get #1, i, Zapis lstZapis(0).AddItem Trim(Zapis.Студент) lstZapis(1).AddItem Trim(Zapis.Группа) lstZapis(2).AddItem Trim(Zapis.Курс) lstZapis(3).AddItem Trim(Zapis.Работа) lstZapis(4).AddItem Trim(Zapis.Дата_сдачи) lstZapis(5).AddItem Trim(Zapis.Оценка) lstZapis(6).AddItem Trim(Zapis.Дата_выдачи) Next Close #1 End If If OpenFile <> "" Then Me.Caption = strName + " - " + OpenFile 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 Sub Edit(strType As String, lngN As Long) If strType = "Add" Then frmAdd.Show 1 End If If strType = "Del" Then If MsgBox("Вы действительно хотите удалить эту запись?", vbQuestion + vbYesNo) = vbNo Then Exit Sub For i = 0 To 6 lstZapis(i).RemoveItem (lngN) Next End If If strType = "Edt" Then lngNumberOfEdit = lngN frmEdit.txt1.Text = lstZapis(0).List(lngN) frmEdit.txt2.Text = lstZapis(1).List(lngN) frmEdit.txt3.Text = lstZapis(2).List(lngN) frmEdit.txt4.Text = lstZapis(3).List(lngN) frmEdit.txt5.Text = lstZapis(4).List(lngN) frmEdit.txt6.Text = lstZapis(5).List(lngN) frmEdit.txt7.Text = 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 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 <> 4 And 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 <> 4 And 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 If cdl1.FontSize <> 0 Then lstZapis(i).FontSize = cdl1.FontSize 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 IfMsgBox("Вы уверены, что хотите выйти?" + vbNewLine + "Все несохраненные данные будут потеряны", vbQuestion + vbYesNo, strName) = vbYesThenQuite = TrueElseQuite = 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 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), lstZapis(6).List(i)) = max Then For j = 0 To 6 frmSearch.lstZapis(j).AddItem lstZapis(j).List(i) Next frmSearch.lstNumbers.AddItem i End If Next frmSearch.Show 1 End Sub Private Sub mnuOpen_Click() Call Open_File End Sub Private Sub mnuSave_Click() Call Save(0) End Sub Private Sub mnuSaveAs_Click() Call Save(1) End Sub Private Sub mnuSearch_Click() If lstZapis(1).ListIndex = -1 Then mnuZap1.Enabled = False mnuZap2.Enabled = False mnuZap4.Enabled = False Else mnuZap1.Enabled = True mnuZap2.Enabled = True mnuZap4.Enabled = True End If End Sub Private Sub mnuSize_Click() Call Format("Size") End Sub Private Sub mnuTwoMonth_Click() For i = 0 To 6 frmSearch.lstZapis(i).Clear Next frmSearch.lstNumbers.Clear For i = 0 To lstZapis(0).ListCount - 1 If Date_raz(lstZapis(4).List(i), lstZapis(6).List(i)) > 60 Then For j = 0 To 6 frmSearch.lstZapis(j).AddItem lstZapis(j).List(i) Next frmSearch.lstNumbers.AddItem i End If Next frmSearch.Show 1 End Sub Private Sub mnuUp_Click() For i = 0 To 6 If optPole(i).Value = True Then Call Sort("Up", i) Next End Sub Private Sub mnuZap1_Click() Dim strStud As String strStud = lstZapis(0).Text For i = 0 To 6 frmSearch.lstZapis(i).Clear Next frmSearch.lstNumbers.Clear For i = 0 To lstZapis(1).ListCount - 1 If lstZapis(0).List(i) = strStud Then For j = 0 To 6 frmSearch.lstZapis(j).AddItem lstZapis(j).List(i) Next frmSearch.lstNumbers.AddItem i End If Next frmSearch.Show 1 End Sub Private Sub mnuZap2_Click() Dim strMounth As String Dim strGroop As String For i = 0 To 6 frmSearch.lstZapis(i).Clear Next frmSearch.lstNumbers.Clear strGroop = lstZapis(1).Text strMounth = InputBox("Введите номер месяца", "За какой месяц?", Mid(Date, 4, 2)) If Number(strMounth, False, True, 1, 12) = False Then MsgBox NumError, vbCritical + vbOKOnly, strName Exit Sub End If For i = 0 To lstZapis(0).ListCount - 1 If lstZapis(1).List(i) = strGroop Then If (CInt(Mid(lstZapis(4).List(i), 4, 2)) = CInt(strMounth)) And (lstZapis(1).List(i) = strGroop) Then For j = 0 To 6 frmSearch.lstZapis(j).AddItem lstZapis(j).List(i) Next frmSearch.lstNumbers.AddItem i End If End If Next frmSearch.Show 1 End Sub Private Sub mnuZap3_Click() Dim stud As String Dim n As Integer Dimk k = 0 'Подготовка формы поиска For n = 0 To 6 frmSearch.lstZapis(n).Clear Next frmSearch.lstNumbers.AddItem i 'Выбор студента For i = 0 To lstZapis(0).ListCount - 1 k = 0: lstDates.Clear stud = lstZapis(0).List(i) 'Внесение всех его дат сдачи в список дат For j = 0 To lstZapis(0).ListCount - 1 If lstZapis(0).List(j) = stud Then lstDates.AddItem lstZapis(4).List(i) Next 'Проверка дат на совпадение For n = 0 To lstDates.ListCount - 1 For j = 0 To lstDates.ListCount - 1 'Если совпадает, увеличиваем счетчик на 1 If lstDates.List(n) = lstDates.List(j) And n <> j Then k = k + 1 Next Next 'Если больше 2-х одинаковых, вносим в результат If k > 2 Then For n = 0 To 6 frmSearch.lstZapis(n).AddItem lstZapis(n).List(i) Next frmSearch.lstNumbers.AddItem i End If Next frmSearch.Show 1 End Sub Private Sub mnuZap4_Click() Dim strKurs As String strKurs = lstZapis(2).Text For i = 0 To 6 frmSearch.lstZapis(i).Clear Next frmSearch.lstNumbers.Clear For i = 0 To lstZapis(1).ListCount - 1 If (lstZapis(5).List(i) = "4" Or lstZapis(5).List(i) = "5") And (lstZapis(2).List(i) = strKurs) Then For j = 0 To 6 frmSearch.lstZapis(j).AddItem lstZapis(j).List(i) Next frmSearch.lstNumbers.AddItem i End If Next frmSearch.Show 1 End Sub Public Sub Замена(lngЧто As Long, lngНа As Long) Dim str1 As String Dim int3 As Byte For int3 = 0 To 6 str1 = lstZapis(int3).List(lngНа) lstZapis(int3).List(lngНа) = lstZapis(int3).List(lngЧто) lstZapis(int3).List(lngЧто) = str1 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 'Надпись легенды 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 столбца DimedAsInteger '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 единицам Fori = 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 Public Sub Graf() Dim intX0 As Integer Dim edx As Integer Dim edy As Integer Dim intY0 As Integer intX0 = lnOX.X1 edx = Int((lnOX.X2 - intX0) / lstGroops2.ListCount) - 10 intY0 = lnOX.Y1: edy = lstkol2.List(0) If edy = 0 Then Exit Sub End If For i = 0 To lstkol2.ListCount - 1 If CInt(lstkol2.List(i)) > edy Then edy = CInt(lstkol2.List(i)) Next edy = Int((intY0 - lnOY.Y1) / edy) - 5 'Установка делений по оси у Fori = 1 Tolstkol2.ListCount picGraf.Line (intX0 - 3, intY0 - CInt(lstkol2.List(i - 1)) * edy)-(intX0 + 3, intY0 - CInt(lstkol2.List(i - 1)) * edy) picGraf.CurrentX = intX0 - 12 picGraf.CurrentY = intY0 - edy * CInt(lstkol2.List(i - 1)) - 5 picGraf.Print lstkol2.List(i - 1) Next 'Установка делений по оси х For i = 1 To lstGroops.ListCount picGraf.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 + 5 picGraf.Print lstGroops2.List(i - 1) Next 'Установка точек и их соединение picGraf.DrawWidth = 5 picGraf.PSet (intX0 + edx, intY0 - CInt(lstkol2.List(0)) * edy), vbRed For i = 2 To lstGroops2.ListCount picGraf.DrawWidth = 5 picGraf.PSet (intX0 + i * edx, intY0 - CInt(lstkol2.List(i - 1)) * edy), vbRed picGraf.DrawWidth = 2 picGraf.Line (intX0 + (i - 1) * edx, intY0 - CInt(lstkol2.List(i - 2)) * edy)-(intX0 + i * edx, intY0 - CInt(lstkol2.List(i - 1)) * edy), vbRed Next End Sub frmAbout Option Explicit ' Reg Key Security Options... Const READ_CONTROL = &H20000 Const KEY_QUERY_VALUE = &H1 Const KEY_SET_VALUE = &H2 Const KEY_CREATE_SUB_KEY = &H4 Const KEY_ENUMERATE_SUB_KEYS = &H8 Const KEY_NOTIFY = &H10 Const KEY_CREATE_LINK = &H20 Const 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 = &H80000002 Const ERROR_SUCCESS = 0 Const REG_SZ = 1 ' Unicode nul terminated string Const REG_DWORD = 4 ' 32-bit number Const 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 Long Private 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 Long Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long Private Sub cmdSysInfo_Click() Call StartSysInfo End Sub Private Sub cmdOK_Click() Unload Me End Sub Private Sub Form_Load() Me.Caption = "О программе " + strName lblDescription.Caption = strDescription lblDisclaimer.Caption = strDisclaimer Me.Icon = frmDatabase.imlButtons.ListImages(12).Picture End Sub Public 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 Sub SysInfoErr: MsgBox "System Information Is Unavailable At This Time", vbOKOnly End Sub Public 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 Key End Function frmHelp Private Sub Form_Load() Browser.Navigate ("file://localhost/" + App.Path + "/Help/Main.html") End Sub Private Sub imgAbout_Click() Browser.Navigate ("file://localhost/" + App.Path + "/Help/About.html") End Sub Private Sub imgAdd_Click() Browser.Navigate ("file://localhost/" + App.Path + "/Help/Add.html") End Sub Private Sub imgDel_Click() Browser.Navigate ("file://localhost/" + App.Path + "/Help/Del.html") End Sub Private Sub imgDiags_Click() Browser.Navigate ("file://localhost/" + App.Path + "/Help/Diags.html") End Sub Private Sub imgEdt_Click() Browser.Navigate ("file://localhost/" + App.Path + "/Help/Edt.html") End Sub Private Sub imgErrors_Click() Browser.Navigate ("file://localhost/" + App.Path + "/Help/Errors.html") End Sub Private Sub imgExit_Click() Browser.Navigate ("file://localhost/" + App.Path + "/Help/Exit.html") End Sub Private Sub imgMain_Click() Browser.Navigate ("file://localhost/" + App.Path + "/Help/Main.html") End Sub Private Sub imgNew_Click() Browser.Navigate ("file://localhost/" + App.Path + "/Help/New.html") End Sub Private Sub imgOpen_Click() Browser.Navigate ("file://localhost/" + App.Path + "/Help/Open.html") End Sub Private Sub imgSave_Click() Browser.Navigate ("file://localhost/" + App.Path + "/Help/Save.html") End Sub Private Sub imgSearch_Click() Browser.Navigate ("file://localhost/" + App.Path + "/Help/Search.html") End Sub Private Sub imgSort_Click() Browser.Navigate ("file://localhost/" + App.Path + "/Help/Sort.html") EndSub modAbout '---------------------------------------- 'Оперативное изменение программы: '---------------------------------------- '1) Поменять ниже стоящие константы и массив с названиями всех полей. Если полей больше 7, то добавить новые поля на формах 'frmDatabase, frmAdd, frmEdit, а также изменить их обработку (ну там по коду все понятно где надо добавлять) 'если полей меньше 7, то те же действия, но в другую сторону :-) '2) Поменять иконки в имидж-листе на форме frmDatabase. Они распространяются сразу на всю программу '---------------------------------------- Option Explicit Public 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 String Public 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) Next frmDatabase.Caption = strName frmDatabase.Icon = frmDatabase.imlButtons.ListImages(12).Picture End Sub modData Option Explicit Public i As Long Public j As Long Public lngNumberOfEdit As Long Public strSearch As String Public intPole As Integer Public OpenFile As String Public Zapis As DataBase PublicboolDopAsBoolean 'поменять тип в соответствии с заданием Public Type DataBase Студент As String * 50 Группа As String * 8 Курс As String * 50 Работа As String * 50 Дата_сдачи As String * 50 Оценка As Byte Дата_выдачи As String * 50 End Type Public Function Date_raz(date1 As String, date2 As String) As Long Dim ldate1 As Long Dim ldate2 As Long ldate1 = 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 - ldate2 End Function modInspect Option Explicit Public NumError As String Public 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 Boolean Dim i As Byte Dim c As String * 1 Dim boolДробь As Boolean boolДробь = False If Not IsNumeric(str) Then Number = False: NumError = numNumeric: Exit Function For i = 1 To Len(str) c = Mid$(str, i, 1) If c = "," Or c = "." Then boolДробь = True Next If boolДробь = True And Дробь = False Then Number = False: NumError = numДробь: Exit Function If Limits = True Then If CDbl(str) > UpLim Then Number = False: NumError = numUpLim: Exit Function If CDbl(str) < DownLim Then NumError = numDownLim: Exit Function End If NumError = "" Number = True End Function frmStart rmDatabase frmAdd frmEdit frmDiagramms frmSearch frmHelp frmAbout
| |||||