Створення бази даних

МОСКОВСЬКИЙ ОРДЕНА ЛЕНІНА, ОРДЕНИ ЖОВТНЕВОЇ РЕВОЛЮЦІЇ
І ОРДЕНА ТРУДОВОГО ЧЕРВОНОГО ПРАПОРА
ДЕРЖАВНИЙ ТЕХНІЧНИЙ УНІВЕРСИТЕТ ІМ. Н.Е. БАУМАНА
Калузький філія
Факультет "Фундаментальних Наук"
Кафедра "Програмного Забезпечення ЕОМ, інформаційних технологій і Прикладної Математики"
РОЗРАХУНКОВО-ПОЯСНЮВАЛЬНА ЗАПИСКА до курсової роботи
З основ інформатики
Тема:
"Створення бази даних"

зміст

Анотація. 4
1. дослідна частина. 5
1.1. Постановка завдання. 5
1.2. Загальні відомості. 6
1.3. Елементи мови. 7
1.4. Кошти обміну даними. 9
1.5. Вбудовані елементи .. 10
1.6. Засоби налагодження програм .. 10
2. конструкторська частина. 12
2.1. Загальні відомості. 12
2.2. Функціональне призначення. 13
2.3. Опис логічної структури програми .. 14
2.3.1. Головна форма (MainForm. frm) (рис.1) 14
2.3.2. Майстер діаграм (DiagMasterForm. frm) (рис.11) 17
2.3.3. Робота з вікном діаграми (DiagResForm. frm) (рис.16) 18
2.3.4. Робота з вікном налаштувань діаграми (DiagOpt. frm) (рис.15) 19
2.3.5. Робота з редактором записів (EditRecordForm. frm) (рис.3) 20
2.3.6. Робота з вікном вибору (SelectForm. frm) (Рис.6) 21
2.3.7. Робота з редактором тексту (TextEditForm. frm) (рис.8) 21
2.3.8. Робота з календарем (MonthForm. frm) (рис. 19) 22
2.3.9. Робота DBConst (DBConst. bas) 22
2.3.10. Робота DBTypes (DBTypes. bas) 22
2.3.11. Робота QueryRunner (QueryRunner. bas) 23
2.4. Запуск і виконання. 24
3. технологічна частина. 26
3.1. Керівництво системного програміста. 26
3.1.1. Загальні відомості про програму. 26
3.1.2. Структура програми .. 27
3.1.3. Перевірка програми .. 28
3.2. Керівництво оператора. 29
3.2.1. Загальні відомості про програму. 29
3.2.2. Виконання програми .. 29
3.2.3. Повідомлення оператору (рис.12, рис.13, рис.14) 31
література. 34
Додаток 1. 35
Додаток 2. 165

Анотація

Даний курсовий проект являє собою програму, призначену для роботи з однотаблічной ненормалізованном базою даних. Основною метою програми є забезпечення інструментарієм для роботи з базою даних різних шкільних змагань. Наданий інструментарій, який дозволяє працювати з БД на фізичному та логічному рівнях. Фізичний рівень, який змінює структуру БД, дозволяє працювати з окремими БД, створювати, видаляти і обмінювати поля і запису, а також змінювати типи полів БД. На логічному рівні можна змінювати значення полів (заголовки) і записів, виробляти вибірки, сортування, будувати різні діаграми, зберігати БД в гіпертекстовому форматі. Для полегшення роботи з програмою написана найдокладніша довідка в HTML.

1. дослідна частина

1.1. Постановка завдання

Використовуючи засоби мови програмування створити файл, елементами якого є записи, визначені таблицею вашого варіанту.
Створити файл з 10 - 15 записів. Передбачити можливість редагування файлової інформації (додавання, видалення, заміну всього запису і одного з полів запису).
Створити запити, відповідно до вашого варіанту.
Розробити інтерфейс користувача для реалізації вище перерахованих функцій.
Створити файл довідкової служби і підключити його до інтерфейсу.
Підготувати розрахунково-пояснювальну записку (див. методичні вказівки).
Основні алгоритми роботи програми винести на лист А1.
Створити заставку-презентацію даного програмного продукту з використанням графічних засобів VB.
Картка учасника змагання.

Прізвище
Ім'я
По батькові

Рік народження

Дата
Змагання

Вид змагання

Показники в змаганні

Школа

Район

Додається стовпець.
Запити:
скільки учасників змагань змагалося у стрибках у довжину; який показник є найкращим в цьому виді змагань?
отримати список учнів школи № 20, що взяли участь у змаганнях;
скільки учасників Ленінського району взяли участь у змаганнях?
який найкращий показник у стрибках у висоту, хто встановив рекорд?
отримати список учасників змагань, які взяли участь більше, ніж у трьох видах змагань.
Додається стовпець «Прізвище, ім'я, по батькові тренера».
Додаткові запити:
яка кількість учасників змагань підготував тренер Сидоров І. І.;
отримати прізвище, ім'я, по батькові тренера, який підготував учасника з кращими показниками у штовханні ядра.

1.2. Загальні відомості

Visual Basic є прямим нащадком мови Basic, що створювалася як дуже проста мова для навчання основам програмування. З тих пір мова значно розширився, а з появою Visual Basic став підтримувати концепцію ООП. Однак він все-таки ще занадто простий, і не пристосований до написання широкого кола програм. З іншого боку, він цілком підходить для своєї основної мети - написання офісних додатків. Завдяки простоті і схильності до офісних додатків діалект Visual Basic VBA (Visual Basic for Application) зроблено внутрішнім мовою для додатків Microsoft Office, а також у сторонніх програмах, що мають ліцензію на використання мови. Також існує скриптова варіант мови VBScript, який використовується в технології HTML, а саме в DHTML, тобто для динамічної роботи з вмістом гіпертекстових документів, нарівні з JavaScript, JScript. Однак навіть зараз VBScript підтримується далеко не всіма сучасними і найбільш поширеними браузерами, на відміну від JavaScript, що скорочує область його використання.
Серцем будь-якої програми на Visual Basic є виконуваний файл і ряд динамічних бібліотек (DLL - Dynamic Link Library, бібліотека динамічного зв'язування). Крім того, Visual Basic має інтегрованої можливістю використання зовнішніх компонентів, що вбудовуються в програму і полегшують роботу програміста (технологія ActiveX). Завдяки тому, що компоненти ActiveX є незалежними від вихідного мови, то в програмах Visual Basic можна використовувати сторонні компоненти, які можуть допомогти у здійсненні поставленої мети.

1.3. Елементи мови

У цій роботі використовувалися різні типи даних:
byte
integer
long
boolean
string (у форматі UNICODE)
variant
користувацькі типи
масиви елементів даних типів
Оголошення змінних:
(Dim | Private | Public | Static) <ім'я змінної> As <тип змінної>
Опис констант:
Const <ідентифікатор> As <тип>
Використовувалися запису:
Type <назва>
<Поля_запісі>
End Type
А також використовувалися основні оператори:
Альтернативні оператори умови
If <умова> Then
<Оператор 1>
[ElseIf <умова> Then
<Оператор 2> ...]
[Else <оператор 3>]
End If
Оператори вибору
Select Case <умова>
[Case <мітка 1>
<Оператор 1>]
... ... ...
[Case Else
<Оператор 2>]
End Select
Цикли
з передумовою
Do (While | Until) <умова>
<Оператор 1>
Loop
While <умова>
<Оператор 1>
Wend
з лічильником
For <лічильник> = <початкове значення> To <кінцеве значення> [крок]
<Оператор 1>
[Exit For <оператор 2>]
Next <лічильник>
з постусловіем
Loop
<Оператор 1>
Do (While | Until) <умова>
Процедури
[Dim | Private | Public | Static] Sub <ім'я процедури> ([список параметрів])
<Тіло процедури>
End Sub
Функції
[Dim | Private | Public | Static] Function <ім'я функції>; ([список параметрів]) [As <тип значення>]
<Тіло процедури>
End Function
Масиви
Статичний
Dim <іденітіфекатор> ([нижня межа to] верхня межа) As <тип>
Динамічний
Dim <ідентифікатор> As <тип> - опис масиву

1.4. Кошти обміну даними

Внутрішній обмін даними здійснюється за допомогою змінних.
Змінні можуть передаватися в процедури і функції трьома способами:
За посиланням. Передається адресу змінної, що дозволяє змінювати її значення. Використовується By Ref, режим за замовчуванням.
За значенням. Створюється локальна копія змінної рівна переданої. Значення змінити не можна. Використовується By Val.
Змінна може бути описана як глобальна і розташована поза процедур і функцій. Таким чином вона буде глобально доступна.

1.5. Вбудовані елементи

Check boxФлажок для вибору з двох варіантів
Combo boxПоле вводу зі списком
FrameГруппірованіе елементів управління
ImageДобавленіе на форму зображень
LabelОтображеніе написів
LineІзображеніе ліній для легкого зорового поділу частин інтерфейсу
List boxОтображеніе списку елементів
Option buttonГруппи перемикачів
Text boxПоле введення тексту
TimerТаймер
Не вбудовані, але використовувані:
Common DialogСтандартние системні діалоги (comdlg32. ocx)
List ViewРасшіренний список елементів (mscomctl. ocx)
Rich Text BoxРедактор текстових полів (richtx32. ocx)
Status BarСтрока стану для відображення глобальних параметрів (шлях до БД, необхідність збереження і т.д.) (mscomctl. ocx)
MonthViewКалендарь (comct332. ocx)

1.6. Засоби налагодження програм

При написанні програм виникають ситуації, коли, наприклад, необхідно виконати ділянку програми з дій, або знайти місце і причину виникає помилки. Для цих цілей у Visual Basic реалізований механізм налагодження, що дозволяє виконувати програму по кроках і спостерігати за значеннями змінних. Використовуючи точки зупину, вікно спостереження значень змінних можна вивчати виконання програми: виконання операцій, розгалужень, викликів процедур і функцій і т.д.
Також Visual Basic надає можливість вбудованої в код обробки виключень (помилок, пов'язаних з неправомірними діями програми, які походять з-за помилок в коді, або стану середовища виконання - операційної системи). Для цього в мові реалізовано конструкції:
On Error GoTo <мітка>.
Якщо під час виконання програми виникне виключення в одному з операторів, розташованих після даної конструкції, то управління передається обробнику помилок, вказаною меткой.Т. е. виконання програми продовжиться з місця, наступного за міткою. Якщо в деякий момент обробку помилок слід відключити, то використовується конструкція On Error GoTo 0.
У обробник помилок можна включити оператор Resume, який вказує на ігнорування будь-яких помилок. У цьому випадку жодна помилка не буде оброблена, що вельми небезпечно.
Resume має кілька форм:
Resume відновлює виконання програми з оператора, який викликав помилку;
Resume Next відновлює виконання програми з наступного оператора;
Resume <мітка> відновлює виконання програми з оператора, що настає за зазначеною міткою.

2. конструкторська частина

2.1. Загальні відомості

Програма DB Xtension складається з наступних частин:
Основного виконуваного файлу DBX. exe
Допоміжної програми assoc. exe
Набору wav-файлів в папці \ Data
Файли довідки в папці \ Help, ключовий файл - \ Help \ index. html
Через особливості реалізації Visual Basic також можуть знадобитися бібліотеки:
asyncfilt. dll
comcat. dll
ctl3d32. dll
msvbvm60. dll
oleaut32. dll
olepro32. dll
stdole. tlb
а також бібліотеки використовуваних ActiveX-компонентів
При написанні програми використовувалися наступні програми:
Середовище розробки
Microsoft Visual Basic 6.0
Borland / Inprise Delphi 6.0
Графічний інструметарій
XaraX 1.0
Xara3D 5.0
Microangelo 5.57
IrfanView 3.91
ICA Converter 1.1.0.8
Написання довідки, пояснювальної записки та структурної схеми
Microsoft Office Word Professional 2003
Help & Manual 3.3
Microsoft Office Visio Professional 2003
Додатково використовувалася програма UGH! 0.942

2.2. Функціональне призначення

Дана програма являє собою зручний засіб для роботи з однотаблічной ненормалізованном базою даних. Максимально зручний і функціональний інтерфейс полегшує роботу з базою даних. Запитна система, що дозволяє додавати, видаляти, сортувати, виводити, обмінювати і перетворювати дані, побудована на основі декількох універсальних запитів, що охоплюють все коло вирішуваних завдань:
Додавання полів і записів
Видалення полів і записів
Сортування записів по будь-якому полю за і проти алфавіту
Висновок записів по будь-якому полю, що підходить за параметрами:
Рівності висловом
Більше вираження
Менше вираз
Зустрічається в таблиці N разів
Зустрічається в таблиці більш N разів
Зустрічається в таблиці менш N разів
Обмін полів і записів
Перейменування і зміна типу полів (довільні рядки і цілі числа)
Запити формують копії бази даних, які можна зберігати в якості нових баз даних.
З будь-яких числових даних можна будувати діаграми наступних видів:
Столбчатая
Лінійна
Точкова
Кругова
Стовпчасті, лінійні, точкові і кругові діаграми можна будувати в площині і в аксонометричній проекції (3D, тільки для столбчатой та кругової).
Результати роботи з базою даних можна зберегти в HTML.
У разі необхідності захисту даних передбачена можливість захисту за паролем і шифрування даних в базі даних.
У даній реалізації програми база даних може містити поля трьох типів даних:
рядки довжиною до ~ 248 символів
цілі числа в діапазоні - 2147483647. .2147483647
псевдоформат Дата, є строковим, але редагований з використанням календарем

2.3. Опис логічної структури програми

2.3.1. Головна форма (MainForm. frm) (рис.1)

Запуск програми.
Запускається форма MainForm (рядок 1), у процедурі Form_Load (рядок 245) встановлюються початкові значення і стан панелі інструментів.
Створення нової БД.
Спочатку управління отримує процедура CreateDB_Click (рядок 96), в якій викликається стандартний системний діалог вибору файлу. Якщо файл обраний, то викликається процедура NewDB (рядок 2788), що створює нову БД, і процедурою ShowTable (рядок 2378) відображається порожня таблиця.

Відкриття БД.
У процедурі OpenDB_Click (рядок 292) викликається діалог вибору файлу. Якщо файл був вибраний викликається функція LoadDB (рядок 2600), завантажуються БД з файлу. У разі відсутності помилок у файлі і потрібних прав для відкриття файлу кнопки на панелі інструментів змінюють стан за допомогою процедури DisEnImage (рядок 37) та відображається завантажена таблиця процедурою ShowTable (рядок 2378). Якщо прав недостатньо для відкриття БД буде викликаний майстер захисту (рис.5, Рис.6).
Збереження БД.
У процедурі SaveDB_Click (рядок 345) викликається діалог вибору файлу. Якщо файл був вибраний, то змінюється шлях до поточної БД у змінній DBPath (рядок 2309) і БД зберігається у вказаний файл процедурою FlushDB (рядок 2500).
Закриття БД.
Якщо змінна DBChanged (рядок 2311), що є прапором незбережених змін до БД, дорівнює істині, то пропонується скасувати закриття. Якщо користувач все ж закриває БД, то процедура ClearAll (рядок 2806) звільняє використовувану під таблиці пам'ять, а процедура ShowTable (рядок 2378) приховує пусту таблицю.
Створення резервної копії.
У процедурі ResCopyDB_Click (рядок 328) спочатку викликається діалог вибору файлу. Якщо він вдалий, то перевіряється збіг поточної БД з її створюваної копією. Якщо файли різні API функція CopyFile (рядок 2824) створює копію файлу поточної БД і з'являється повідомлення про вдалому виконанні операції.
Вихід (завершення роботи).
Вихід з програми реалізований процедурою ExitPr_Click (рядок 124). У ній відбувається перевірка на внесені в БД зміни, які ще не були збережені. Якщо змін немає, або користувач вибрав вихід без збереження, програма завершує свою роботу.
Запуск Майстра запитів (QueryMasterForm. frm) (рис.2)
При виборі Запити → Майстер запитів виконується процедура QueryM_Click. (Рядок 319) У ній модально показується форма QueryMasterForm (рис.2). Управління передається цій формі, її процедурі Form_Load (рядок 785). У ній настроюється зовнішній вигляд форми. При виборі елемента в списку QueryTypeCombo викликається процедура QueryTypeCombo_Click (рядок 801), що заповнює список QuerySubtypeCombo значеннями в залежності від поля QueryTypeCombo. ListIndex. При натисканні на зображенні «+» у правій частині вікна викликається процедура AddImage_Click (рядок 667). У неї в залежності від полів QueryTypeCombo. ListIndex і QuerySubtypeCombo. ListIndex викликаються вкладені процедура AddStr (рядок 659) і функція Generate_XXX (рядки 2982, 2996, 3031, 3043, 3068, 3089). AddStr визначена в модулі форми і виконує перевірку на додаток рядка в список QueryList. Generate_XXX, що є серією функцій, що починаються Generate_, і визначених у модулі QueryRunner, формують тексти запитів на основі діалогів. Натискання зображення «-» викликає процедуру DelImage_Click (рядок 774), що видаляє вибраний в списку QueryList елемент. Якщо натиснути на зображення «X», то буде викликане процедура ClearImage_Click (рядок 762), що видаляє всі елементи в списку QueryList. При клацанні по кнопці CancelBut управління переходить до процедури обробки цієї події. Ця процедура вивантажує форму QueryMasterForm з пам'яті. Ну й натискання на кнопку «Виконати» приводить до виконання процедури RunBut_Click (рядок 832), яка викликає процедуру RunQuery (модуль QueryRunner) для кожного елемента списку QueryList, а також показує вибрану таблицю викликом ShowTable (QMFDBIndex). Після цього список QueryList очищається і видається повідомлення про завершення виконання запитів.

Формування HTML.
При виборі пункту меню Результати → Формування HTML викликається процедура HTMLCreator_Click (рядок 208). У ній викликається діалог вибору файлу. Якщо файл обраний, то процедура CreateHTML зберігає поточну БД в файл, інакше видається повідомлення про скасування формування HTML.
Захист (PasswordForm. frm) (мал. 9).
При виборі Установки → Захист викликається процедура Security_Click (рядок 356). У ній показується форма PasswordForm в режимі налаштування параметрів безопосності. Якщо після завершення роботи з формою значення змінної PasswordForm. res істинно, то нові параметри зберігаються і Вибав відповідне повідомлення. Після цього форма PasswordForm вивантажується з пам'яті.
Також дана форма використовується при відкритті БД, захищеної паролем.
Про програму (AboutForm. frm) (рис.10).
При виботе пункту Про програму в меню? викликається процедура AboutProg_Click (рядок 11). У ній модально відображається форма AboutForm.
Допомога.
Після вибору? → Допомога управління переходить до процедури HelpProg_Click (рядок 140), запускає за допомогою API функції ShellExecute (рядок 2827) браузер з файлом програмної довідки. Форму можна перетягувати мишею за будь-яке місце. Для цього використовуються процедури MDown (рядок 2874), MUp (рядок 2880), MMove (рядок 2 862). У процедурі MMove викликаються API функції GetWindowRect (рядок 2846) і MoveWindow (рядок 2847). При клацанні по напису «Xerx» викликається API функція ShellExecute (рядок 2827), що викликає програму, зареєстровану в системі як поштова.

2.3.2. Майстер діаграм (DiagMasterForm. frm) (рис.11)

При виборі Результати → Майстер діаграм виконується процедура DiagDraw_Click (рядок 114). У ній модально показується форма DiagMasterForm. Управління передається цій формі, її процедурі Form_Load (рядок 1196). У ній настроюється зовнішній вигляд форми, очищаються всі списки і в список TableIndexCombo додаються назви всіх відкритих таблиць.
При виборі елемента в TableIndexCombo у процедурі TableIndexCombo_Click (рядок 1306) список TableColList заповнюється заголовками полів обраної таблиці. При подвійному клацанні в TableColList викликається процедура TableColList_DblClick (рядок 1291), в якій обраний заголовок разом з назвою таблиці додається до списку SelectColList з попередньою перевіркою на вже додані. Подвійний клацання у списку SelectColList викликає процедуру SelectColList_DblClick (рядок 1301), в якій обрана рядок видаляється.
Вибір елемента списку DiagTypeCombo призводить до виклику процедури DiagTypeCombo_Click (рядок 1184), в якій змінюється картинка типу діаграм в компоненті DiagTypeImage, а також ховається або показується фрейм Frame2.
Натискання на кнопку Скасувати закриє форму DiagMasterForm.
Натискання на кнопку Прийняти призводить до виклику процедури OkBut_Click (рядок 1275), в якій викликається функція GettingDiagData (рядок 1229), що формує дані для діаграми. У разі успішності цього завантаження завантажується в пам'ять форма DiagResForm (рис.16) і викликається її процедура InitDiagData (рядок 1424), після чого завантажена форма модально показується.

2.3.3. Робота з вікном діаграми (DiagResForm. frm) (рис.16)

Форма DiagResForm, що викликається з форми DiagMasterForm (рис.11) кнопкою «Прийняти», призначена безпосередньо для побудови діаграм. Діаграми будуються на канві компонента Chart типу PictureBox, використовуючи його методи. Кнопка Image1 з зображення дискети дозволяє зберегти діаграму як BMP файлу. Для цього призначена процедура Image1_Click (рядок 2046), в якій, використовуючи компонент CD типу CommonDialog, вказується шлях до створюваного растровому файлу, після чого (якщо файл був вказаний) викликається вбудована процедура SavePicture, зберігає діаграму. Натиснення на зображення Image2 з зображенням питання показує модально вікно налаштувань DiagOptForm (рис.15). Кнопка Image3 з зображення стрілки вивантажує форму з пам'яті. Процедура DrawDiagram (рядок 1975), що викликається при зміні розмірів і зміні налаштувань, безпосередньо не будує діаграми, вона лише заливає фон градієнтної заливкою (процедура ColorFill (рядок 1440)), а також залежно від типу строімого діаграми викликає процедури DrawCircle (рядок 1673) (кругова діаграма) та DrawPoint (рядок 1749) (колончатая, точкова і лінійчата діаграми). Також DrawCircle викликає процедуру OutOneElem (рядок 1482), що стоїть один елемент кругової діаграми. Дані для побудови зберігаються в масиві DiagData (рядок 1387), режим побудови (тип діаграми) у змінній DrawingMode (рядок 1388), а прапор використання 3D у змінній Use3D (рядок 1388). Значення цих змінних визначаються у процедурі InitDiagData (рядок 1424). При переміщенні миші над діаграмою Chart викликається процедура Chart_MouseMove (рядок 1988), що виводить в мітку Label2 текст про значення функції у зазначеній точці. Переміщення повзунка смуги прокрутки VScroll викликає процедуру VScroll_Change (рядок 2122), що змінює значення змінної Ellipce в залежності від позиції повзунка і перемальовує діаграму.

2.3.4. Робота з вікном налаштувань діаграми (DiagOpt. frm) (рис.15)

На закладці «Кольори і текст» клацання по будь-якого компонента Frame2 викликає діалог вибору кольору (використовується ColorDlg). Зміна кольору фреймів з індексами 0 або 1 викликає процедуру ColorFill (рядок 1440) для компоненту Picture1 типу PictureBox. У списку List1 зберігаються написи елементів діаграми, а в масиві List1. ItemData зберігаються кольору відповідних елементів. У текстовому полі Text1 можна змінювати значення обраної в List1 запису. При натисканні кнопки [Enter] викликається процедура Text1_KeyDown (рядок 2203), що зберігає значення підпису в масив List1. Item. При натисканні кнопки Прийняти змінної res присвоюється значення 1, що сигналізує про необхідність застосувати внесені зміни. Після цього форма ховається. При натисканні на кнопку Відміна форма робиться невидимою без зміни змінної res.

2.3.5. Робота з редактором записів (EditRecordForm. frm) (рис.3)

Подвійний клацання по рядку в списку ListView викликає процедуру ListView_DblClick (рядок 220), в якій налаштовується зовнішній вигляд форми EditRecordForm, викликається процедура LoadData (рядок 855), визначена у модулі форми, і форма модально відображається. При завантаженні форми викликаються процедура Form_Load (рядок 891), настроює зовнішній вигляд форми. У списку CellList_Click виводяться поля вибраної у списку ListView запису. Вибір елемента в списку супроводжується викликом процедури CellList_Click (рядок 866), у якій залежно від типу обраного поля в мітку Label6 виводиться відповідний текст, а також процедурою ButEnabled (рядок 2934), визначеної в модулі DBConst, змінюється стан кнопки «Редактор». Після цього в текстове поле Text1 завантажується значення вибраного поля і повністю виділяється. Натискання кнопки «Редактор» викликає процедуру EditorBut_Click (рядок 917), в якій спочатку перевіряється тип редагованого поля, потім, якщо воно числове, видається повідомлення про помилку, інакше поле порівнюється з форматом дати. Якщо формат збігається і прапорець MonthForm. Check1 (рис. 19) (встановлений - календар не показується) не встановлено, то завантажується форма TextEditForm (рис.8) (в іншому випадку завантажується форма MonthForm), в текстовий редактор TextEdit типу RichTextBox завантажується значення з текстового поля Text1. Якщо вікно TextEditForm було закрито з збереженням тексту, то змінна TextEditForm. res істинна і змінений текст завантажується в текстове поле Text1. Після цього форма TextEditForm вивантажується з пам'яті. Натиснення на кнопку «Застосувати» викликає процедуру FlipBut_Click (рядок 1010), що перевіряє введене значення на коректність (відповідність типу і розрядній сітці) і, в разі відсутності помилок, присвоює обраному в списку CellList елементу введене значення. У разі будь-якої помилки видається відповідне повідомлення. Натиснення на кнопку «Повернути» відновлює всі поля запису з БД у процедурі ReturnBut_Click (рядок 908), що викликає послідовно LoadData (рядок 855) і OverloadList (рядок 883), що отримують і копіюють запис в тимчасовий буфер Arr (рядок 853). Натиснення на кнопку «Скасування» викликає процедуру CancelBut_Click (рядок 982), вивантажуються форму EditRecordForm з пам'яті. Кнопка «Прийняти» викликає процедуру SelectBut_Click (рядок 954), робота якої полягає у збереженні полів запису з локального масиву Arr в глобальну таблицю.

2.3.6. Робота з вікном вибору (SelectForm. frm) (Рис.6)

Вибір записів і полів БД проводиться за допомогою форми SelectForm, що надає зручний вибір середовища зазначених списків. У модулі форми глобально оголошені функції SelectDlg (рядок 556) і MultiSelectDlg (рядок 598), призначені для організації діалогу з вибору одного (SD) або декількох (MSD) записів (SD) або полів (SD, MSD) з вказаної при виклику таблиці. Функція SelectDlg повертає число, що дорівнює номеру обраного елемента, або «-1», якщо вибір був відмінений. Функція MultiSelectDlg повертає рядок, в якій через кому перераховані індекси всіх вибраних елементів. Якщо рядок порожній, то це однозначно вказує, що нічого не було обрано.

2.3.7. Робота з редактором тексту (TextEditForm. frm) (рис.8)

Натискання кнопки «Редактор» викликає форму «Редактор текстових полів» (TextEditForm), головною частиною якої є компонент TextEdit типу RichTextBox. На панель Toolbar1, розташований ряд кнопок, обробка натисків яких розташована в процедурі Toolbar1_ButtonClick (рядок 522). Кнопка «ClearText» очищає весь текст в TextEdit, а кнопка «SaveText» вказує викликає формі про необхідність внести зміни в дані. Кнопки «CopyText», «PasteText», «CutText» і «DeleteText» працюють з системним буфером обміну. Кнопка «Properties» дозволяє, використовуючи компонент FontDlg, настроювати шрифт в редакторі.

2.3.8. Робота з календарем (MonthForm. frm) (рис. 19)

При завантаженні форми у процедурі Form_Load настроюється зовнішній вигляд вікна а також змінної res (рядок 2231), що зберігає результат роботи з вікном, присвоюється значення 0. При натисканні кнопки Прийняти викликається процедура YesBut_Click (рядок 2249), що встановлює значення res в 1 (дата вибрана) і приховує форму. При натисканні кнопки Текст викликається процедура EditBut_Click (рядок 2237), що встановлює значення res в - 1 (редагування як текст) і також приховує форму. Натискання кнопки Скасування просто приховує форму у процедурі CancelBut_Click (рядок 2233).

2.3.9. Робота DBConst (DBConst. bas)

У модулі описані глобальні константи, процедури:
SoundClick (рядок 2914), для програвання звуку натискання на кнопку
IsInteger (рядок 2918), для перевірки можливості перетворення рядка в ціле число
ButEnabled (рядок 2934), для анімації кнопок

2.3.10. Робота DBTypes (DBTypes. bas)

Модуль призначений для забезпечення всієї роботи з БД як з фізичним файлом. Для цього в модулі оголошені необхідні типи, змінні і константи. Також модуль містить наступні процедури і функції:
DelCol_ (рядок 2318), процедура для видалення поля із зазначеної таблиці
DelRow_ (рядок 2348), процедура для видалення запису з вказаної таблиці
TestDBChanged (рядок 2369), процедура перевірки зміни БД і відображення дискети в першому секторі рядка стану головної форми
ShowTable (рядок 2378), процедура виведення зазначеної БД на екран
ItColAlreadyCreate (рядок 2419), функція перевірки унікальності поля
AddCol (рядок 2432), процедура додавання поля
AddField (рядок 2465), процедура додавання запису
DelTable (рядок 2475), процедура видалення зазначеної таблиці з масиву таблиць DB
CodeDecode (рядок 2483), функція шифрує рядки
FlushDB (рядок 2500), процедура збереження БД
LoadDB (рядок 2600), функція завантаження БД
NewDB (рядок 2788), процедура створення нової БД і ініціалізації налаштувань
ClearAll (рядок 2806), процедура звільнення займаної пам'яті і скидання налаштувань
ClearHeader (рядок 2814), процедура установки полів заголовка БД в стандартне (початкове) стан

2.3.11. Робота QueryRunner (QueryRunner. bas)

Модуль призначений для роботи із запитами. Для формування і виконання запитів у модулі описані необхідні константи і процедури з функціями:
Формування рядки запитів на основі діалогів:
Generate_Add (рядок 2982) - додавання полів і записів
Generate_Del (рядок 2996) - видалення полів і записів
Generate_Sort (рядок 3031) - сортування записів
Generate_Out (рядок 3043) - висновок записів
Generate_Swap (рядок 3068) - перестановка полів і записів
Generate_Change (рядок 3089) - зміна типу і заголовка поля
ErrorInQuery (рядок 3105) - повідомлення про помилку в запиті, пов'язане з ручною правкою запитів та / або некоректними параметрами
TestZero (рядок 3109) - перевірка параметра на рівність нулю. У разі рівності викликається ErrorInQuery
Виконання запитів:
AddRun (рядок 3118) - додавання полів і записів
DelRun (рядок 3187) - видалення полів і записів
SortRun (рядок 3227) - сортування записів
OutRun (рядок 3340) - висновок записів. Використовуються додаткові функції:
Equal (рядок 3290) - порівняння значень, що передаються відповідно до типів
CalcCount (рядок 3308) - підрахунок кількості записів з полем рівним заданому
EarlierDontFind (рядок 3316) - перевірка на існування раніше ідентичного поля по записах
FindRow (рядок 3326) - пошук запису
SwapRun (рядок 3464) - перестановка полів і записів
ChangeRun (рядок 3518) - зміна типу і заголовка поля
RunQuery (рядок 3583) - виконання довільного запиту. Виконує розгалуження й передачу процедур зазначених у запиті даних

2.4. Запуск і виконання

Для запуску програми необхідно запустити DBX. exe. Відразу після запуску (за умови наявності в системі всіх необхідних файлів, перерахованих в загальних відомостях) буде відкрито вікно заставки (рис.17). Після натискання клавишь Enter або Esc буде додано головне вікно програми.
Програма може бути запущена з будь-якого носія даних, будь то: жорсткий диск (HDD), дискета (FDD), CD-диск (CD - і DVD - ROM), різних зовнішніх пристроїв (Flash і ZIP) і т.д., а також по локальній мережі.

3. технологічна частина

3.1. Керівництво системного програміста

3.1.1. Загальні відомості про програму

Дана програма являє собою зручний засіб для роботи з однотаблічной ненормалізованном базою даних. У програму вбудована запитна система, що дозволяє додавати, видаляти, сортувати, виводити, обмінювати і перетворювати дані, побудована на основі декількох універсальних запитів, що охоплюють все коло конкретних вирішуваних завдань.
Системні вимоги
Процесор не нижче Intel Pentium 133,
Операційна система сімейства Windows не нижче 9x, бажано XP,
Оперативна пам'ять не менше 32MB,
Миша (не менше 1 кнопки),
Клавіатура,
1 MB вільного простору на жорсткому диску (плюс файли баз даних, результуючих HTML і збережених в BMP діаграм),
Монітор, що підтримує режим не менш 800x600x8, бажано 1024x768x24.
Програма DB Xtension складається з наступних частин:
Основного виконуваного файлу DBX. exe
Допоміжної програми assoc. exe
Набору wav-файлів в папці \ Data
Файли довідки в папці \ Help, ключовий файл - \ Help \ index. html
Через особливості реалізації Visual Basic також можуть знадобитися бібліотеки:
asyncfilt. dll
comcat. dll
ctl3d32. dll
msvbvm60. dll
oleaut32. dll
olepro32. dll
stdole. tlb
плюс бібліотеки використовуваних ActiveX-компонентів

3.1.2. Структура програми

Програма включає в себе наступні файли:
Форми:
AboutForm. frm (вікно Про програму)
DiagMasterForm. frm (майстер діаграм)
DiagResForm. frm (вікно побудови діаграм)
EditRecordForm. frm (редакрор записів)
InputForm. frm (вікно введення, заміна InputBox)
MainForm. frm (головне вікно програми)
MsgForm. frm (вікна діалогів, заміна MsgBox)
PasswordForm. frm (налаштування безпеки і введення пароля)
QueryMasterForm. frm (майстер запитів)
SelectForm. frm (вікно вибору полів або записів)
TableForm. frm (вікно створення нового поля)
TextEditForm. frm (редактор текстових полів)
Модулі:
API. bas (оголошення і використання функцій WinAPI)
DBConst. bas (глобальні опису)
DBTypes. bas (робота з БД як з файлом)
QueryRunner. bas (формування і виконання запитів)
Набір графічних і аудіо файлів

3.1.3. Перевірка програми

Для перевірки правильності функціонування програми виконайте наступні дії:
Після запуску програми і появи головної форми Створіть нову БД. Як ім'я вкажіть «test». Буде створений файл «test. dbx »розміром в 13 байт, виведено повідомлення, показана порожня таблиця на закладці« Головна таблиця »і в друге поле рядка стану виведений повний шлях до файлу.
Використовуючи майстер запитів додайте в БД два поля «ПІБ» і «Оцінка» строкового і числового типу відповідно. Поле значення за замовчуванням зміните в полі «ПІБ» на порожнє. Також створіть нову запис.
У таблиці з'явилися дві колонки з зазначеними заголовками і запис виду «'',' 0 '». Змініть значення цього поля на "Іванов І.І. | 4 ».
Аналогічно додайте запису «Петров П.П. | 5 »і« Сидоров С.С. | 3 ». Повинна вийде таблиця з відповідними даними.
Використовуючи Вибірку на перевищення запису по полю «Оцінка» більше 0 отримаєте копію БД на закладці «Висновок? > 0 ».
Видаліть запис з ПІБ Петров П.П., скориставшись видаленням запису з вибором «1) Петров П.П. - 5 ». Попередження відміните.
В отриманій дворядкового таблиці скористайтеся Обміном записів. В результаті таблиця набуде вигляду:

ПІБ	Оцінка
Сидоров С.С.	3
Іванов І.І.	4

Закрийте створену таблицю. Відсортуйте по полю ПІБ проти алфавіту. Додасться закладка «Я-> А» і таблиця «Сидоров, Петров, Іванов».
У майстрі запитів з таблиці сортування виберіть поле «Я-> А» і тип діаграми «Колонки». Встановіть режим 3D. Відмальовані стовпчаста діаграма повинна містити три стовпці чорного, сірого та білого кольорів зі значеннями відсотків 25%, 42%, 33%. Збережіть отриману діаграму у файл «diag. bmp ». Однойменний файл буде створено за вказаним шляхом.
Створіть гіпертекстовий файл «hiper. html »із заголовком« Тестовий файл ». Погодьтеся на відкриття після створення. Якщо у вашій системі встановлений і зареєстрований браузер, він буде запущений з вмістом «hiper. html ».
Також можна налаштувати параметри безпеки (Установки → Захист), зберегти БД на диск і повторно її відкрити для перевірки правильності зазначених налаштувань.
Вибір «? -> Допомога »призведе до відкриття довідки. Якщо цього не сталося, переконайтеся, що виконується умова запуску браузера з HTML-результатом (пункт X), а також у відношенні наявності безпосередньо файлів довідки.

3.2. Керівництво оператора

3.2.1. Загальні відомості про програму

3.2.2. Виконання програми

Для запуску програми необхідно запустити DBX. exe.
Для виходу з програми виконайте одну з таких дій:
Виберіть Файл → Вихід
Натисніть клавішу F12.
Натисніть праву кнопку на панелі інструментів головного вікна у вигляді кнопки виключення живлення.
Всі пункти меню Файл дублюються панеллю інструментів у еквівалентному порядку.
Для створення, відкриття, збереження, закриття та створення копії БД використовуйте однойменні пункти в меню Файл, або кнопки на панелі інструментів.
Майже вся робота з БД виконується в Майстрі запитів, розташованому в Запити → Майстер запитів. Можливі запити:

Додавання	Поля	Додавання нового поля в таблицю. Параметри задаються в окремому вікні.
Додавання	Записи	Додавання пустого запису (поля заповнені значеннями по-замовчуванню).
Видалення	Поля	Видалення поля. Установки видалення в окремому вікні.
Видалення	Записи	Видалення поля. Установки видалення в окремому вікні.
Сортування	За абеткою	Сортування обраного поля в поточній таблиці. Всі налаштування діалогами.
Сортування	Проти алфавіту
Вибір	Порівняння з виразом	Вибір тих записів, в яких вибране поле знаходиться в зазначеному логічному відношенні з введеним значенням.
Вибір	Підрахунок кількості	Вибір тих записів, кількість записів у полях на яких знаходиться у вказаному логічному відношенні з введеним значенням.
Обмін	Полів	Перестановка двох обраних полів.
Обмін	Записів	Перестановка двох обраних записів.
Зміна	Типу поля	Зміна типу поля (число ↔ рядок)
Зміна	Заголовка поля	Зміна заголовка поля на нове

Для побудови діаграм виберіть Результати → Майстер діаграм. Діаграми можна будувати тільки по полях числового типу.
Для збереження БД в гіпертекстовому форматі скористайтеся пунктом меню Результати → Формування HTML. Досить вказати шлях до файлу і заголовок таблиці.
Для установки захисту, виберіть Установки → Захист. Умовою захисту за паролем є наявність довільного, відмінного від прогалин тексту в полі введення пароля. Якщо поле порожньо ніякі налаштування не враховуються.
Для отримання довідки виберіть? → Допомога.

3.2.3. Повідомлення оператору (рис.12, рис.13, рис.14)

Майстер діаграм:
Не можна будувати діаграму по нечислових даними! (Спроба будувати діаграму за строковим значенням)
Редактор записів:
Відновити поля з БД?
Поля були відновлені!
Для редагування чисел редактор не використовується. (Редактор призначений лише для зручності редагування багаторядкового тексту)
Зберегти поля в БД?
Поля були збережені в БД!
Змінена полі перекриває вже існуюче! Змініть дані. (Змінений поле стало еквівалентно іншому полю, або не було внесено змін в дані)
Числове значення перевищує розрядну сітку! (Введено ціле число, більше за модулем 2147483647)
Значення не є цілим числом! (Введено значення, не є цілим числом або 0)
Рядок порожня. Продовжити? (Змінена рядок порожня)
Майстер запитів:
Запит скасовано!
Список запитів не порожній. Вийти? (Були створені і не виконані запити)
Очистити список запитів?
Видалити вибраний запит зі списку?
Запити виконані.
Виводити в нову таблицю? Ні для виведення у вже існуючу. (Запит може виводити результат або у вже існуючу таблицю, дописуючи в кінець, або створити нову)
Не задано відносне значення! (Для виконання запиту недостатньо даних)
Помилка в запиті! (Сталася помилка під час інтерпретації або виконання запиту)
Додається поле вже існує!
Додається стовпець дублюється!
Не можна додавати записи в БД без полів! (Запис додається, а полів у БД ще немає)
В БД немає полів!
В БД немає записів!
Нема чого сортувати! (Викликана сортування порожній БД)
Не з чим порівнювати! (Порівняння по порожній БД)
Еквівалентом виведення цілочисельного стовпця не є ціле число! Умова завжди істинне! (У запиті виведення зазначено строкове значення, а висновок йде по числовому полю)
Додається запис вже існує!
Поле строкового типу перетвориться в числовий тип. Всі нечислові значення будуть перетворені в 0. Продовжити? (При зміні типу поля з строкового в числове всі рядки, які не можна перетворити на цілі числа, будуть замінені 0).
Поле з назвою XXX вже існує!
Вікно настройок створюваного поля:
Введене значення не є цілим числом. Перетворено до "0".
Головне вікно:
Недостатньо прав для виконання дії! (Відкрита БД, захищена паролем, в режимі читання і здійснюється спроба зміни даних)
Помилка видалення стовпця!
Видалити стовпець?
Помилка видалення запису!
Видалити запис?
БД збережена!
БД пошкоджена! (При завантаженні БД сталася помилка)
Пароль прийнятий! (БД, захищена паролем, відкрита з коректно введеним паролем)
Тільки читання! (БД, захищена паролем, відкрита в режимі читання)
Пароль не прийнято! Доступ заборонено!
БД завантажена!
БД створена з налаштуваннями за замовчуванням!

література

1. Microsoft Corporation Microsoft Visual Basic 6.0 Programmer's Guide, Microsoft Press, 2003 р .
2. Microsoft ® Win32 ® Programmer's Reference, 1996 р .

Додаток 1

Вихідний код програми
Форма: MainForm. frm
0 'різниця ширини і висоти форми і TabStrip'а
1Dim dW1%, dH1%
2 'різниця ширини і висоти TabStrip'а і ListView'а
3Dim dW2%, dH2%
4 'останній вибраний елемент
5Dim saveItemIndex%
6 'поточна таблиця
7Public DBCurIndex%
8 'останній Image, над яким був курсор
9Dim OldImageIndex%
10
11Private Sub AboutProg_Click ()
12 CoolTimer. Enabled = False
13 AboutForm. Show vbModal
14 CoolTimer. Enabled = True
15End Sub
16
17Private Sub CloseDB_Click ()
18 CoolTimer. Enabled = False
19
20 If DBChanged Then
21 If (MsgForm. QuestMsg ("В БД внесені не збережені зміни. Закрити не зберігаючи?") <> ResOk) Then GoTo exit_
22 End If
23
24 SB. Panels (3). Text = ""
25 Call ClearAll
26 Call ShowTable (-1)
27 Call DisEnImage (2, 1)
28 Call DisEnImage (3, 1)
29 Call DisEnImage (4, 1)
30
31exit_:
32
33 CoolTimer. Enabled = True
34End Sub
35
36 'index, mode / сегмент, зміщення
37Sub DisEnImage (Index%, Mode%)
38 CoolBut (Index). Picture = CoolImgs. ListImages (1 + (Index * 3 + Mode)). Picture
39 CoolBut (Index). Enabled = (Mode <> 1)
40End Sub
41
42Sub RetImage ()
43 If (OldImageIndex> - 1) Then
44 If CoolBut (OldImageIndex). Enabled Then
45 Call DisEnImage (OldImageIndex, 0)
46 Else
47 Call DisEnImage (OldImageIndex, 1)
48 End If
49 End If
50 OldImageIndex = - 1
51End Sub
52
53Sub CoolMouseMove (Index%)
54 If (Index = OldImageIndex) Then Exit Sub
55 Call DisEnImage (Index, 2)
56 Call RetImage
57 OldImageIndex = Index
58End Sub
59
60Private Sub CoolBut_Click (Index As Integer)
61 Call DisEnImage (Index, 0)
62 Select Case Index
63 Case 0: Call CreateDB_Click
64 Case 1: Call OpenDB_Click
65 Case 2: Call SaveDB_Click
66 Case 3: Call CloseDB_Click
67 Case 4: Call ResCopyDB_Click
68 Case 5: Call ExitPr_Click
69 End Select
70End Sub
71
72Private Sub CoolTimer_Timer ()
73 Dim Point As POINTAPI
74 Dim R As RECT, R2 As RECT
75 Call GetCursorPos (Point)
76 Call GetWindowRect (Frame1. hwnd, R)
77 For i% = 0 To 5
78 If (Not CoolBut (i). Enabled) Then GoTo loop_
79 x% = R. Left + CoolBut (i). Left / Screen. TwipsPerPixelX
80 y% = R. Top + CoolBut (i). Top / Screen. TwipsPerPixelY
81 X2% = x + CoolBut (i). Width / Screen. TwipsPerPixelX
82 Y2% = y + CoolBut (i). Height / Screen. TwipsPerPixelY
83 R2. Left = x
84 R2. Top = y
85 R2. Right = X2
86 R2. Bottom = Y2
87 If ((Point. x> = R2. Left) And (Point. x <= R2. Right) And (Point. y> = R2. Top) And (Point. y <= R2. Bottom)) Then
88 Call CoolMouseMove (i)
89 Exit Sub
90 End If
91loop_:
92 Next i
93 Call RetImage
94End Sub
95
96Private Sub CreateDB_Click ()
97 CoolTimer. Enabled = False
98 Dlgs. FileName = ""
99 Dlgs. ShowSave
100 If (Dlgs. FileName <> "") Then
101 'створюю нову БД
102 Call NewDB (Dlgs. FileName)
103 'виводжу шлях до БД
104 SB. Panels (3). Text = DBPath
105 'дозволу
106 Call DisEnImage (2, 0)
107 Call DisEnImage (3, 0)
108 Call DisEnImage (4, 0)
109 Call ShowTable (DBCurIndex)
110 End If
111 CoolTimer. Enabled = True
112End Sub
113
114Private Sub DiagDraw_Click ()
115 CoolTimer. Enabled = False
116 DiagMasterForm. Show vbModal
117 CoolTimer. Enabled = True
118End Sub
119
120Private Sub ExitBut_Click ()
121 Call ExitPr_Click
122End Sub
123
124Private Sub ExitPr_Click ()
125 CoolTimer. Enabled = False
126 If Not DBChanged Then
127 End
128 Else
129 If (MsgForm. QuestMsg ("В БД внесені не збережені зміни. Вийти не зберігаючи?") = ResOk) Then End
130 End If
131 CoolTimer. Enabled = True
132End Sub
133
134Private Sub File_Click ()
135 SaveDB. Enabled = DBPath <> ""
136 CloseDB. Enabled = SaveDB. Enabled
137 ResCopyDB. Enabled = SaveDB. Enabled
138End Sub
139
140Private Sub HelpProg_Click ()
141 CoolTimer. Enabled = False
142 Call ShellExecute (hwnd, "open", "Help \ index. Html", "", "", 0)
143 CoolTimer. Enabled = True
144End Sub
145
146Sub CreateHTML (Path $)
147 Call DeleteFile (Path)
148 DBI% = FreeFile
149 Open Path For Binary As DBI
150
151 Capt $ = InputForm. InputVal ("Введіть заголовок для таблиці")
152
153 HTMLHeader $ = Replace ("<html> <head> <meta http-equiv=~Content-Language~ content=~ru~>" + _
154 "<meta http-equiv=~Content-Type~ content=~text/html; charset=windows-1251~>", "~", Chr (34))
155
156 HTMLInfo $ = "<title>" + Capt + "</ title>"
157
158 HTMLStart $ = Replace ("</ head> <body> <div align=~center~> <table border=~1~ cellspacing=~2~ style=~border-collapse: collapse~>", "~", Chr (34))
159
160 HTMLEnd $ = "</ table> </ div> <br> <br> <br> <hr> <i> Файл згенерований програмою DB Xtension по вмісту БД </ i> <b> '" + DBPath + "'</ b> </ body> </ html>"
161
162 HTMLCaption $ = Replace ("<tr> <td colspan=~" + CStr(DB(DBCurIndex). Header. ColCount) + "~ align=~center~ bgcolor=~#66CCFF~> <font color = ~ # FFFF00 ~ size = ~ 5 ~> "+ Capt +" </ font> </ td> </ tr> "," ~ ", Chr (34))
163
164 HTMLRowS $ = "<tr>"
165 HTMLRowE $ = "</ tr>"
166
167 If (DB (DBCurIndex). Header. ColCount> 0) Then ColWidth% = 100 \ DB (DBCurIndex). Header. ColCount
168
169 HTMLCols $ = Replace ("<td bgcolor=~#999999~ width=~" + CStr(ColWidth) + "%~ align=~center~> <b> <font face = ~ Arial ~ color = ~ # FFFFFF ~ > ^ </ font> </ b> </ td> "," ~ ", Chr (34))
170
171 HTMLCells $ = Replace ("<td width=~" + CStr(ColWidth) + "%~ align=~center~> ^ </ td>", "~", Chr (34))
172
173 Put DBI,, HTMLHeader
174 Put DBI,, HTMLInfo
175
176 If (DB (DBCurIndex). Header. ColCount> 0) Then
177 Put DBI,, HTMLStart
178 Put DBI,, HTMLCaption
179
180 Put DBI,, HTMLRowS
181 For c% = 0 To DB (DBCurIndex). Header. ColCount - 1
182 Put DBI,, Replace (HTMLCols, "^", CStr (DB (DBCurIndex). Cols (c). Title))
183 Next c
184 Put DBI,, HTMLRowE
185
186 For R% = 0 To DB (DBCurIndex). Header. RowCount - 1
187 Put DBI,, HTMLRowS
188 For c% = 0 To DB (DBCurIndex). Header. ColCount - 1
189 tmp $ = CStr (DB (DBCurIndex). Rows (R). Fields (c))
190 If (Trim (tmp) = "") Then tmp = ""
191 Put DBI,, Replace (HTMLCells, "^", tmp)
192 Next c
193 Put DBI,, HTMLRowE
194 Next R
195
196 Put DBI,, HTMLEnd
197 Else
198 Put DBI,, "</ head> <body> База не містить даних </ body> </ html>"
199 End If
200
201 Close DBI
202
203 If (MsgForm. QuestMsg ("Файл '" + Path + "' створений. Відкрити?") = ResOk) Then
204 Call ShellExecute (hwnd, "open", Path, "", "", 0)
205 End If
206End Sub
207
208Private Sub HTMLCreator_Click ()
209 CoolTimer. Enabled = False
210 HTMLPath. FileName = ""
211 HTMLPath. ShowSave
212 If (HTMLPath. FileName <> "") Then
213 Call CreateHTML (HTMLPath. FileName)
214 Else
215 Call MsgForm. ErrorMsg ("Формування HTML-документа скасовано!")
216 End If
217 CoolTimer. Enabled = True
218End Sub
219
220Private Sub ListView_DblClick ()
221 If (saveItemIndex> 0) Then
222 Load EditRecordForm
223 With EditRecordForm
224. CellList. Clear
225. ERFDBIndex = DBCurIndex
226 Call. LoadData (saveItemIndex - 1)
227 Call. OverloadList
228. Show vbModal
229 End With
230 End If
231End Sub
232
233Private Sub ListView_ItemClick (ByVal Item As MSComctlLib. ListItem)
234 saveItemIndex = Item. Index
235End Sub
236
237Private Sub ListView_MouseDown (Button As Integer, Shift As Integer, x As Single, y As Single)
238 saveItemIndex = 0
239End Sub
240
241Private Sub OptDB_Click ()
242 Security. Enabled = DBPath <> ""
243End Sub
244
245Private Sub Form_Load ()
246 'реєстрації розширення
247 Call ShellExecute (0, "", "assoc. Exe", App. Path + "\" + App. EXEName + ". Exe", "", 0)
248 DBCurIndex = 0
249 UserIsAdmin = True
250 saveItemIndex = 0
251 OldImageIndex = - 1
252 Call ClearAll
253 dW1 = Width - TabStrip. Width
254 dH1 = Height - TabStrip. Height
255 dW2 = Width - ListView. Width
256 dH2 = Height - ListView. Height
257 Call DisEnImage (0, 0)
258 Call DisEnImage (1, 0)
259 Call DisEnImage (2, 1)
260 Call DisEnImage (3, 1)
261 Call DisEnImage (4, 1)
262 Call DisEnImage (5, 0)
263End Sub
264
265Private Sub Form_Resize ()
266 CoolBar1. Width = 2 * Width
267
268 Min% = MainForm. Width - dW2
269 If (Min <0) Then: Min = 0
270 ListView. Width = Min
271
272 Min = MainForm. Height - dH2
273 If (Min <0) Then: Min = 0
274 ListView. Height = Min
275
276 Min = MainForm. Width - dW1
277 If (Min <0) Then: Min = 0
278 TabStrip. Width = Min
279
280 Min = MainForm. Height - dH1
281 If (Min <0) Then: Min = 0
282 TabStrip. Height = Min
283End Sub
284
285Private Sub Form_Unload (Cancel%)
286 If DBChanged Then
287 If (MsgForm. QuestMsg ("Вийти?") = ResNo) Then Cancel = 1
288 End If
289 Close 'мабуть, це зайве, але так мало:)
290End Sub
291
292Private Sub OpenDB_Click ()
293 CoolTimer. Enabled = False
294 Dlgs. FileName = ""
295 Dlgs. ShowOpen
296 If (Dlgs. FileName <> "") Then
297 'відкриваю БД
298 If LoadDB (DBCurIndex, Dlgs. FileName) Then
299 'виводжу шлях до БД
300 SB. Panels (3). Text = DBPath
301 Call DisEnImage (2, 0)
302 Call DisEnImage (3, 0)
303 Call DisEnImage (4, 0)
304 Call ShowTable (DBCurIndex)
305 End If
306 End If
307 CoolTimer. Enabled = True
308End Sub
309
310Private Sub QueryDB_Click ()
311 QueryM. Enabled = DBPath <> ""
312End Sub
313
314Private Sub ResDB_Click ()
315 DiagDraw. Enabled = DBPath <> ""
316 HTMLCreator. Enabled = DBPath <> ""
317End Sub
318
319Private Sub QueryM_Click ()
320 CoolTimer. Enabled = False
321 With QueryMasterForm
322. QMFDBIndex = DBCurIndex
323. Show vbModal
324 End With
325 CoolTimer. Enabled = True
326End Sub
327
328Private Sub ResCopyDB_Click ()
329 CoolTimer. Enabled = False
330 Dlgs. FileName = ""
331 Dlgs. ShowSave
332 If (Dlgs. FileName <> "") Then
333 If (Dlgs. FileName = DBPath) Then
334 Call MsgForm. ErrorMsg ("Не можна копіювати файл сам у себе!")
335 Else
336 Call CopyFile (DBPath, Dlgs. FileName, False)
337 Call MsgForm. InfoMsg ("Архівна копія БД створена.")
338 End If
339 Else
340 Call MsgForm. ErrorMsg ("Резервне копіювання БД скасовано!")
341 End If
342 CoolTimer. Enabled = True
343End Sub
344
345Private Sub SaveDB_Click ()
346 CoolTimer. Enabled = False
347 Dlgs. FileName = ""
348 Dlgs. ShowSave
349 If (Dlgs. FileName <> "") Then
350 DBPath = Dlgs. FileName
351 Call FlushDB (DBCurIndex)
352 End If
353 CoolTimer. Enabled = True
354End Sub
355
356Private Sub Security_Click ()
357 CoolTimer. Enabled = False
358 If UserIsAdmin Then
359 With PasswordForm
360. SetPassText = DB (DBCurIndex). Password
361
362 If (DB (DBCurIndex). Header. Flags And flCoded) Then
363. CheckCoded = 1
364 Else
365. CheckCoded = 0
366 End If
367 If (DB (DBCurIndex). Header. Flags And flReadOnlyEnable) Then
368. CheckNoRO = 1
369 Else
370. CheckNoRO = 0
371 End If
372. CaptionLabel = "Налаштування захисту"
373. TextLabel = "Ви можете змінити пароль і права доступу до даної БД. Наявність пароля передбачає обмежений доступ."
374. Frame1. Visible = False
375. Frame2. Visible = True
376. Show vbModal
377 If (. Res) Then
378 DB (DBCurIndex). Header. Flags = 0
379 If (Trim (. SetPassText) <> "") Then
380 DB (DBCurIndex). Password = Trim (. SetPassText)
381 DB (DBCurIndex). Header. Flags = flPasswordNeed
382 Call MsgForm. InfoMsg ("Було поставлено пароль!")
383 End If
384 DB (DBCurIndex). Header. Flags = DB (DBCurIndex). Header. Flags + (flCoded *. CheckCoded) + (flReadOnlyEnable *. CheckNoRO)
385 End If
386 Unload PasswordForm
387 End With
388 Else
389 Call ProtectedMsg
390 End If
391 CoolTimer. Enabled = True
392End Sub
393
394Private Sub TabStrip_Click ()
395 If (TabStrip. Tabs. Count = 0) Then Exit Sub
396 If (DBCurIndex <> TabStrip. SelectedItem. Index - 1) Then
397 DBCurIndex = TabStrip. SelectedItem. Index - 1
398 Call ShowTable (DBCurIndex)
399End If
400End Sub
401
402Private Sub TabStrip_MouseDown (Button As Integer, Shift As Integer, x As Single, y As Single)
403 If (Shift = vbCtrlMask) Then PopupMenu TSMenu
404End Sub
405
406Private Sub TSClose_Click ()
407 If (MsgForm. QuestMsg ("Закрити закладку?") = ResOk) Then
408 TabIndex% = TabStrip. SelectedItem. Index
409 TabStrip. Tabs. Remove (TabIndex)
410 Call DelTable (TabIndex - 1)
411
412 If (TabStrip. Tabs. Count = 0) Then
413 DBChanged = False
414 Call DisEnImage (2, 1)
415 Call DisEnImage (3, 1)
416 Call DisEnImage (4, 1)
417 Call ShowTable (-1)
418 Else
419 TabStrip. SelectedItem = TabStrip. Tabs. Item (1)
420 End If
421 End If
422End Sub
Форма: TableForm. frm
423Dim tmp As String
424
425Public Function AddColDlg (DBIndex%) As String
426 tmp = ""
427 With StCol
428. Clear
429 For i% = 1 To DB (DBIndex). Header. ColCount
430. AddItem DB (DBIndex). Cols (i - 1). title
431 Next
432. ListIndex =. ListCount - 1
433 End With
434 ColType. ListIndex = 0
435 Me. Show vbModal
436 AddColDlg = tmp
437 Unload Me
438End Function
439
440Private Sub ColType_Click ()
441 'зміна допустимих довжин
442 If Visible Then
443 Select Case ColType. ListIndex
444 Case ccInteger: InitValue. MaxLength = 4
445 Case ccString: InitValue. MaxLength = 255
446 End Select
447 End If
448
449 'контроль введення
450 If Visible And (ColType. ListIndex = ccInteger) Then
451 If (Not IsInteger (InitValue. Text)) Then InitValue. Text = "0"
452 End If
453End Sub
454
455Private Sub CreateBut_Click ()
456 Call SoundClick
457 s1 $ = Trim (ColTitle. Text)
458 Do While (s1 = "")
459 s1 = Trim (InputForm. InputVal ("Ви не ввели заголовок стовпця. Повторіть Enter."))
460 Loop
461 tmp $ = s1 + ","
462 Dim ct
463 Dim s2
464 Select Case ColType. ListIndex
465 Case ccInteger
466 t $ = Trim (InitValue. Text)
467 If (Not IsInteger (t)) Then
468 Call MsgForm. InfoMsg ("Введене значення не є цілим числом. Перетворені до" 0 ".")
469 t = "0"
470 End If
471 tmp = tmp + "" + sI + "," + t
472 Case ccString
473 t $ = Trim (InitValue. Text)
474 If (t = "") Then t = ""
475 tmp = tmp + "" + sS + "," + t
476 End Select
477 Dim pos%
478 If (OnlyEndCheck. value = 1) Then
479 pos = - 1
480 Else
481 pos = StCol. ListIndex
482 If (Option2. value = True) Then pos = pos + 1
483 End If
484 tmp = tmp + "," + CStr (pos)
485 Hide
486End Sub
487
488Private Sub CancelBut_Click ()
489 Call SoundClick
490 Hide
491End Sub
492
493Private Sub Form_Load ()
494 Call ButEnabled (CreateImg, CreateBut, True)
495 Call ButEnabled (CancelImg, CancelBut, True)
496End Sub
Форма: TextEditForm. frm
497Public res%
498Dim dW%, dH%
499
500Private Sub Form_Activate ()
501 With TextEdit
502. SelStart = Len (. Text)
503 End With
504End Sub
505
506Private Sub Form_Load ()
507 res = 0
508 dW = Width - TextEdit. Width
509 dH = Height - TextEdit. Height
510End Sub
511
512Private Sub Form_Resize ()
513 Min% = Height - dH
514 If (Min <= 1000) Then: Min = 1000: Height = dH + Min
515 TextEdit. Height = Min
516
517 Min = Width - dW
518 If (Min <= 1000) Then: Min = 1000: Width = dW + Min
519 TextEdit. Width = Min
520End Sub
521
522Private Sub Toolbar1_ButtonClick (ByVal Button As MSComctlLib. Button)
523 On Error Resume Next
524 Select Case Button. Key
525 Case "ClearText"
526 TextEdit. TextRTF = ""
527 Case "SaveText"
528 res = 1
529 Hide
530 Case "CopyText"
531 Clipboard. SetText (TextEdit. SelText)
532 Case "PasteText"
533 TextEdit. SelText = VB. Clipboard. GetText
534 Case "CutText"
535 Clipboard. SetText (TextEdit. SelText)
536 TextEdit. SelText = ""
537 Case "DeleteText"
538 TextEdit. SelText = ""
539 Case "Properties"
540 On Error GoTo checkerror
541 FontDlg. ShowFont
542 TextEdit. Font. Name = FontDlg. FontName
543 TextEdit. Font. Bold = FontDlg. FontBold
544 TextEdit. Font. Italic = FontDlg. FontItalic
545 TextEdit. Font. Size = FontDlg. FontSize
546 TextEdit. Font. Strikethrough = FontDlg. FontStrikethru
547 TextEdit. Font. Underline = FontDlg. FontUnderline
548 Exit Sub
549checkerror:
550 MsgBox "error"
551 End Select
552End Sub
553
Форма: SelectForm. frm
554Dim tmp%, tmps $
555
556Public Function SelectDlg (DBIndex%, ByVal title $, ByVal what $) As Integer
557 Dim s $
558 List1. Visible = True
559 List2. Visible = False
560 List1. Clear
561 Select Case what
562 Case sRow '*******************...::: Select Row :::... ********************
563 With MainForm. ListView. ListItems
564 For i% = 1 To. Count
565 s = CStr (i - 1) + ")" +. Item (i)
566 For j% = 1 To DB (DBIndex). Header. ColCount - 1
567 s = s + "-" +. Item (i). SubItems (j)
568 Next j
569 List1. AddItem s
570 Next i
571 End With
572
573 Case sCol '*******************...::: Select Col :::... ********************
574 With MainForm. ListView. ColumnHeaders
575 For i% = 1 To. Count
576 List1. AddItem CStr (i - 1) + ")" +. Item (i)
577 Next i
578 End With
579
580 Case sTable '*******************...::: Select Table :::... ********************
581 For i% = 0 To (MainForm. TabStrip. Tabs. Count - 1)
582 List1. AddItem CStr (i) + ")" + MainForm. TabStrip. Tabs. Item (i + 1)
583 Next i
584 End Select
585
586 If (List1. ListCount> 0) Then
587 List1. ListIndex = 0
588 Call ButEnabled (SelectImg, SelectBut, True)
589 Else
590 Call ButEnabled (SelectImg, SelectBut, False)
591 End If
592 Label1. Caption = title
593 tmp = - 1
594 Show vbModal
595 SelectDlg = CStr (tmp)
596End Function
597
598Public Function MultiSelectDlg (DBIndex%, ByVal title $, ByVal what $) As String
599 Dim s $
600 List2. Visible = True
601 List1. Visible = False
602 List2. Clear
603 CheckConfirm. Visible = False
604 If (what = sRow) Then
605 With MainForm. ListView. ListItems
606 For i% = 1 To. Count
607 s = CStr (i - 1) + ")" +. Item (i)
608 For j% = 1 To DB (DBIndex). Header. ColCount - 1
609 s = s + "-" +. Item (i). SubItems (j)
610 Next j
611 List2. AddItem s
612 Next i
613 End With
614 Else
615 With MainForm. ListView. ColumnHeaders
616 For i% = 1 To. Count
617 List2. AddItem CStr (i - 1) + ")" +. Item (i)
618 Next i
619 End With
620 End If
621 Call ButEnabled (SelectImg, SelectBut, False)
622 Label1. Caption = title
623 tmps = ""
624 Show vbModal
625 CheckConfirm. Visible = True
626 MultiSelectDlg = tmps
627End Function
628
629Private Sub Form_Activate ()
630 Call ButEnabled (CancelImg, CancelBut, True)
631End Sub
632
633Private Sub SelectBut_Click ()
634 If (SelectBut. Tag = 0) Then Exit Sub
635 If (List1. Visible) Then
636 tmp = List1. ListIndex
637 Else
638 For i = 0 To List2. ListCount - 1
639 If List2. Selected (i) Then tmps = tmps + CStr (i) + ","
640 Next i
641 tmps = Strings. Left $ (tmps, Len (tmps) - 1)
642 End If
643 Hide
644End Sub
645
646Private Sub CancelBut_Click ()
647 Hide
648End Sub
649
650Private Sub List1_Click ()
651 Call ButEnabled (SelectImg, SelectBut, (List1. ListIndex <> - 1))
652End Sub
653
654Private Sub List2_Click ()
655 Call ButEnabled (SelectImg, SelectBut, (List2. SelCount = 2))
656End Sub
Форма: QueryMasterForm. frm
657Public QMFDBIndex%
658
659Sub AddStr (str $)
660 If (str <> "") Then
661 QueryList. AddItem str
662 Else
663 Call MsgForm. ErrorMsg ("Запит скасовано!")
664 End If
665End Sub
666
667Private Sub AddImage_Click ()
668Call SoundClick
669With QueryList
670 Select Case QueryTypeCombo. ListIndex
671'******************* Додавання ***********************
672 Case 0
673 Select Case QuerySubtypeCombo. ListIndex
674 Case 0 'додавання стовпця
675 Call AddStr (Generate_Add (sCol))
676 Case 1 'додавання запису
677 Call AddStr (Generate_Add (sRow))
678 End Select
679'******************* Видалення ***********************
680 Case 1
681 Select Case QuerySubtypeCombo. ListIndex
682 Case 0 'видалення стовпця
683 Call AddStr (Generate_Del (sCol))
684 Case 1 'видалення запису
685 Call AddStr (Generate_Del (sRow))
686 End Select
687
688'******************* Сортування ***********************
689 Case 2
690 Select Case QuerySubtypeCombo. ListIndex
691 Case 0 'сортування за алфавітом
692 Call AddStr (Generate_Sort (sAZ))
693 Case 1 'сортування проти алфавіту
694 Call AddStr (Generate_Sort (sZA))
695 End Select
696
697'******************* Висновок ***********************
698 Case 3
699 Select Case QuerySubtypeCombo. ListIndex
700 Case 0 'висновок на рівність запису
701 Call AddStr (Generate_Out (sEqual))
702 Case 1 'висновок більше запису
703 Call AddStr (Generate_Out (sAbove))
704 Case 2 'висновок менше запису
705 Call AddStr (Generate_Out (sBelow))
706 Case 3 'висновок на рівність кол-ву
707 Call AddStr (Generate_Out (sCountEqual))
708 Case 4 'висновок більше запланованого,
709 Call AddStr (Generate_Out (sCountAbove))
710 Case 5 'висновок менше запланованого,
711 Call AddStr (Generate_Out (sCountBelow))
712 End Select
713
714'******************* Обмін ***********************
715 Case 4
716 Select Case QuerySubtypeCombo. ListIndex
717 Case 0 'обмін стовпців
718 Call AddStr (Generate_Swap (sCol))
719 Case 1 'обмін рядків
720 Call AddStr (Generate_Swap (sRow))
721 End Select
722
723'******************* Зміна ***********************
724 Case 5
725 Select Case QuerySubtypeCombo. ListIndex
726 Case 0 'зміна типу поля
727 Call AddStr (Generate_Change (sType))
728 Case 1 'зміна назви поля
729 Call AddStr (Generate_Change (sName))
730 End Select
731 End Select
732
733End With
734End Sub
735
736Private Sub CancelBut_Click ()
737 Call SoundClick
738 If (QueryList. ListCount> 0) Then
739 If (MsgForm. QuestMsg ("Список запитів не порожній. Вийти?") = ResOk) Then Unload Me
740 Else
741 Unload Me
742 End If
743End Sub
744
745 'заміна запиту
746Private Sub ChangeImage_MouseDown (Button As Integer, Shift As Integer, x As Single, y As Single)
747 If (Trim (Text1) <> "") Then
748 Call SoundClick
749 With QueryList
750 If (. ListIndex = - 1) Or (Shift And vbShiftMask <> 0) Then
751. AddItem Text1
752 Else
753. List (. ListIndex) = Text1
754 End If
755 End With
756 End If
757 Text1 = ""
758 Text1. SetFocus
759End Sub
760
761 'очищення запитів
762Private Sub ClearImage_Click ()
763 If (QueryList. ListCount> 0) Then
764 Call SoundClick
765 If (MsgForm. QuestMsg ("Очистити список запитів?") = ResOk) Then
766 QueryList. Clear
767 Text1 = ""
768 Text1. SetFocus
769 End If
770 End If
771End Sub
772
773 'видалення запиту
774Private Sub DelImage_Click ()
775 If (QueryList. ListIndex> = 0) Then
776 Call SoundClick
777 If (MsgForm. QuestMsg ("Видалити вибраний запит з списку?") = ResOk) Then
778 QueryList. RemoveItem QueryList. ListIndex
779 Text1 = ""
780 Text1. SetFocus
781 End If
782 End If
783End Sub
784
785Private Sub Form_Load ()
786 QueryTypeCombo. ListIndex = 0
787 Call ButEnabled (RunImg, RunBut, True)
788 Call ButEnabled (CancelImg, CancelBut, True)
789 TopImg. Picture = MainForm. TopImageList. ListImages (1). Picture
790End Sub
791
792Private Sub QueryList_DblClick ()
793 With QueryList
794 If (. ListIndex <> - 1) Then
795 Text1 =. List (. ListIndex)
796 Text1. SetFocus
797 End If
798 End With
799End Sub
800
801Private Sub QueryTypeCombo_Click ()
802 With QuerySubtypeCombo
803. Clear
804 Select Case QueryTypeCombo. ListIndex
805 Case 0
806. AddItem "Поля"
807. AddItem "Записи"
808 Case 1
809. AddItem "Поля"
810. AddItem "Записи"
811 Case 2
812. AddItem "За абеткою"
813. AddItem "Проти алфавіту"
814 Case 3
815. AddItem "Так само запису"
816. AddItem "Більше запису"
817. AddItem "Менше запису"
818. AddItem "Так само кол-ву копій"
819. AddItem "Більше запланованого копій"
820. AddItem "Менше кол-ва копій"
821 Case 4
822. AddItem "Полів"
823. AddItem "Записів"
824 Case 5
825. AddItem "Типу поля"
826. AddItem "Назви поля"
827 End Select
828. ListIndex = 0
829 End With
830End Sub
831
832Private Sub RunBut_Click ()
833 If (QueryList. ListCount> 0) Then
834 Call SoundClick
835 For i% = 0 To QueryList. ListCount - 1
836 Call RunQuery (QMFDBIndex, QueryList. List (i))
837 Next i
838 With MainForm
839. TabStrip. SelectedItem =. TabStrip. Tabs (QMFDBIndex + 1)
840 Call ShowTable (QMFDBIndex)
841 End With
842 QueryList. Clear
843 Call MsgForm. InfoMsg ("Запити виконані.")
844 End If
845End Sub
846
847Private Sub Text1_KeyDown (KeyCode As Integer, Shift As Integer)
848 If (KeyCode = 13) Then Call ChangeImage_MouseDown (vbLeftButton, Shift, 1, 1)
849End Sub
Форма: EditRecordForm. frm
850Public ERFDBIndex%
851Dim RowIndexSave%
852Dim protect As Boolean
853Dim Arr ()
854
855Public Sub LoadData (RowIndex%)
856 RowIndexSave = RowIndex
857 With DB (ERFDBIndex). Header
858 ReDim Arr (. ColCount, 1)
859 For i% = 0 To. ColCount - 1
860 Arr (i, 0) = DB (ERFDBIndex). Rows (RowIndex). Fields (i)
861 Arr (i, 1) = DB (ERFDBIndex). Cols (i). Class
862 Next i
863 End With
864End Sub
865
866Private Sub CellList_Click ()
867 i% = CellList. ListIndex
868 Select Case Arr (i, 1)
869 Case ccInteger
870 Label6. Caption = "Поле числового типу"
871 Call ButEnabled (EditorImg, EditorBut, False)
872 Case ccString
873 Label6. Caption = "Поле строкового типу"
874 Call ButEnabled (EditorImg, EditorBut, True)
875 End Select
876 With Text1
877. Text = CStr (Arr (i, 0))
878. SelStart = 0
879. SelLength = Len (. Text)
880 End With
881End Sub
882
883Public Sub OverloadList ()
884 CellList. Clear
885 For i% = 0 To DB (ERFDBIndex). Header. ColCount - 1
886 CellList. AddItem CStr (Arr (i, 0))
887 Next i
888 CellList. ListIndex = 0
889End Sub
890
891Private Sub Form_Load ()
892 protect = False
893 Call ButEnabled (ReturnImg, ReturnBut, True)
894 Call ButEnabled (EditorImg, EditorBut, False)
895 Call ButEnabled (FlipImg, FlipBut, True)
896 Call ButEnabled (SelectImg, SelectBut, True)
897 Call ButEnabled (CancelImg, CancelBut, True)
898 TopImg. Picture = MainForm. TopImageList. ListImages (1). Picture
899
900 'If (Not protect) Then
901 'Call OverloadList
902 'Else
903 'protect = False
904 'End If
905
906End Sub
907
908Private Sub ReturnBut_Click ()
909 Call SoundClick
910 If (MsgForm. QuestMsg ("Відновити поля з БД?") = ResOk) Then
911 Call LoadData (RowIndexSave)
912 Call OverloadList
913 Call MsgForm. InfoMsg ("Поля були відновлені!")
914 End If
915End Sub
916
917Private Sub EditorBut_Click ()
918 If (EditorBut. Tag = 0) Then Exit Sub
919 Call SoundClick
920 i% = CellList. ListIndex
921 If (Arr (i, 1) = ccInteger) Then
922 Call MsgForm. InfoMsg ("Для редагування чисел редактор не ісспользуется.")
923 Exit Sub
924 End If
925 If IsDate (Text1. Text) And (MonthForm. Check1. Value = 0) Then
926 s $ = Text1. Text
927 p% = InStr (1, s, ".")
928 MonthForm. MonthView1. Day = CInt (Left (s, p - 1))
929 s = Mid (s, p + 1)
930 p% = InStr (1, s, ".")
931 MonthForm. MonthView1. Month = CInt (Left (s, p - 1))
932 s = Mid (s, p + 1)
933 MonthForm. MonthView1. Year = CInt (s)
934
935 MonthForm. Show vbModal
936 Select Case MonthForm. res
937 Case 1
938 Text1. Text = CStr (MonthForm. MonthView1. Day) + "." + CStr (MonthForm. MonthView1. Month) + "." + CStr (MonthForm. MonthView1. Year)
939 Case - 1
940 GoTo text_
941 End Select
942 Else
943text_:
944 With TextEditForm
945. TextEdit. Text = Text1. Text
946 protect = True
947. Show vbModal
948 If (. Res = 1) Then Text1. Text =. TextEdit. Text
949 Unload TextEditForm
950 End With
951 End If
952End Sub
953
954Private Sub SelectBut_Click ()
955Call SoundClick
956If UserIsAdmin Then
957 If (MsgForm. QuestMsg ("Зберегти поля в БД?") = ResOk) Then
958 With DB (ERFDBIndex)
959 Dim tmparr ()
960 ReDim tmparr (. Header. ColCount)
961 For i% = 0 To. Header. ColCount - 1
962 tmparr (i) = Arr (i, 0)
963 Next i
964 If (Not FindRow (ERFDBIndex, tmparr)) Then
965 For i% = 0 To. Header. ColCount - 1
966. Rows (RowIndexSave). Fields (i) = Arr (i, 0)
967 Next i
968 DBChanged = True
969 Call MsgForm. InfoMsg ("Поля були збережені в БД!")
970 Call ShowTable (ERFDBIndex)
971 Unload Me
972 Else
973 Call MsgForm. ErrorMsg ("Змінена полі перекриває вже існуюче! Змініть дані.")
974 End If
975 End With
976 End If
977Else
978 Call ProtectedMsg
979End If
980End Sub
981
982Private Sub CancelBut_Click ()
983 Call SoundClick
984 Unload Me
985End Sub
986
987 'посимвольної порівняння str з '2147483647' - максимальним значенням Long
988Function isVeryLong (str $) As Boolean
989 If (Left (str, 1) = "-") Then str = Mid (str, 2)
990 For i% = 1 To (10 - Len (str))
991 str = "0" + str
992 Next i
993
994 maxval $ = "2147483647"
995 For i% = 1 To 10
996 ch1 $ = Mid (maxval, i, 1)
997 ch2 $ = Mid (str, i, 1)
998 If (Asc (ch2)> Asc (ch1)) Then
999 isVeryLong = True
1000 GoTo exit_
1001 ElseIf (ch2 <> ch1) Then
1002 isVeryLong = False
1003 GoTo exit_
1004 End If
1005 Next i
1006 isVeryLong = False
1007exit_:
1008End Function
1009
1010Private Sub FlipBut_Click ()
1011Call SoundClick
1012If UserIsAdmin Then
1013 tmp = Null
1014 i% = CellList. ListIndex
1015 mln% = 10
1016 If (Left (Text1. Text, 1) = "-") Then mln = mln + 1
1017 If (Arr (i, 1) = ccInteger) Then
1018 If (Len (Trim (Text1. Text))> mln) Or (isVeryLong (Trim (Text1. Text))) Then
1019 Call MsgForm. ErrorMsg ("Числове значення перевищує розрядну сітку!")
1020 With Text1
1021. SelStart = 0
1022. SelLength = Len (. Text)
1023 End With
1024 GoTo exit_
1025 End If
1026
1027 If IsInteger (Trim (Text1. Text)) Then
1028 tmp = CLng (Text1. Text)
1029 Else
1030 Call MsgForm. ErrorMsg ("Значення не є цілим числом!")
1031 With Text1
1032. SelStart = 0
1033. SelLength = Len (. Text)
1034 End With
1035 End If
1036 Else
1037 If (Trim (Text1. Text) = "") Then
1038 If (MsgForm. QuestMsg ("Рядок порожня. Продовжити?") = ResOk) Then
1039 tmp = Text1. Text
1040 GoTo exit_
1041 Else
1042 With Text1
1043. SelStart = 0
1044. SelLength = Len (. Text)
1045 End With
1046 End If
1047 Else
1048 tmp = Text1. Text
1049 End If
1050 End If
1051
1052 "Введене значення пройшло контроль
1053 If (Not IsNull (tmp)) Then
1054 Select Case Arr (i, 1)
1055 Case ccInteger: Arr (i, 0) = CLng (tmp)
1056 Case ccString: Arr (i, 0) = CStr (tmp)
1057 End Select
1058 curpos% = CellList. ListIndex
1059 Call OverloadList
1060 CellList. ListIndex = curpos
1061 End If
1062exit_:
1063Else
1064 Call ProtectedMsg
1065End If
1066End Sub
1067
1068Private Sub Text1_KeyDown (KeyCode As Integer, Shift As Integer)
1069 If (KeyCode = 13) Then FlipBut_Click
1070End Sub
Форма: MsgForm. frm
1071Dim res As Byte
1072
1073Public Function ErrorMsg (str $) As Integer
1074 Caption = "Помилка"
1075 Text = str
1076
1077 YesFrame. Visible = True
1078 NoFrame. Visible = False
1079 CancelFrame. Visible = False
1080
1081 InfoImage. Visible = False
1082 ErrImage. Visible = True
1083 QuestImage. Visible = False
1084
1085 YesFrame. Move 2400
1086 res = resBad
1087 Call sndPlaySound ("Data \ Error. Wav", SND_ASYNC + SND_FILENAME + SND_LOOP + SND_APPLICATION)
1088 Show vbModal
1089 ErrorMsg = res
1090 Unload Me
1091End Function
1092
1093Public Function InfoMsg (str $) As Integer
1094 Caption = "Інформація"
1095 Text = str
1096
1097 YesFrame. Visible = True
1098 NoFrame. Visible = False
1099 CancelFrame. Visible = False
1100
1101 InfoImage. Visible = True
1102 ErrImage. Visible = False
1103 QuestImage. Visible = False
1104
1105 YesFrame. Move 2400
1106
1107 res = 0
1108 Call sndPlaySound ("Data \ Info. Wav", SND_ASYNC + SND_FILENAME + SND_LOOP + SND_APPLICATION)
1109 Show vbModal
1110 InfoMsg = res
1111 Unload Me
1112End Function
1113
1114Public Function QuestMsg (str $, Optional showcancel As Boolean = False) As Integer
1115 Caption = "Питання"
1116 Text = str
1117
1118 If showcancel Then
1119 YesFrame. Visible = True
1120 NoFrame. Visible = True
1121 CancelFrame. Visible = True
1122
1123 YesFrame. Move 360
1124 NoFrame. Move 4380
1125 CancelFrame. Move 2400
1126
1127 Else
1128 YesFrame. Visible = True
1129 NoFrame. Visible = True
1130 CancelFrame. Visible = False
1131
1132 YesFrame. Move 900
1133 NoFrame. Move 3840
1134 End If
1135
1136 InfoImage. Visible = False
1137 ErrImage. Visible = False
1138 QuestImage. Visible = True
1139
1140 res = 0
1141 Call sndPlaySound ("Data \ Quest. Wav", SND_ASYNC + SND_FILENAME + SND_LOOP + SND_APPLICATION)
1142 Show vbModal
1143 QuestMsg = res
1144 Unload Me
1145End Function
1146
1147Private Sub CancelBut_Click ()
1148 res = resCancel
1149 Call SoundClick
1150 Hide
1151End Sub
1152
1153Private Sub Form_KeyDown (KeyCode As Integer, Shift As Integer)
1154 Select Case KeyCode
1155 Case 13
1156 Call YesBut_Click
1157 Case 27
1158 Call NoBut_Click
1159 Case 8
1160 If (CancelFrame. Visible = True) Then Call CancelBut_Click
1161 End Select
1162End Sub
1163
1164Private Sub Form_Load ()
1165 Call ButEnabled (YesImg, YesBut, True)
1166 Call ButEnabled (CancelImg, CancelBut, True)
1167 Call ButEnabled (NoImg, NoBut, True)
1168End Sub
1169
1170Private Sub NoBut_Click ()
1171 res = resNo
1172 Call SoundClick
1173 Hide
1174End Sub
1175
1176Private Sub YesBut_Click ()
1177 res = resOk
1178 Call SoundClick
1179 Hide
1180End Sub
1181
Форма: DiagMasterForm. frm
1182Dim DiagData ()
1183
1184Private Sub DiagTypeCombo_Click ()
1185 DiagTypeImage. Picture = DiagTypeImgs. ListImages (DiagTypeCombo. ListIndex + 1). Picture
1186 Select Case DiagTypeCombo. ListIndex
1187 Case 0, 2: Frame2. Visible = False
1188 Case 1, 3: Frame2. Visible = True
1189 End Select
1190End Sub
1191
1192Private Sub Enabled3DCheck_Click ()
1193 DimImg. Picture = DiagTypeImgs. ListImages (5 + Enabled3DCheck. Value). Picture
1194End Sub
1195
1196Private Sub Form_Load ()
1197 Call ButEnabled (OkImg, OkBut, False)
1198 Call ButEnabled (CancelImg, CancelBut, True)
1199 TopImg. Picture = MainForm. TopImageList. ListImages (1). Picture
1200 DiagTypeCombo. ListIndex = 0
1201 DimImg. Picture = DiagTypeImgs. ListImages (5). Picture
1202
1203 TableIndexCombo. Clear
1204 SelectColList. Clear
1205 For i% = 1 To MainForm. TabStrip. Tabs. Count
1206 TableIndexCombo. AddItem MainForm. TabStrip. Tabs (i). Caption
1207 Next i
1208 TableIndexCombo. ListIndex = 0
1209End Sub
1210
1211 'по рядку "{x, YYY} ZZZ" повертає номер таблиці (x)
1212Sub GetTableIndex (ByVal str As String, TI As Integer)
1213 s $ = Trim $ (Mid $ (str, 2, InStr (1, str, ",") - 2))
1214 TI = CInt (s)
1215End Sub
1216
1217 'по рядку "{x, YYY} ZZZ" та номером таблиці повертає номер поля із заголовком ZZZ
1218Sub GetColIndex (ByVal str As String, ByVal TI As Integer, CI As Integer)
1219 s $ = Trim $ (Mid $ (str, InStr (1, str, "}") + 1))
1220 For i% = 0 To DB (TI). Header. ColCount - 1
1221 If (s = Trim (DB (TI). Cols (i). Title)) Then
1222 CI = i
1223 Exit Sub
1224 End If
1225 Next i
1226 CI = - 1 'подія неможливе але ймовірне
1227End Sub
1228
1229Function GettingDiagData (OnlyOneCol As Boolean) As Boolean
1230 GettingDiagData = False
1231
1232 Dim TI As Integer, CI As Integer
1233
1234 Select Case OnlyOneCol
1235 Case True '********************************************** **************************
1236 Call GetTableIndex (SelectColList. List (0), TI)
1237 Call GetColIndex (SelectColList. List (0), TI, CI)
1238 'знаючи номер таблиці та номер поля даних потрібно перевірити тип поля
1239 If (DB (TI). Cols (CI). Class <> ccInteger) Then
1240 Call MsgForm. ErrorMsg ("Не можна будувати діаграму по нечисельних даними!")
1241 Exit Function
1242 End If
1243 'заповнення масиву даних
1244 ReDim DiagData (2 * DB (TI). Header. RowCount)
1245 For i% = 0 To DB (TI). Header. RowCount - 1
1246 DiagData (2 * i) = DB (TI). Rows (i). Fields (CI)
1247 DiagData (2 * i + 1) = DiagData (2 * i)
1248 Next i
1249 GettingDiagData = True
1250
1251 Case False '********************************************** **************************
1252 ReDim DiagData (2 * SelectColList. ListCount)
1253 For R% = 0 To SelectColList. ListCount - 1
1254 Call GetTableIndex (SelectColList. List (R), TI)
1255 Call GetColIndex (SelectColList. List (R), TI, CI)
1256 'знаючи номер таблиці та номер поля даних потрібно перевірити тип поля
1257 If (DB (TI). Cols (CI). Class <> ccInteger) Then
1258 Call MsgForm. ErrorMsg ("Не можна будувати діаграму по нечисельних даними!")
1259 Exit Function
1260 End If
1261 Dim Summary As Integer
1262 Summary = 0
1263 For i% = 0 To DB (TI). Header. RowCount - 1
1264 Summary = Summary + DB (TI). Rows (i). Fields (CI)
1265 Next i
1266 'заповнення масиву даних
1267 DiagData (2 * R) = Summary
1268 DiagData (2 * R + 1) = MainForm. TabStrip. Tabs (TI + 1). Caption + "." + DB (TI). Cols (CI). title
1269 Next R
1270 GettingDiagData = True
1271 End Select
1272
1273End Function
1274
1275Private Sub OkBut_Click ()
1276 If (OkBut. Tag = 0) Then Exit Sub
1277 Call SoundClick
1278
1279 If GettingDiagData (SelectColList. ListCount = 1) Then
1280 Load DiagResForm
1281 Call DiagResForm. InitDiagData (DiagData, DiagTypeCombo. ListIndex, (Enabled3DCheck. value = 1))
1282 DiagResForm. Show vbModal
1283 End If
1284End Sub
1285
1286Private Sub CancelBut_Click ()
1287 Call SoundClick
1288 Unload Me
1289End Sub
1290
1291Private Sub TableColList_DblClick ()
1292 i% = TableColList. ListIndex
1293 s $ = "{" + CStr (TableIndexCombo. ListIndex) + "," + TableIndexCombo. Text + "}" + TableColList. List (i)
1294 For j% = 0 To SelectColList. ListCount - 1
1295 If (SelectColList. List (j) = s) Then Exit Sub
1296 Next j
1297 Call ButEnabled (OkImg, OkBut, True)
1298 SelectColList. AddItem s
1299End Sub
1300
1301Private Sub SelectColList_DblClick ()
1302 If (SelectColList. ListIndex> - 1) Then SelectColList. RemoveItem SelectColList. ListIndex
1303 Call ButEnabled (OkImg, OkBut, (SelectColList. ListCount> 0))
1304End Sub
1305
1306Private Sub TableIndexCombo_Click ()
1307 DBI% = TableIndexCombo. ListIndex
1308 TableColList. Clear
1309 For i% = 0 To DB (DBI). Header. ColCount - 1
1310 TableColList. AddItem DB (DBI). Cols (i). title
1311 Next i
1312 If (TableColList. ListCount> 0) Then TableColList. ListIndex = 0
1313End Sub
Форма: PasswordForm. frm
1314Public res As Boolean
1315
1316Private Sub Form_Activate ()
1317 res = False
1318 If Frame1. Visible Then
1319 PassText. SetFocus
1320 Else
1321 SetPassText. SetFocus
1322 End If
1323End Sub
1324
1325Private Sub Form_Load ()
1326 Call ButEnabled (OkImg, OkBut, True)
1327 Call ButEnabled (CancelImg, CancelBut, True)
1328 TopImg. Picture = MainForm. TopImageList. ListImages (1). Picture
1329End Sub
1330
1331Private Sub OkBut_Click ()
1332 res = True
1333 Call SoundClick
1334 Hide
1335End Sub
1336
1337Private Sub CancelBut_Click ()
1338 Call SoundClick
1339 Hide
1340End Sub
1341
1342Private Sub PassText_KeyDown (KeyCode As Integer, Shift As Integer)
1343 If (KeyCode = 13) Then Call OkBut_Click
1344End Sub
1345
1346Private Sub SetPassText_KeyDown (KeyCode As Integer, Shift As Integer)
1347 If (KeyCode = 13) Then Call OkBut_Click
1348End Sub
Форма: AboutForm. frm
1349Private Sub Form_Load ()
1350 Call MInit
1351 Call ButEnabled (OkImg, OkBut, True)
1352 Label6. Caption = "v." + CStr (App. Major) + "." + CStr (App. Minor) + "." + CStr (App. Revision)
1353End Sub
1354
1355Private Sub Form_MouseDown (Button As Integer, Shift As Integer, x As Single, y As Single)
1356 Call MDown (x, y)
1357End Sub
1358
1359Private Sub Form_MouseMove (Button As Integer, Shift As Integer, x As Single, y As Single)
1360 Call MMove (hwnd, x, y)
1361End Sub
1362
1363Private Sub Form_MouseUp (Button As Integer, Shift As Integer, x As Single, y As Single)
1364 Call MUp
1365End Sub
1366
1367Private Sub Image2_Click ()
1368 Call ShellExecute (0, "", "mailto: xerx @ nightmail. Ru", "", "", 1)
1369End Sub
1370
1371Private Sub NoViewLabel_MouseDown (Button As Integer, Shift As Integer, x As Single, y As Single)
1372 Call MDown (x, y)
1373End Sub
1374
1375Private Sub NoViewLabel_MouseMove (Button As Integer, Shift As Integer, x As Single, y As Single)
1376 Call MMove (hwnd, x, y)
1377End Sub
1378
1379Private Sub NoViewLabel_MouseUp (Button As Integer, Shift As Integer, x As Single, y As Single)
1380 Call MUp
1381End Sub
1382
1383Private Sub OkBut_Click ()
1384 Unload Me
1385End Sub
Форма: DiagResForm. frm
1386Dim dW%, dH%, dX%, dH2%
1387Dim DiagData () As TDiagElem
1388Dim DrawingMode As Byte, Use3D As Boolean
1389
1390 'константи для виведення шматка більше 270 градусів (виведена частина)
1391Const mode270begin As Byte = 1
1392Const mode270end As Byte = 2
1393
1394 'дані для процедур малювання
1395 Const Pi_180 As Double = 1.74532925199433E-02
1396 Const Pi_2 As Double = 1.5707963267949
1397 Const NearZero As Double = 1E-45
1398
1399 Dim Xc%, Yc% 'центр діаграми
1400 Dim Radius # 'радіус шматків
1401 Dim InRad # 'радіус розносу шматків
1402 Dim OneGradus # 'одиниць в одному градусі
1403 Dim ChartHeight% 'висота графіка
1404 Dim ChartWidth% 'ширина графіка
1405 Dim ChartTop% 'верх графіка
1406 Dim ChartDown% 'вниз графіка
1407 Dim ItemCount% 'к-ть елементів
1408 Dim Max%, Sum% 'максимальне значення, а сума всіх значень
1409 Dim OldGrad # 'попередній кут
1410 Dim LineCount As Long 'кількість смуг заливки
1411 Dim d3D% 'зсув в 3D, в пікселях
1412 Dim dWidth As Single 'ширина одного стовпця
1413 Dim dHeight As Single 'висота' одиниці висоти '
1414 Dim StartFillColor As Long
1415 Dim EndFillColor As Long
1416 Dim LineColor As Long
1417 Dim LineWidth As Byte
1418 Dim PointRadius%
1419 Dim Ellipce #
1420 Dim UseColorFill As Boolean
1421 Dim UseCircleLegend As Boolean
1422 Dim UseLineLeftValues As Boolean
1423
1424Public Sub InitDiagData (Data (), ByVal Mode As Byte, ByVal May3D As Boolean)
1425 ReDim DiagData (UBound (Data) \ 2 - 1)
1426 d # = 255 / (UBound (Data) \ 2 - 1)
1427 For i% = 0 To (UBound (Data) \ 2 - 1)
1428 DiagData (i). Val = Abs (Data (2 * i))
1429 DiagData (i). Text = Data (2 * i + 1)
1430 DiagData (i). Color = RGB (i * d, i * d, i * d)
1431 Next i
1432 DrawingMode = Mode
1433 Use3D = May3D
1434
1435 Label2. Visible = (DrawingMode <> 3)
1436 Label3. Visible = Label2. Visible
1437 VScroll. Enabled = Not Label2. Visible
1438End Sub
1439
1440Public Sub ColorFill (PB As PictureBox, ByVal StColor As Long, ByVal EnColor As Long)
1441 Dim dR #, dG #, DB #, dC1 As Long, dC2 As Long
1442 Dim R #, G #, B #
1443 Dim intLoop As Long
1444
1445 PB. Line (0, 0) - (PB. Width, PB. Height), EnColor, BF
1446
1447 'get Red
1448 dC1 = StColor - (StColor \ & H100) * & H100
1449 R = dC1
1450 dC2 = EnColor - (EnColor \ & H100) * & H100
1451 dR = (dC1 - dC2) / LineCount
1452
1453 'get Green
1454 dC1 = (StColor - (StColor \ & H10000) * & H10000 - dC1) \ & H100
1455 G = DC1
1456 dC2 = (EnColor - (EnColor \ & H10000) * & H10000 - dC2) \ & H100
1457 dG = (dC1 - dC2) / LineCount
1458
1459 'get Blue
1460 dC1 = StColor \ & H10000
1461 B = dC1
1462 dC2 = EnColor \ & H10000
1463 DB = (dC1 - dC2) / LineCount
1464
1465 With PB
1466. DrawStyle = 1
1467. DrawMode = vbCopyPen
1468. ScaleMode = vbPixels
1469. DrawWidth = 2
1470. ScaleHeight = LineCount
1471 For intLoop = 0 To LineCount - 1
1472 PB. Line (0, intLoop) - (PB. Width, intLoop - 1), RGB (R, G, B), BF
1473 R = R - dR: If (R <0) Then R = 255: If (R> 255) Then R = 0
1474 G = G - dG: If (G <0) Then G = 255: If (G> 255) Then G = 0
1475 B = B - DB: If (B <0) Then B = 255: If (B> 255) Then B = 0
1476 Next intLoop
1477. ScaleMode = vbTwips
1478. DrawWidth = 1
1479 End With
1480End Sub
1481
1482Sub OutOneElem (ElemIndex As Integer, StAn #, EnAn #, Optional Mode270Mode As Byte = 0)
1483 'центральний кут
1484 angle # = (StAn + (EnAn - StAn) / 2) * Pi_180
1485
1486 'динамічна глибина
1487 d3D_% = Round (d3D / 100 * (100 - Round (100 * Ellipce)))
1488 If (d3D_ = 0) Then d3D_ = 1
1489 'динамічне зміщення центрів шматків
1490 r_ # = Ellipce * d3D / 100
1491
1492 X1 # = Xc + Radius * Cos (angle)
1493 Y1 # = Yc - Radius * Sin (angle)
1494
1495 x # = Xc + InRad / Radius * (X1 - Xc)
1496 y # = Yc + InRad / Radius * (Y1 - Yc) * r_
1497
1498 If (Not Use3D) Then
1499 Chart. FillStyle = 0
1500 Chart. FillColor = DiagData (ElemIndex). Color
1501 If (StAn <> 0) Then
1502 Chart. Circle (x, y), Radius, LineColor, - StAn * Pi_180, - EnAn * Pi_180, Ellipce
1503 Else
1504 Chart. Circle (x, y), Radius, LineColor, - 1E-45, - EnAn * Pi_180, Ellipce
1505 End If
1506 Chart. FillStyle = 1
1507
1508 'висновок значень
1509 R # = 1.3. * Radius
1510 X2 # = x + R * Cos (angle)
1511 Y2 # = y - Ellipce * R * Sin (angle)
1512
1513 x0 # = x + Radius * Cos (angle)
1514 y0 # = y - Ellipce * Radius * Sin (angle)
1515
1516 str_1 $ = CStr (DiagData (ElemIndex). Text)
1517 d1 # = Chart. TextWidth (str_1)
1518 str_2 $ = CStr (DiagData (ElemIndex). Val)
1519 d2 # = Chart. TextWidth (str_2)
1520
1521 If UseCircleLegend Then
1522 Chart. DrawStyle = 4
1523 Chart. Line (x0, y0) - (X2, Y2), LineColor
1524 Chart. DrawStyle = 0
1525
1526 If Not ((angle> Pi_2) And (angle <= 3 * Pi_2)) Then
1527 Chart. Line (X2, Y2) - (X2 + d1, Y2), LineColor
1528 Chart. CurrentX = X2
1529 Chart. CurrentY = Y2
1530 Chart. Print CStr (str_1)
1531
1532 Chart. CurrentX = X2
1533 Chart. CurrentY = Y2 - Chart. TextHeight (str_2)
1534 Chart. Print CStr (str_2)
1535 Else
1536 Chart. Line (X2, Y2) - (X2 - d1, Y2), LineColor
1537 Chart. CurrentX = X2 - d1
1538 Chart. CurrentY = Y2
1539 Chart. Print CStr (str_1)
1540
1541 Chart. CurrentX = X2 - d1
1542 Chart. CurrentY = Y2 - Chart. TextHeight (str_2)
1543 Chart. Print CStr (str_2)
1544 End If
1545 End If
1546
1547 Else
1548 Chart. FillStyle = 0
1549 Chart. FillColor = DiagData (ElemIndex). Color
1550
1551 Select Case Mode270Mode
1552 Case 0
1553 sa # = StAn
1554 If (sa = 0) Then sa = 1E-45 Else sa = sa * Pi_180
1555 For i% = d3D_ To 1 Step - 1
1556 If (i = d3D_) Then
1557 Chart. DrawStyle = vbSolid
1558 Chart. Circle (x, Screen. TwipsPerPixelY * (i - 1) + y), Radius, LineColor, - sa, - EnAn * Pi_180, Ellipce
1559 Chart. DrawStyle = vbInvisible
1560 ElseIf (i = 1) Then
1561 Chart. DrawStyle = vbSolid
1562 Chart. Circle (x, y), Radius, LineColor, - sa, - EnAn * Pi_180, Ellipce
1563 Chart. DrawStyle = vbInvisible
1564 Else
1565 Chart. Circle (x, Screen. TwipsPerPixelY * (i - 1) + y), Radius, LineColor, - sa, - EnAn * Pi_180, Ellipce
1566 End If
1567 Next i
1568
1569 Case mode270begin
1570 For i% = d3D_ To 1 Step - 1
1571 If (i = d3D_) Then
1572 Chart. DrawStyle = vbSolid
1573 Chart. Circle (x, Screen. TwipsPerPixelY * (i - 1) + y), Radius, LineColor, - StAn * Pi_180, - EnAn * Pi_180, Ellipce
1574 Chart. DrawStyle = vbInvisible
1575 Else
1576 Chart. Circle (x, Screen. TwipsPerPixelY * (i - 1) + y), Radius, LineColor, - StAn * Pi_180, - angle, Ellipce
1577 End If
1578 Next i
1579
1580 Case mode270end
1581 For i% = d3D_ To 1 Step - 1
1582 If (i = 1) Then
1583 Chart. DrawStyle = vbSolid
1584 Chart. Circle (x, y), Radius, LineColor, - StAn * Pi_180, - EnAn * Pi_180, Ellipce
1585 Else
1586 Chart. DrawStyle = vbInvisible
1587 Chart. Circle (x, Screen. TwipsPerPixelY * (i - 1) + y), Radius, LineColor, - angle, - EnAn * Pi_180, Ellipce
1588 End If
1589 Next i
1590 End Select
1591
1592 Chart. FillStyle = 1
1593 Chart. DrawStyle = vbSolid
1594
1595 'висновок значень
1596 R # = 1.3. * Radius
1597 X2 # = x + R * Cos (angle)
1598 Y2 # = y - Ellipce * R * Sin (angle)
1599
1600 x0 # = x + Radius * Cos (angle)
1601 y0 # = y - Ellipce * Radius * Sin (angle)
1602
1603 str_1 $ = CStr (DiagData (ElemIndex). Text)
1604 d1 # = Chart. TextWidth (str_1)
1605 str_2 $ = CStr (DiagData (ElemIndex). Val)
1606 d2 # = Chart. TextWidth (str_2)
1607
1608 If UseCircleLegend Then
1609 Chart. DrawStyle = 4
1610 Chart. Line (x0, y0) - (X2, Y2), LineColor
1611 Chart. DrawStyle = 0
1612
1613 If Not ((angle> Pi_2) And (angle <= 3 * Pi_2)) Then
1614 Chart. Line (X2, Y2) - (X2 + d1, Y2), LineColor
1615 Chart. CurrentX = X2
1616 Chart. CurrentY = Y2
1617 Chart. Print CStr (str_1)
1618
1619 Chart. CurrentX = X2
1620 Chart. CurrentY = Y2 - Chart. TextHeight (str_2)
1621 Chart. Print CStr (str_2)
1622 Else
1623 Chart. Line (X2, Y2) - (X2 - d1, Y2), LineColor
1624 Chart. CurrentX = X2 - d1
1625 Chart. CurrentY = Y2
1626 Chart. Print CStr (str_1)
1627
1628 Chart. CurrentX = X2 - d1
1629 Chart. CurrentY = Y2 - Chart. TextHeight (str_2)
1630 Chart. Print CStr (str_2)
1631 End If
1632 End If
1633
1634 'а тепер висновок бічних ліній
1635 Chart. DrawStyle = 0
1636
1637 'початковий кут
1638 If Not ((StAn> 90) And (StAn <180)) Then
1639 sa # = StAn * Pi_180
1640 x0 = x + Radius * Cos (sa)
1641 y0 = y - Radius * Ellipce * Sin (sa)
1642
1643 If (Mode270Mode <> mode270end) Then
1644 Chart. Line (x0, y0) - (x0, y0 + d3D_ * Screen. TwipsPerPixelY), LineColor
1645 End If
1646 End If
1647
1648 'кінцевий кут
1649 If Not ((EnAn> 0) And (EnAn <90)) Then
1650 x0 = x + Radius * Cos (EnAn * Pi_180)
1651 y0 = y - Radius * Ellipce * Sin (EnAn * Pi_180)
1652
1653 Chart. Line (x0, y0) - (x0, y0 + d3D_ * Screen. TwipsPerPixelY), LineColor
1654 End If
1655
1656 'центр
1657 If Not ((EnAn> = 270) And (StAn <= 270)) Then
1658 Chart. Line (x, y) - (x, y + d3D_ * Screen. TwipsPerPixelY), LineColor
1659 End If
1660
1661 'лівий край
1662 If ((StAn <= 180) And (EnAn> = 180)) Then
1663 Chart. Line (x - Radius, y) - (x - Radius, y + d3D_ * Screen. TwipsPerPixelY), LineColor
1664 End If
1665
1666 End If
1667
1668 OldGrad = Grad
1669End Sub
1670
1671
1672 'малювання кругової діаграми
1673Sub DrawCircle ()
1674 Dim Mode270 As Boolean
1675 Dim Item270%
1676
1677 ItemCount = UBound (DiagData) + 1
1678
1679 With Chart
1680 Max = - 1
1681 Sum = 0
1682 For i% = 1 To ItemCount
1683 If (DiagData (i - 1). Val> Max) Then Max = DiagData (i - 1). Val
1684 Sum = Sum + DiagData (i - 1). Val
1685 Next i
1686
1687 Mode270 = (Max> 3 / 4 * Sum)
1688
1689 OneGradus = 360 / Sum
1690 OldGrad = 0.00001
1691
1692 Xc = Chart. Width \ 2
1693 Yc = Chart. Height \ 2
1694
1695 Dim pos90%, pos270% 'індекси ключових елементів
1696 pos90 = - 1
1697 pos270 = - 1
1698 OldGrad = 0
1699
1700 Dim Angles () As Double
1701 ReDim Angles (ItemCount - 1, 1)
1702
1703 For i% = 1 To ItemCount
1704 If Mode270 Then If (DiagData (i - 1). Val = Max) Then Item270 = i - 1
1705 Grad # = DiagData (i - 1). Val * OneGradus + OldGrad
1706 If (OldGrad <= 90) And (Grad> = 90) Then pos90 = i - 1
1707 If (OldGrad <= 270) And (Grad> = 270) Then pos270 = i - 1
1708 Angles (i - 1, 0) = OldGrad
1709 Angles (i - 1, 1) = Grad
1710 OldGrad = Grad
1711 Next i
1712
1713 Chart. DrawStyle = 0
1714
1715 If Not Mode270 Then
1716
1717 For i% = pos90 To 0 Step - 1
1718 Call OutOneElem (i, Angles (i, 0), Angles (i, 1))
1719 Next i
1720
1721 For i% = pos90 + 1 To pos270 - 1
1722 Call OutOneElem (i, Angles (i, 0), Angles (i, 1))
1723 Next i
1724
1725 For i% = ItemCount - 1 To pos270 Step - 1
1726 Call OutOneElem (i, Angles (i, 0), Angles (i, 1))
1727 Next i
1728 Else
1729
1730 i% = pos90 - 1
1731 If (i <0) Then i = ItemCount - 1
1732
1733 Call OutOneElem (Item270, Angles (Item270, 0), Angles (Item270, 1), mode270begin)
1734
1735 Do While (i <> Item270)
1736 Call OutOneElem (i, Angles (i, 0), Angles (i, 1))
1737
1738 i = i - 1
1739 If (i <0) Then i = ItemCount - 1
1740 Loop
1741
1742 Call OutOneElem (Item270, Angles (Item270, 0), Angles (Item270, 1), mode270end)
1743
1744 End If
1745 End With
1746End Sub
1747
1748 'малювання лінійної, точкового і стовпчастої діаграм
1749Sub DrawPoint ()
1750 Dim d3DX%
1751 Dim d3DY%
1752 Dim OldX%, OldY% 'координати попередньої точки
1753
1754 ItemCount = UBound (DiagData) + 1
1755 ChartHeight = Chart. Height * 0.8
1756 ChartTop = Chart. Height * 0.1
1757 ChartDown = Chart. Height * 0.9
1758
1759 With Chart
1760 dWidth = Chart. Width / (2 * ItemCount + 1)
1761
1762 Max = - 1
1763 Sum = 0
1764 For i% = 1 To ItemCount
1765 If (DiagData (i - 1). Val> Max) Then Max = DiagData (i - 1). Val
1766 Sum = Sum + DiagData (i - 1). Val
1767 Next i
1768
1769 dHeight = ChartHeight / Max
1770
1771 d3DX = Screen. TwipsPerPixelX
1772 d3DY = Screen. TwipsPerPixelY
1773
1774 With Chart
1775. DrawWidth = 1
1776. DrawStyle = 3
1777 Chart. Line (dWidth * 0.9, ChartTop \ 2) - (dWidth * 0.9, ChartDown), LineColor
1778 Chart. Line (dWidth * 0.9, ChartDown) - ((2 * ItemCount + 0.5) * dWidth, ChartDown), LineColor
1779. DrawStyle = 0
1780
1781. FontSize =. FontSize + 3
1782. FontUnderline = True
1783
1784. CurrentX = 2 * d3DX
1785. CurrentY = 2 * d3DY
1786 Chart. Print "Значення"
1787
1788 str_ $ = "Підписи"
1789. CurrentX =. Width -. TextWidth (str_) - 10 * d3DX
1790. CurrentY = ChartDown +. TextHeight (str_)
1791 Chart. Print str_
1792
1793. FontSize =. FontSize - 3
1794. FontUnderline = False
1795 End With
1796
1797
1798 For i% = 1 To ItemCount
1799 j% = 2 * i - 1
1800 Dim y #, x #
1801 y = ChartTop + dHeight * (Max - DiagData (i - 1). Val)
1802
1803 Select Case DrawingMode
1804 Case 0 '/ / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / ЛІНІЇ / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / /
1805 x # = (j + 0.5) * dWidth
1806
1807 If (i> 1) Then
1808 Chart. DrawWidth = LineWidth
1809 Chart. Line (OldX, OldY) - (x, y), DiagData (i - 1). Color
1810 Chart. DrawWidth = 1
1811 End If
1812 Chart. DrawStyle = 1
1813 Chart. Line (x, y) - (x, ChartDown), DiagData (i - 1). Color
1814 Chart. DrawStyle = 0
1815 OldX = x
1816 OldY = y
1817
1818 str_ $ = CStr (DiagData (i - 1). Text)
1819 Chart. CurrentX = j * dWidth + (dWidth - Chart. TextWidth (str_)) \ 2
1820 Chart. CurrentY = ChartDown + Chart. TextHeight (str_) \ 10
1821 Chart. Print str_
1822
1823 str_ = CStr (Round (DiagData (i - 1). Val / Sum * 100)) + "%"
1824 Chart. CurrentX = j * dWidth + (dWidth - Chart. TextWidth (str_)) \ 2
1825 Chart. CurrentY = y - Chart. TextHeight (str_) * 1.2
1826 Chart. Print str_
1827
1828 'значення зліва з зарубкою і лінією
1829 str_ = CStr (DiagData (i - 1). Val)
1830 If UseLineLeftValues Then
1831 Chart. CurrentX = dWidth * 0.8 - Chart. TextWidth (str_)
1832 Chart. DrawStyle = 2
1833 Chart. Line (dWidth * 0.9, y) - (x, y), LineColor
1834 Chart. DrawStyle = 0
1835 End If
1836
1837 Chart. DrawWidth = 2
1838 Chart. Line (dWidth * 0.85, y) - (dWidth * 0.95, y), LineColor
1839 Chart. DrawWidth = 1
1840 x # = dWidth * 0.8 - Chart. TextWidth (str_)
1841 Chart. CurrentX = x
1842 Chart. CurrentY = y - Chart. TextHeight (str_) \ 2
1843 Chart. Print str_
1844
1845 Case 1 '/ / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / КОЛОНКИ / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / /
1846 If (Not Use3D) Then
1847 Chart. Line (j * dWidth, y) - ((j + 1) * dWidth, ChartDown), DiagData (i - 1). Color, BF
1848 Chart. Line (j * dWidth, y) - ((j + 1) * dWidth, ChartDown), LineColor, B
1849
1850 str_ = CStr (DiagData (i - 1). Text)
1851 Chart. CurrentX = j * dWidth + (dWidth - Chart. TextWidth (str_)) \ 2
1852 Chart. CurrentY = ChartDown + Chart. TextHeight (str_) \ 10
1853 Chart. Print str_
1854
1855 str_ = CStr (Round (DiagData (i - 1). Val / Sum * 100)) + "%"
1856 Chart. CurrentX = j * dWidth + (dWidth - Chart. TextWidth (str_)) \ 2
1857 Chart. CurrentY = y - Chart. TextHeight (str_) * 1.2
1858 Chart. Print str_
1859
1860 'значення зліва з зарубкою і лінією
1861 str_ = CStr (DiagData (i - 1). Val)
1862 If UseLineLeftValues Then
1863 Chart. CurrentX = dWidth * 0.8 - Chart. TextWidth (str_)
1864 Chart. DrawStyle = 2
1865 Chart. Line (dWidth * 0.9, y) - (j * dWidth, y), LineColor
1866 Chart. DrawStyle = 0
1867 End If
1868
1869 x # = dWidth * 0.8 - Chart. TextWidth (str_)
1870 Chart. CurrentX = x
1871 Chart. CurrentY = y - Chart. TextHeight (str_) \ 2
1872 Chart. Print str_
1873 Chart. CurrentX = x
1874 Chart. CurrentY = y
1875 Chart. DrawWidth = 2
1876 Chart. Line (dWidth * 0.85, y) - (dWidth * 0.95, y), LineColor
1877 Chart. DrawWidth = 1
1878 Else
1879 For k% = 0 To d3D - 1
1880 Chart. Line (j * dWidth + k * d3DX, y - k * d3DY) - ((j + 1) * dWidth + k * d3DX, ChartDown - k * d3DY), DiagData (i - 1). Color, B
1881 Next k
1882 Chart. Line (j * dWidth, y) - ((j + 1) * dWidth, ChartDown), DiagData (i - 1). Color, BF
1883 'верхня ліва в глибині
1884 ltdx% = j * dWidth + (d3D - 1) * d3DX
1885 ltdy% = y - (d3D - 1) * d3DY
1886 'верхня права у глибині
1887 rtdx% = (j + 1) * dWidth + (d3D - 1) * d3DX
1888 rtdy% = y - (d3D - 1) * d3DY
1889 'нижня права в глибині
1890 rddx% = (j + 1) * dWidth + (d3D - 1) * d3DX
1891 rddy% = ChartDown - (d3D - 1) * d3DY
1892 'верхня в глибині
1893 Chart. Line (rtdx, rtdy) - (rddx, rddy), LineColor
1894 'права в глибині
1895 Chart. Line (ltdx, ltdy) - (rtdx, rtdy), LineColor
1896
1897 'ліва перехідна
1898 Chart. Line (ltdx, ltdy) - (ltdx - d3D * d3DX, ltdy + d3D * d3DY), LineColor
1899 'права верхня перехідна
1900 Chart. Line (rtdx, rtdy) - (rtdx - d3D * d3DX, rtdy + d3D * d3DY), LineColor
1901 'права нижня перехідна
1902 Chart. Line (rddx, rddy) - (rddx - d3D * d3DX, rddy + d3D * d3DY), LineColor
1903 Chart. Line (j * dWidth, y) - ((j + 1) * dWidth, ChartDown), LineColor, B
1904
1905 'напис внизу
1906 str_ = CStr (DiagData (i - 1). Text)
1907 Chart. CurrentX = j * dWidth + (dWidth - Chart. TextWidth (str_)) \ 2
1908 Chart. CurrentY = ChartDown + Chart. TextHeight (str_) \ 10
1909 Chart. Print str_
1910 'відсоток вгорі
1911 str_ = CStr (Round (DiagData (i - 1). Val / Sum * 100)) + "%"
1912 Chart. CurrentX = d3D * d3DX + j * dWidth + (dWidth - Chart. TextWidth (str_)) \ 2
1913 Chart. CurrentY = y - d3D * d3DY - Chart. TextHeight (str_) * 1.2
1914 Chart. Print str_
1915 'значення зліва з зарубкою і лінією
1916 str_ = CStr (DiagData (i - 1). Val)
1917 If UseLineLeftValues Then
1918 Chart. CurrentX = dWidth * 0.8 - Chart. TextWidth (str_)
1919 Chart. DrawStyle = 2
1920 Chart. Line (dWidth * 0.9, y) - (j * dWidth, y), LineColor
1921 Chart. DrawStyle = 0
1922 End If
1923
1924 x # = dWidth * 0.8 - Chart. TextWidth (str_)
1925 Chart. CurrentX = x
1926 Chart. CurrentY = y - Chart. TextHeight (str_) \ 2
1927 Chart. Print str_
1928 Chart. CurrentX = x
1929 Chart. CurrentY = y
1930 Chart. DrawWidth = 2
1931 Chart. Line (dWidth * 0.85, y) - (dWidth * 0.95, y), LineColor
1932 Chart. DrawWidth = 1
1933 End If
1934
1935 Case 2 '/ / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / ТОЧКИ / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / /
1936 Chart. FillStyle = 0
1937 Chart. FillColor = DiagData (i - 1). Color
1938 x # = (j + 0.5) * dWidth
1939 Chart. Circle (x, y), PointRadius * d3DX, LineColor
1940 Chart. FillStyle = 1
1941 Chart. DrawStyle = 1
1942 Chart. Line (x, y) - (x, ChartDown), DiagData (i - 1). Color
1943 Chart. DrawStyle = 0
1944
1945 str_ = CStr (DiagData (i - 1). Text)
1946 Chart. CurrentX = j * dWidth + (dWidth - Chart. TextWidth (str_)) \ 2
1947 Chart. CurrentY = ChartDown + Chart. TextHeight (str_) \ 10
1948 Chart. Print str_
1949
1950 str_ = CStr (Round (DiagData (i - 1). Val / Sum * 100)) + "%"
1951 Chart. CurrentX = j * dWidth + (dWidth - Chart. TextWidth (str_)) \ 2
1952 Chart. CurrentY = y - PointRadius * d3D - Chart. TextHeight (str_) * 1.2
1953 Chart. Print str_
1954
1955 'значення зліва з зарубкою і лінією
1956 str_ = CStr (DiagData (i - 1). Val)
1957 Chart. CurrentX = dWidth * 0.8 - Chart. TextWidth (str_)
1958 Chart. DrawStyle = 2
1959 Chart. Line (dWidth * 0.9, y) - (x, y), LineColor
1960 Chart. DrawStyle = 0
1961
1962 Chart. DrawWidth = 2
1963 Chart. Line (dWidth * 0.85, y) - (dWidth * 0.95, y), LineColor
1964 Chart. DrawWidth = 1
1965 x # = dWidth * 0.8 - Chart. TextWidth (str_)
1966 Chart. CurrentX = x
1967 Chart. CurrentY = y - Chart. TextHeight (str_) \ 2
1968 Chart. Print str_
1969 End Select
1970 Next i
1971
1972 End With
1973End Sub
1974
1975Sub DrawDiagram ()
1976 If (Chart. Height> Screen. TwipsPerPixelX * 5) And (UseColorFill) Then
1977 Call ColorFill (Chart, StartFillColor, EndFillColor)
1978 Else
1979 Chart. Line (0, 0) - (Chart. Width, Chart. Height), StartFillColor, BF
1980 End If
1981
1982 Select Case DrawingMode
1983 Case 3: Call DrawCircle
1984 Case Else: Call DrawPoint
1985 End Select
1986End Sub
1987
1988Private Sub Chart_MouseMove (Button As Integer, Shift As Integer, x As Single, y As Single)
1989 If (DrawingMode <> 3) Then
1990 y = Round ((ChartDown - y) * Max / (ChartDown - ChartTop))
1991 Label3. Caption = CStr (y)
1992 End If
1993End Sub
1994
1995Private Sub Form_KeyDown (KeyCode As Integer, Shift As Integer)
1996 If (KeyCode = vbKeyF5) Then Call DrawDiagram
1997End Sub
1998
1999Private Sub Form_Load ()
2000 dW = Width - Chart. Width
2001 dH = Height - Chart. Height
2002 dX = Width - VScroll. Left
2003 dH2 = Height - VScroll. Height
2004 DrawingMode = 0
2005 Use3D = False
2006 LineCount = 100
2007 d3D = 15
2008 StartFillColor = RGB (255, 255, 128)
2009 EndFillColor = RGB (0, 128, 255)
2010 LineColor = 0
2011 LineWidth = 1
2012 Ellipce = 2 / 5
2013 PointRadius = 15
2014
2015 UseColorFill = True
2016 UseCircleLegend = True
2017 UseLineLeftValues = True
2018
2019 ChartHeight = Chart. Height * 0.85
2020 ChartWidth = Chart. Width * 0.85
2021 ChartTop = Chart. Height * 0.075
2022 ChartDown = Chart. Height * 0.925
2023 If (ChartWidth <ChartHeight) Then Radius = ChartWidth Else Radius = ChartHeight
2024 Radius = Radius * 0.5
2025 InRad = 0.1 * Radius
2026End Sub
2027
2028Private Sub Form_Resize ()
2029 Min% = Width - dW + 5 * Screen. TwipsPerPixelX
2030 If (Min <0) Then Min = 0
2031 Chart. Width = Min
2032
2033 Min% = Height - dH + Screen. TwipsPerPixelY
2034 If (Min <0) Then Min = 0
2035 Chart. Height = Min
2036
2037 VScroll. Left = Width - dX
2038
2039 Min% = Height - dH2 + Screen. TwipsPerPixelY
2040 If (Min <0) Then Min = 0
2041 VScroll. Height = Min
2042
2043 Call DrawDiagram
2044End Sub
2045
2046Private Sub Image1_Click ()
2047 CD. FileName = ""
2048 CD. ShowSave
2049 If (CD. FileName <> "") Then
2050 Call SavePicture (Chart. Image, CD. FileName)
2051 End If
2052End Sub
2053
2054Private Sub Image2_Click ()
2055 With DiagOptForm
2056 'кольору
2057. Frame2 (0). BackColor = StartFillColor
2058. Frame2 (1). BackColor = EndFillColor
2059. Frame2 (2). BackColor = Chart. ForeColor
2060. Frame2 (3). BackColor = LineColor
2061 'розміри
2062. UpDown1. value = LineWidth
2063. UpDown2. value = d3D
2064. UpDown3. value = PointRadius
2065. UpDown4. value = LineCount
2066. UpDown5. value = Round (Ellipce * 100)
2067
2068. UpDown6. Max = Chart. Width
2069 If (Chart. Height <Chart. Width) Then. UpDown6. Max = Chart. Width
2070. UpDown6. Max = Round (. UpDown6. Max / Screen. TwipsPerPixelX)
2071. UpDown6. value = Round (Radius / Screen. TwipsPerPixelX)
2072
2073. UpDown7. Max =. UpDown6. Max * 0.9
2074. UpDown7. value = Round (InRad / Screen. TwipsPerPixelX)
2075
2076 'кольори і написи
2077. List1. Clear
2078 For i% = 1 To ItemCount
2079. List1. AddItem (DiagData (i - 1). Text)
2080. List1. ItemData (i - 1) = DiagData (i - 1). Color
2081 Next i
2082 If (. List1. ListCount> 0) Then. List1. ListIndex = 0
2083
2084 'прапори
2085. Check1. value = - CInt (UseColorFill)
2086. Check3. value = - CInt (UseCircleLegend)
2087. Check2. value = - CInt (UseLineLeftValues)
2088
2089. Show vbModal
2090 If (. Res = 1) Then
2091 'кольору
2092 StartFillColor =. Frame2 (0). BackColor
2093 EndFillColor =. Frame2 (1). BackColor
2094 Chart. ForeColor =. Frame2 (2). BackColor
2095 LineColor =. Frame2 (3). BackColor
2096 'розміри
2097 LineWidth =. UpDown1. value
2098 d3D =. UpDown2. value
2099 PointRadius =. UpDown3. value
2100 LineCount =. UpDown4. value
2101 Ellipce =. UpDown5. value / 100
2102 Radius =. UpDown6. value * Screen. TwipsPerPixelX
2103 InRad =. UpDown7. value * Screen. TwipsPerPixelX
2104 'кольори і написи
2105 For i% = 1 To ItemCount
2106 DiagData (i - 1). Text =. List1. List (i - 1)
2107 DiagData (i - 1). Color =. List1. ItemData (i - 1)
2108 Next i
2109 'прапори
2110 UseColorFill = (. Check1. Value = 1)
2111 UseCircleLegend = (. Check3. Value = 1)
2112 UseLineLeftValues = (. Check2. Value = 1)
2113 Call DrawDiagram
2114 End If
2115 End With
2116End Sub
2117
2118Private Sub Image3_Click ()
2119 Hide
2120End Sub
2121
2122Private Sub VScroll_Change ()
2123 Ellipce = VScroll. value / 100
2124 Call DrawDiagram
2125End Sub
Форма: InputForm. frm
2126Dim res%
2127
2128Private Sub CancelBut_Click ()
2129 Call SoundClick
2130 Hide
2131End Sub
2132
2133Private Sub Form_Activate ()
2134 Text1. SetFocus
2135End Sub
2136
2137Private Sub Form_KeyDown (KeyCode As Integer, Shift As Integer)
2138 Select Case KeyCode
2139 Case 13: Call YesBut_Click
2140 Case 27: Call CancelBut_Click
2141 End Select
2142End Sub
2143
2144Private Sub Form_Load ()
2145 Call ButEnabled (YesImg, YesBut, True)
2146 Call ButEnabled (CancelImg, CancelBut, True)
2147End Sub
2148
2149Public Function InputVal (str $) As String
2150 Label1. Caption = str
2151 Text1. Text = ""
2152 res = 0
2153 Me. Show vbModal
2154 If (res = 1) Then InputVal = Text1. Text
2155 Unload Me
2156End Function
2157
2158Private Sub YesBut_Click ()
2159 Call SoundClick
2160 res = 1
2161 Hide
2162End Sub
Форма: DiagOpt. frm
2163Public res%
2164
2165Private Sub Form_Load ()
2166 res = 0
2167 Call ButEnabled (SelectImg, SelectBut, True)
2168 Call ButEnabled (CancelImg, CancelBut, True)
2169End Sub
2170
2171Private Sub Form_Paint ()
2172 Call DiagResForm. ColorFill (Picture1, Frame2 (0). BackColor, Frame2 (1). BackColor)
2173End Sub
2174
2175Private Sub Frame2_Click (Index As Integer)
2176 ColorDlg. Color = Frame2 (Index). BackColor
2177 ColorDlg. ShowColor
2178 Frame2 (Index). BackColor = ColorDlg. Color
2179 If (Index <2) Then Call DiagResForm. ColorFill (Picture1, Frame2 (0). BackColor, Frame2 (1). BackColor)
2180 If (Index = 4) Then List1. ItemData (List1. ListIndex) = Frame2 (4). BackColor
2181End Sub
2182
2183Private Sub Label10_Click ()
2184 res = 1
2185 Hide
2186End Sub
2187
2188Private Sub Label15_Click ()
2189 Hide
2190End Sub
2191
2192Private Sub List1_Click ()
2193 If (List1. ListIndex> - 1) Then
2194 Text1. Text = List1. List (List1. ListIndex)
2195 Frame2 (4). BackColor = List1. ItemData (List1. ListIndex)
2196 End If
2197End Sub
2198
2199Private Sub List1_KeyPress (KeyAscii As Integer)
2200 Call List1_Click
2201End Sub
2202
2203Private Sub Text1_KeyDown (KeyCode As Integer, Shift As Integer)
2204 If (KeyCode = 13) Then
2205 List1. List (List1. ListIndex) = Text1. Text
2206 List1. ItemData (List1. ListIndex) = Frame2 (4). BackColor
2207 End If
2208End Sub
Форма: SplashScreenForm. frm
2209Private Sub Form_KeyDown (KeyCode As Integer, Shift As Integer)
2210 If (KeyCode = 27) Or (KeyCode = 13) Then
2211 MainForm. Show
2212 Unload Me
2213 End If
2214End Sub
2215
2216Private Sub Form_Load ()
2217 Label2. Caption = "v." + CStr (App. Major) + "." + CStr (App. Minor)
2218End Sub
2219
2220Private Sub Picture1_MouseDown (Button As Integer, Shift As Integer, x As Single, y As Single)
2221 Call MDown (x, y)
2222End Sub
2223
2224Private Sub Picture1_MouseMove (Button As Integer, Shift As Integer, x As Single, y As Single)
2225 Call MMove (hwnd, x, y)
2226End Sub
2227
2228Private Sub Picture1_MouseUp (Button As Integer, Shift As Integer, x As Single, y As Single)
2229 Call MUp
2230End Sub
Форма: MonthForm. frm
2231Public res%
2232
2233Private Sub CancelBut_Click ()
2234 Hide
2235End Sub
2236
2237Private Sub EditBut_Click ()
2238 res = - 1
2239 Hide
2240End Sub
2241
2242Private Sub Form_Load ()
2243 Call ButEnabled (YesImg, YesBut, True)
2244 Call ButEnabled (EditImg, EditBut, True)
2245 Call ButEnabled (CancelImg, CancelBut, True)
2246 res = 0
2247End Sub
2248
2249Private Sub YesBut_Click ()
2250 res = 1
2251 Hide
2252End Sub
Модуль: DBTypes. bas
2253'************************************
2254 'модуль DBTypes. bas
2255 'вся робота з файлом БД
2256'************************************
2257
2258'************************************** Опис типів ******** ******************************
2259
2260 'заголовок файлу
2261Type TDBHeader
2262 '"DBX" - перевірка файлу
2263 Header As String * 3
2264 'прапори
2265 Flags As Byte
2266 'кількість полів
2267 ColCount As Long
2268 'кількість записів
2269 RowCount As Long
2270End Type
2271
2272 'має користувач права на редагування
2273Public UserIsAdmin As Boolean
2274
2275 'дані про стовпці
2276Type TDBElemData
2277 'тип даних
2278 Class As Byte
2279 'довжина заголовка
2280 TitleLen As Byte
2281 'заголовок, довжини TitleLen
2282 title As String
2283 'значення по-замовчуванню
2284 DefValue As Variant
2285End Type
2286
2287 'запис
2288Type TDBElem
2289 'поля запису
2290 Fields () As Variant
2291End Type
2292
2293 'елемент у масиві DB
2294Type TDBCell
2295 Header As TDBHeader
2296 Cols () As TDBElemData
2297 Rows () As TDBElem
2298 Password As String
2299End Type
2300
2301'************************************** Опис констант ******** ******************************
2302
2303 'контрольний байт
2304Public Const ValidateByte As Byte = & H7F
2305
2306'************************************** Опис змінних ******** ******************************
2307
2308 'шлях до БД
2309Public DBPath $
2310 'прапор зміни БД
2311Public DBChanged As Boolean
2312 'дані таблиць: кожен елемент - це копія деякої таблиці
2313Public DB () As TDBCell
2314
2315'************************************** Процедури і функції ******* *******************************
2316
2317 'видалення поля
2318Public Sub DelCol_ (DBIndex%, Optional ByVal Index% = - 1, Optional ByVal conf As Boolean = True)
2319 With DB (DBIndex). Header
2320 If (. ColCount = 0) Then Exit Sub
2321 If (Index = - 1) Then Index =. ColCount - 1
2322 If (Index>. ColCount - 1) Or (Index <- 1) Then
2323 Call MsgForm. ErrorMsg ("Помилка видалення стовпця!")
2324 Exit Sub
2325 End If
2326
2327 If conf Then
2328 If (MsgForm. QuestMsg ("Видалити стовпець?") <> ResOk) Then Exit Sub
2329 End If
2330 'вирізаю з полів
2331 For i% = Index To (. ColCount - 2)
2332 DB (DBIndex). Cols (i) = DB (DBIndex). Cols (i + 1)
2333 Next i
2334 'вирізаю із записів
2335 For R% = 0 To (. RowCount - 1)
2336 For c% = Index To (. ColCount - 2)
2337 DB (DBIndex). Rows (R). Fields (c) = DB (DBIndex). Rows (R). Fields (c + 1)
2338 Next c
2339 Next R
2340
2341. ColCount =. ColCount - 1
2342 ReDim Preserve DB (DBIndex). Cols (. ColCount)
2343 DBChanged = True
2344End With
2345End Sub
2346
2347 'видалення запису
2348Public Sub DelRow_ (DBIndex%, Optional ByVal Index% = - 1, Optional ByVal conf As Boolean = True)
2349 With DB (DBIndex). Header
2350 If (. RowCount = 0) Then Exit Sub
2351 If (Index = - 1) Then Index =. RowCount - 1
2352 If (Index>. RowCount - 1) Then
2353 Call MsgForm. ErrorMsg ("Помилка видалення запису!")
2354 Exit Sub
2355 End If
2356
2357 If conf Then
2358 If (MsgForm. QuestMsg ("Видалити запис?") = ResNo) Then Exit Sub
2359 End If
2360 For i% = Index To (. RowCount - 2)
2361 DB (DBIndex). Rows (i) = DB (DBIndex). Rows (i + 1)
2362 Next i
2363. RowCount =. RowCount - 1
2364 ReDim Preserve DB (DBIndex). Rows (. RowCount)
2365 DBChanged = True
2366End With
2367End Sub
2368
2369Public Sub TestDBChanged ()
2370 If DBChanged Then
2371 MainForm. SB. Panels (1). Picture = MainForm. ImageList1. ListImages (2). Picture
2372 Else
2373 Set MainForm. SB. Panels (1). Picture = Nothing
2374 End If
2375End Sub
2376
2377 'відображення таблиці
2378Public Sub ShowTable (DBIndex%)
2379 MainForm. ListView. ListItems. Clear
2380 MainForm. ListView. ColumnHeaders. Clear
2381 If (DBIndex = - 1) Then
2382 DBPath = ""
2383 MainForm. SB. Panels (3). Text = ""
2384 GoTo exit_
2385 End If
2386 If (DB (DBIndex). Header. ColCount = 0) Then GoTo exit_
2387 For c% = 0 To DB (DBIndex). Header. ColCount - 1
2388 Call MainForm. ListView. ColumnHeaders. Add (_
2389 MainForm. ListView. ColumnHeaders. Count + 1, _
2390 "col_key_" + CStr (c), _
2391 DB (DBIndex). Cols (c). title, _
2392 1440, _
2393 lvwColumnLeft, _
2394 0 _
2395)
2396
2397 Next c
2398 For R% = 0 To DB (DBIndex). Header. RowCount - 1
2399 With MainForm. ListView. ListItems. Add
2400. Key = "row_key_" + CStr (R)
2401. Text = DB (DBIndex). Rows (R). Fields (0)
2402 For i% = 1 To DB (DBIndex). Header. ColCount - 1
2403. SubItems (i) = DB (DBIndex). Rows (R). Fields (i)
2404 Next i
2405 End With
2406 Next R
2407exit_:
2408 MainForm. TabStrip. Visible = (DBPath <> "")
2409 MainForm. ListView. Visible = MainForm. TabStrip. Visible
2410 If (DBIndex <> - 1) Then
2411 MainForm. SB. Panels (2). Text = CStr (DB (DBIndex). Header. RowCount)
2412 Else
2413 MainForm. SB. Panels (2). Text = ""
2414 End If
2415 Call TestDBChanged
2416End Sub
2417
2418 'пошук поля ********************************************** ***
2419Public Function ItColAlreadyCreate (QRDBIndex%, title $) As Boolean
2420 With DB (QRDBIndex)
2421 For i% = 0 To (DB (QRDBIndex). Header. ColCount - 1)
2422 If (. Cols (i). Title = title) Then
2423 ItColAlreadyCreate = True
2424 Exit Function
2425 End If
2426 Next i
2427 End With
2428 ItColAlreadyCreate = False
2429End Function
2430
2431 'додавання поля ********************************************** ***
2432Public Sub AddCol (DBIndex%, ByVal Class%, ByVal title $, ByVal defval, Optional ByVal pos% = - 1)
2433 With DB (DBIndex). Header
2434 ReDim Preserve DB (DBIndex). Cols (. ColCount)
2435 If (pos = - 1) Then
2436 pos =. ColCount
2437 Else
2438 For i% = 1 To (. ColCount - pos)
2439 DB (DBIndex). Cols (. ColCount - i + 1) = DB (DBIndex). Cols (. ColCount - i)
2440 Next i
2441 End If
2442 With DB (DBIndex). Cols (pos)
2443. Class = Class
2444. title = title
2445. TitleLen = Len (title)
2446. DefValue = defval
2447 End With
2448
2449 'збільшую розмірність записів
2450 For R% = 0 To DB (DBIndex). Header. RowCount - 1
2451 ReDim Preserve DB (DBIndex). Rows (R). Fields (. ColCount)
2452 For i% = 1 To (. ColCount - pos)
2453 DB (DBIndex). Rows (R). Fields (. ColCount - i + 1) = DB (DBIndex). Rows (R). Fields (. ColCount - i)
2454 Next i
2455 DB (DBIndex). Rows (R). Fields (pos) = DB (DBIndex). Cols (pos). DefValue
2456 Next R
2457
2458. ColCount =. ColCount + 1
2459
2460 DBChanged = True
2461 End With
2462End Sub
2463
2464 'додавання запису ********************************************** ***
2465Public Sub AddField (DBIndex%, row)
2466 With DB (DBIndex). Header
2467 ReDim Preserve DB (DBIndex). Rows (. RowCount)
2468 DB (DBIndex). Rows (. RowCount). Fields = row
2469. RowCount =. RowCount + 1
2470 DBChanged = True
2471 End With
2472End Sub
2473
2474 'видалення таблиці ********************************************** ***
2475Public Sub DelTable (Index%)
2476 For i% = Index To (UBound (DB) - 1)
2477 DB (i) = DB (i + 1)
2478 Next i
2479 If (UBound (DB)> 0) Then ReDim Preserve DB (UBound (DB) - 1)
2480End Sub
2481
2482 'якщо потрібно то рядок шифрується за паролем, інакше не змінюється
2483Function CodeDecode (Index%, str $, col%, row%, Optional pass $ = "", Optional usepass As Boolean = False) As String
2484 If Not usepass Then pass $ = DB (Index). Password
2485 If (pass = "") Then
2486 CodeDecode = str
2487 Exit Function
2488 End If
2489 CodeDecode = ""
2490 p% = 1
2491 Dim ch As Byte
2492 For i% = 1 To Len (str)
2493 ch = Asc (Mid (str, i, 1)) Xor Asc (Mid (pass, p, 1)) Xor col Xor row
2494 CodeDecode = CodeDecode + Chr (ch)
2495 p = p + 1: If p> Len (pass) Then p = 1
2496 Next i
2497End Function
2498
2499 'збереження БД у файлі ******************************************** *****
2500Public Sub FlushDB (DBIndex%)
2501 Dim s $, W%
2502 If Not UserIsAdmin Then
2503 Call ProtectedMsg
2504 Exit Sub
2505 End If
2506 If (DBPath <> "") Then
2507 Call DeleteFile (DBPath)
2508 DBI% = FreeFile
2509 Open DBPath For Binary As DBI
2510
2511 'заголовок - 12
2512 Put DBI,, DB (DBIndex). Header
2513
2514 'якщо треба, то зберігаю пароль
2515 If (DB (DBIndex). Header. Flags And flPasswordNeed) Then
2516 Dim str $, ch1 As Byte, ch2 As Byte
2517 Dim lng As Byte, lng2 As Byte
2518 lng = Len (DB (DBIndex). Password)
2519 lng2 = lng / 2
2520 Put DBI,, lng
2521
2522 For i% = 1 To lng2
2523 ch1 = Asc (Mid (DB (DBIndex). Password, i, 1))
2524 ch2 = Asc (Mid (DB (DBIndex). Password, lng - i + 1, 1))
2525 str = Chr (ch1 Xor ch2) + str
2526 Next i
2527 For i = lng2 To 1 Step - 1
2528 Put DBI,, CByte (Asc (Mid (str, i, 1)))
2529 Next i
2530 End If 'збереження пароля
2531
2532 'дані полів
2533 Dim l As Long
2534 For i% = 0 To DB (DBIndex). Header. ColCount - 1
2535 Put DBI,, DB (DBIndex). Cols (i). Class
2536 Put DBI,, DB (DBIndex). Cols (i). TitleLen
2537 If (DB (Index). Header. Flags And flCoded) Then
2538 Put DBI,, CodeDecode (DBIndex, DB (DBIndex). Cols (i). Title, i, 0)
2539 Else
2540 Put DBI,, DB (DBIndex). Cols (i). title
2541 End If
2542 Select Case DB (DBIndex). Cols (i). Class
2543 Case ccString
2544 If (DB (Index). Header. Flags And flCoded) Then
2545 s = CodeDecode (DBIndex, CStr (DB (DBIndex). Cols (i). DefValue), i, 0)
2546 Else
2547 s = CStr (DB (DBIndex). Cols (i). DefValue)
2548 End If
2549 W = Len (s)
2550 Put DBI,, W
2551 Put DBI,, s
2552 Case ccInteger
2553 l = CInt (DB (DBIndex). Cols (i). DefValue)
2554 Put DBI,, l
2555 End Select
2556 Next i
2557
2558 'запис контрольного байта
2559 Put DBI,, ValidateByte
2560
2561 'запису
2562 Dim f As TDBElem
2563 Dim col As TDBElemData
2564 For R% = 0 To DB (DBIndex). Header. RowCount - 1
2565 f = DB (DBIndex). Rows (R)
2566 For c% = 0 To DB (DBIndex). Header. ColCount - 1
2567 col = DB (DBIndex). Cols (c)
2568 'в залежності від типу даних колонки пишу в файл певний тип даних
2569 Select Case col. Class
2570 'якщо число - записую як long
2571 Case ccInteger
2572 l = CLng (f. Fields (c))
2573 Put DBI,, l
2574 'якщо рядок - то байт довжини і сам рядок
2575 Case ccString
2576 If (DB (Index). Header. Flags And flCoded) Then
2577 s = CodeDecode (DBIndex, CStr (f. Fields (c)), c, R)
2578 Else
2579 s = CStr (f. Fields (c))
2580 End If
2581 'Len повертає 4 байти, а мені потрібно 2
2582 W = Len (s)
2583 Put DBI,, W
2584 Put DBI,, s
2585 End Select
2586 Next c
2587 Next R
2588
2589 MainForm. SB. Panels (3). Text = DBPath
2590 Call MsgForm. InfoMsg ("БД збережена!")
2591
2592 'закриття файлу
2593 Close
2594 DBChanged = False
2595 Call TestDBChanged
2596 End If
2597End Sub
2598
2599 'завантаження БД ********************************************** ***
2600Public Function LoadDB (DBIndex%, ByVal Path $) As Boolean
2601 Dim DBH As TDBHeader
2602 pwrd $ = ""
2603 LoadDB = False
2604 DBI% = FreeFile
2605 DBP $ = Path
2606 'відкриваю БД
2607 Open DBP For Binary As DBI
2608 'зчитую заголовок
2609 Get DBI,, DBH
2610 With DBH
2611 If (. Header <> "DBX") Then
2612 Call MsgForm. ErrorMsg ("БД пошкоджена!")
2613 GoTo Notdata
2614 End If
2615
2616 'якщо треба, то завантажую пароль
2617 If (DBH. Flags And flPasswordNeed) Then
2618 Dim lng As Byte
2619 Get DBI,, lng
2620 Dim str $, ch1 As Byte, ch2 As Byte, ch3 As Byte
2621 str = ""
2622 For i% = 1 To lng \ 2
2623 Get DBI,, ch1
2624 str = str + Chr (ch1)
2625 Next i
2626'************************************************ ********
2627 With PasswordForm
2628. PassText = ""
2629
2630. CaptionLabel = "Захист БД"
2631. TextLabel = "Відкривати БД захищена паролем. Для роботи з БД необхідно ввести пароль."
2632. Frame2. Visible = False
2633. Frame1. Visible = True
2634
2635 Dim ROE As Boolean
2636
2637 ROE = Not ((DBH. Flags And flReadOnlyEnable) = flReadOnlyEnable)
2638
2639 If ROE Then
2640. Frame3. Visible = True
2641. NoFullLabel. Visible = False
2642 Else
2643. Frame3. Visible = False
2644. NoFullLabel. Visible = True
2645 End If
2646. Show vbModal
2647 If (. Res) Then
2648 'допустимий тип доступу
2649 Mode% = 0
2650 'введений пароль
2651 str2 $ = Trim (. PassText)
2652
2653 'перевірка пароля
2654 lng_2 = Len (str2)
2655 If (lng_2 <> lng) Then
2656 Mode = - 1
2657 GoTo bad
2658 End If
2659 For i% = 1 To lng \ 2
2660 ch1 = Asc (Mid (str2, i, 1))
2661 ch2 = Asc (Mid (str2, lng - i + 1, 1))
2662 ch3 = Asc (Mid (str, i, 1))
2663 If ((ch1 Xor ch2) <> ch3) Then
2664 Mode = - 1
2665 GoTo bad
2666 End If
2667 Next i
2668
2669bad:
2670 'обробка правильності пароля та рівня доступу
2671 If (Mode = 0) And (. Check1 = 0) Then
2672 Call MsgForm. InfoMsg ("Пароль прийнято!")
2673 pwrd = str2
2674 UserIsAdmin = True
2675 Else
2676 If ROE And (. Check1 = 1) Then
2677 Call MsgForm. InfoMsg ("Тільки читання!")
2678 UserIsAdmin = False
2679 Else
2680 Call MsgForm. ErrorMsg ("Пароль не прийнятий! Доступ заборонено!")
2681 Unload PasswordForm
2682 GoTo Notdata
2683 End If
2684 End If
2685 Else
2686 Unload PasswordForm
2687 GoTo Notdata
2688 End If 'if (. Res)
2689 Unload PasswordForm
2690 End With
2691'************************************************ ********
2692 End If
2693
2694 'виділення потрібної пам'яті
2695 If (. ColCount> 0) Then
2696 ReDim DB (DBIndex). Cols (. ColCount - 1)
2697 If (. RowCount> 0) Then
2698 ReDim DB (DBIndex). Rows (. RowCount - 1)
2699 For R% = 0 To. RowCount - 1
2700 ReDim DB (DBIndex). Rows (R). Fields (. ColCount - 1)
2701 Next R
2702 End If
2703 End If
2704
2705 'зчитування даних полів
2706 For i% = 0 To DBH. ColCount - 1
2707 'отримання класу
2708 Get DBI,, DB (DBIndex). Cols (i). Class
2709 'отримання довжини заголовка
2710 Get DBI,, DB (DBIndex). Cols (i). TitleLen
2711 'отримання заголовка
2712 s $ = ""
2713 Dim B As Byte
2714 For j% = 1 To DB (DBIndex). Cols (i). TitleLen
2715 Get DBI,, B
2716 s = s + Chr (B)
2717 Next j
2718 s = CodeDecode (DBIndex, s, i, 0, pwrd, True)
2719 DB (DBIndex). Cols (i). title = s
2720 'отримання стандартних значень
2721 Dim l As Long
2722 Dim W%
2723 Select Case DB (DBIndex). Cols (i). Class
2724 Case ccInteger
2725 Get DBI,, l
2726 DB (DBIndex). Cols (i). DefValue = l
2727 Case ccString
2728 Get DBI,, W
2729 s = ""
2730 For j% = 1 To W
2731 Get DBI,, B
2732 s = s + Chr (B)
2733 Next j
2734 s = CodeDecode (DBIndex, s, i, 0, pwrd, True)
2735 DB (DBIndex). Cols (i). DefValue = s
2736 End Select
2737 Next i
2738
2739 'читання контрольного байта
2740 Dim VB As Byte
2741 Get DBI,, VB
2742 If (VB <> ValidateByte) Then
2743 Call MsgForm. ErrorMsg ("БД пошкоджена!")
2744 GoTo Notdata
2745 End If
2746
2747 'зчитування записів
2748 Dim col As TDBElemData
2749 For R% = 0 To. RowCount - 1
2750 For c% = 0 To. ColCount - 1
2751 col = DB (DBIndex). Cols (c)
2752 'в залежності від типу даних колонки пишу в файл певний тип даних
2753 Select Case col. Class
2754 'якщо число - зчитую як long
2755 Case ccInteger
2756 Get DBI,, l
2757 DB (DBIndex). Rows (R). Fields (c) = l
2758 'якщо рядок - то байт довжини і сам рядок
2759 Case ccString
2760 Get DBI,, W
2761 s = ""
2762 For j% = 1 To W
2763 Get DBI,, B
2764 s = s + Chr (B)
2765 Next j
2766 s = CodeDecode (DBIndex, s, c, R, pwrd, True)
2767 DB (DBIndex). Rows (R). Fields (c) = s
2768 End Select
2769 Next c
2770 Next R
2771
2772 End With
2773 LoadDB = True
2774
2775 DB (DBIndex). Header = DBH
2776 DBPath = DBP
2777 DBChanged = False
2778 DB (DBIndex). Password = pwrd
2779
2780 Call MsgForm. InfoMsg ("БД завантажена!")
2781
2782Notdata:
2783 'закриття файлу
2784 Close
2785End Function
2786
2787 "створення нової БД ********************************************* ****
2788Public Function NewDB (Path $)
2789 DBI% = FreeFile
2790 'видаляю БД
2791 Call DeleteFile (Path)
2792 'відкриваю БД
2793 Open Path For Binary As DBI
2794 'застосовую стандартний заголовок до БД
2795 Call ClearAll
2796 DBPath = Path
2797 'записую заголовок БД
2798 Put DBI,, DB (0). Header
2799 'запис контрольного байта
2800 Put DBI,, ValidateByte
2801 Close
2802 Call MsgForm. InfoMsg ("БД створена з налаштуваннями за замовчуванням!")
2803End Function
2804
2805 'очищення ВСЬОГО
2806Public Sub ClearAll ()
2807 ReDim DB (0)
2808 Call ClearHeader (DB (0). Header)
2809 DBChanged = False
2810 DBPath = ""
2811End Sub
2812
2813 'установка полів в початкові значення ******************************************* ******
2814Public Sub ClearHeader (H As TDBHeader)
2815 H. Header = "DBX"
2816 H. Flags = 0
2817 H. ColCount = 0
2818 H. RowCount = 0
2819End Sub
Модуль: API. bas
2820 "створення файлу
2821Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
2822
2823 "створення архівної копії БД
2824Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
2825
2826 'запуск браузера та поштової програми
2827Public Declare Function ShellExecute Lib "shell32. Dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

2828
2829 'звук
2830Public Declare Function sndPlaySound Lib "winmm. Dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
2831Public Const SND_APPLICATION = & H80
2832Public Const SND_ASYNC = & H1
2833Public Const SND_FILENAME = & H20000
2834
2835 'переміщення вікна та анімація кнопок
2836Public Type RECT
2837 Left As Long
2838 Top As Long
2839 Right As Long
2840 Bottom As Long
2841End Type
2842Public Type POINTAPI
2843 x As Long
2844 y As Long
2845End Type
2846Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
2847Public Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
2848Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
2849Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
2850Public Declare Function PtInRect Lib "user32" (lpRect As RECT, pt As POINTAPI) As Long
2851
2852 'перетягування
2853Dim ClickBool As Boolean
2854Dim Xs%, Ys%
2855
2856Sub MInit ()
2857 ClickBool = False
2858 Xs = 0
2859 Ys = 0
2860End Sub
2861
2862Sub MMove (ByVal Handle As Long, ByVal x%, ByVal y%)
2863 Dim R As RECT
2864 If ClickBool Then
2865 Call GetWindowRect (Handle, R)
2866 W% = R. Right - R. Left
2867 H% = R. Bottom - R. Top
2868 x = R. Left + (x - Xs) / Screen. TwipsPerPixelX
2869 y = R. Top + (y - Ys) / Screen. TwipsPerPixelY
2870 Call MoveWindow (Handle, x, y, W, H, True)
2871 End If
2872End Sub
2873
2874Sub MDown (ByVal x%, ByVal y%)
2875 ClickBool = True
2876 Xs = x
2877 Ys = y
2878End Sub
2879
2880Sub MUp ()
2881 ClickBool = False
2882End Sub
Модуль: DBConst. bas
2883 'результати роботи діалогів з MsgBox
2884Public Const resBad = 0 'вихід, закриттям вікна
2885Public Const resOk = 1 'Так
2886Public Const resNo = 2 'Ні
2887Public Const resCancel = 3 'Скасувати
2888
2889 'константи типів даних
2890Public Const ccInteger As Byte = 0
2891Public Const ccString As Byte = 1
2892
2893 'прапори доступу доступу до БД
2894 'вимагати пароль для входу
2895Public Const flPasswordNeed As Byte = 1
2896 'забороняти доступ на читання без пароля
2897Public Const flReadOnlyEnable As Byte = 2
2898 'зашифрованность даних
2899Public Const flCoded As Byte = 4
2900
2901 'для діаграм
2902Type TDiagElem
2903 Text As String
2904 Val As Integer
2905 Color As Long
2906End Type
2907
2908 "права Тільки читання
2909Public Sub ProtectedMsg ()
2910 Call MsgForm. ErrorMsg ("Недостатньо прав для виконання дії!")
2911End Sub
2912
2913 'звук натискання кнопки
2914Public Sub SoundClick ()
2915 Call sndPlaySound ("Data \ Click. Wav", SND_ASYNC + SND_FILENAME + SND_LOOP + SND_APPLICATION)
2916End Sub
2917
2918Public Function IsInteger (ByVal str $) As Boolean
2919 Dim Arr (1 To 4) As String * 1
2920 Arr (1) = "e": Arr (2) = "E": Arr (3) = ",": Arr (4) = "."
2921 IsInteger = True
2922 If IsNumeric (str) Then
2923 For i% = LBound (Arr) To UBound (Arr)
2924 If (InStr (1, str, Arr (i))> 0) Then
2925 IsInteger = False
2926 Exit For
2927 End If
2928 Next i
2929 Else
2930 IsInteger = False
2931 End If
2932End Function
2933
2934Public Sub ButEnabled (Pict As Image, Lbl As Label, enbl As Boolean)
2935 If enbl Then
2936 Pict. Picture = MainForm. ButtonImageList. ListImages (1). Picture
2937 Lbl. MousePointer = 1
2938 Else
2939 Pict. Picture = MainForm. ButtonImageList. ListImages (2). Picture
2940 Lbl. MousePointer = 12
2941 End If
2942 Lbl. Tag = CInt (enbl)
2943End Sub
Модуль: QueryRunner. bas
2944Public QRDBIndex%
2945
2946'***********************************
2947 'Запити чутливі до регістру!
2948'***********************************
2949
2950 'константи видів запитів
2951 'Обов'язково 3 ЗНАКУ
2952Public Const sAdd $ = "Add"
2953Public Const sDel $ = " Del "
2954Public Const sSort $ = "Srt"
2955Public Const sOut $ = "Out"
2956Public Const sSwap $ = "Swp"
2957Public Const sChange $ = "Chg"
2958
2959 'константи підтипів запитів
2960Public Const sCol $ = "Col"
2961Public Const sRow $ = "Row"
2962Public Const sTable $ = "Tbl" 'тільки для використання в запиті Висновок
2963Public Const sAZ $ = "AZ"
2964Public Const sZA $ = "ZA"
2965Public Const sEqual $ = "? ="
2966Public Const sAbove $ = "?>"
2967Public Const sBelow $ = "? <"
2968Public Const sCountEqual $ = "+ ="
2969Public Const sCountAbove $ = "+>"
2970Public Const sCountBelow $ = "+ <"
2971Public Const sI $ = "i"
2972Public Const sS $ = "s"
2973Public Const sYes $ = "yes"
2974Public Const sNo $ = "no"
2975Public Const sType $ = "Type"
2976Public Const sName $ = "Name"
2977
2978 'інші константи
2979Public Const sSep $ = ";"
2980
2981'************************ Формує рядок додавання 'What' ****************** ******
2982Public Function Generate_Add (ByVal what $) As String
2983 If (what = sCol) Then
2984 s $ = AddColForm. AddColDlg (QRDBIndex)
2985 If (s <> "") Then
2986 Generate_Add = sAdd + sCol + "(" + s + ")"
2987 Else
2988 Generate_Add = ""
2989 End If
2990 Else
2991 Generate_Add = sAdd + sRow + "()"
2992 End If
2993End Function
2994
2995'************************ Формує рядок видалення 'What' ****************** ******
2996Public Function Generate_Del (ByVal what $) As String
2997 With SelectForm. CheckConfirm
2998. value = 1
2999. Visible = True
3000 End With
3001 Dim conf $
3002
3003 If (what = sCol) Then
3004 s $ = SelectForm. SelectDlg (QRDBIndex, "Виберіть видалити поле", sCol)
3005 If (s <> - 1) Then
3006 If (SelectForm. CheckConfirm. Value = 1) Then
3007 conf = sYes
3008 Else
3009 conf = sNo
3010 End If
3011 Generate_Del = sDel + sCol + "(" + s + "," + conf + ")"
3012 Else
3013 Generate_Del = ""
3014 End If
3015 Else
3016 s $ = SelectForm. SelectDlg (QRDBIndex, "Виберіть удаляемую запис", sRow)
3017 If (s <> - 1) Then
3018 If (SelectForm. CheckConfirm. Value = 1) Then
3019 conf = sYes
3020 Else
3021 conf = sNo
3022 End If
3023 Generate_Del = sDel + sRow + "(" + s + "," + conf + ")"
3024 Else
3025 Generate_Del = ""
3026 End If
3027 End If
3028End Function
3029
3030'************************ Формує рядок сортування за 'What' ***************** *******
3031Public Function Generate_Sort (ByVal what $) As String
3032 SelectForm. CheckConfirm. Visible = False
3033
3034 s $ = SelectForm. SelectDlg (QRDBIndex, "Виберіть поле сортування", sCol)
3035 If (s <> - 1) Then
3036 Generate_Sort = sSort + "(" + s + "," + what + ")"
3037 Else
3038 Generate_Sort = ""
3039 End If
3040End Function
3041
3042'************************ Формує рядок висновку за 'What' ***************** *******
3043Public Function Generate_Out (ByVal what $) As String
3044 Generate_Out = ""
3045 SelectForm. CheckConfirm. Visible = False
3046 Dim str $
3047
3048 s $ = SelectForm. SelectDlg (QRDBIndex, "Виберіть поле", sCol)
3049 If (s <> "-1") Then
3050 str = Trim (InputForm. InputVal ("Введіть відносне значення"))
3051 If (str <> "") Then
3052 Dim CreateNewTab As Boolean
3053 CreateNewTab = (MsgForm. QuestMsg ("Виводити в нову таблицю? Ні для виведення у вже існуючу.") = ResOk)
3054 If (Not CreateNewTab) Then
3055 Table $ = SelectForm. SelectDlg (QRDBIndex, "Виберіть таблицю", sTable)
3056 If (Table = "-1") Then Exit Function
3057 Generate_Out = sOut + "(" + s + "," + what + str + "," + Table + ")"
3058 Else
3059 Generate_Out = sOut + "(" + s + "," + what + str + ")"
3060 End If
3061 Else
3062 Call MsgForm. ErrorMsg ("Не задано відносне значення!")
3063 End If
3064 End If
3065End Function
3066
3067'************************ Формує рядок обміну по 'What' ***************** *******
3068Public Function Generate_Swap (ByVal what $) As String
3069 If (what = sCol) Then
3070 s $ = SelectForm. MultiSelectDlg (QRDBIndex, "Виберіть 2 обмінюваних поля", sCol)
3071 If (s <> "") Then
3072 p% = InStr (1, s, ",")
3073 Generate_Swap = sSwap + sCol + "(" + Left (s, p - 1) + "," + Mid (s, p + 1) + ")"
3074 Else
3075 Generate_Swap = ""
3076 End If
3077 Else
3078 s $ = SelectForm. MultiSelectDlg (QRDBIndex, "Виберіть 2 обмінювані запису", sRow)
3079 If (s <> "") Then
3080 p% = InStr (1, s, ",")
3081 Generate_Swap = sSwap + sRow + "(" + Left (s, p - 1) + "," + Mid (s, p + 1) + ")"
3082 Else
3083 Generate_Swap = ""
3084 End If
3085 End If
3086End Function
3087
3088'************************ Формує рядок зміни 'What' ****************** ******
3089Public Function Generate_Change (ByVal what $) As String
3090 Generate_Change = ""
3091 SelectForm. CheckConfirm. Visible = False
3092
3093 s $ = SelectForm. SelectDlg (QRDBIndex, "Виберіть змінюване поле", sCol)
3094 If (s = "-1") Then Exit Function
3095 Select Case what
3096 Case sType 'Зміна типу поля
3097 Generate_Change = sChange + sType + "(" + s + ")"
3098 Case sName 'Зміна назви стовпця
3099 Name $ = InputForm. InputVal ("Введіть нову назву поля")
3100 If (Name = "") Then Exit Function
3101 Generate_Change = sChange + sName + "(" + s + "," + Name + ")"
3102 End Select
3103End Function
3104
3105Sub ErrorInQuery ()
3106 Call MsgForm. ErrorMsg ("Помилка в запиті!")
3107End Sub
3108
3109Function TestZero (i%)
3110 If (i = 0) Then
3111 Call ErrorInQuery
3112 TestZero = True
3113 Else
3114 TestZero = False
3115 End If
3116End Function
3117
3118Sub AddRun (what $, str $)
3119 Select Case what
3120 Case sCol
3121 'заголовок
3122 p% = InStr (1, str, ",")
3123 If TestZero (p) Then Exit Sub
3124 title $ = Trim (Left (str, p - 1))
3125 str = Mid (str, p + 1)
3126 'тип
3127 p = InStr (1, str, ",")
3128 If TestZero (p) Then Exit Sub
3129 ColType $ = Trim (Left (str, p - 1))
3130 str = Mid (str, p + 1)
3131
3132 'початкове значення
3133 p = InStr (1, str, ",")
3134 If TestZero (p) Then Exit Sub
3135 StValStr $ = Trim (Left (str, p - 1))
3136 str = Mid (str, p + 1)
3137
3138 'позиція
3139 ColPosStr $ = str
3140 If (Not IsNumeric (ColPosStr)) Then
3141 Call ErrorInQuery
3142 Exit Sub
3143 End If
3144 ColPos% = CInt (ColPosStr)
3145
3146 If ItColAlreadyCreate (QRDBIndex, title) Then
3147 Call MsgForm. ErrorMsg ("Додає поле вже існує!")
3148 Exit Sub
3149 End If
3150
3151 'в залежності від типу визначаю значення
3152 Select Case ColType
3153 Case sI
3154 If (Not IsInteger (StValStr)) Then
3155 Call ErrorInQuery
3156 Exit Sub
3157 End If
3158 stval = CInt (StValStr)
3159 Call AddCol (QRDBIndex, ccInteger, title, stval, ColPos)
3160 Case sS
3161 stval = CStr (StValStr)
3162 Call AddCol (QRDBIndex, ccString, title, stval, ColPos)
3163 Case Default
3164 Call ErrorInQuery
3165 Exit Sub
3166 End Select
3167
3168 Case sRow
3169 If (DB (QRDBIndex). Header. ColCount> 0) Then
3170 Dim row () As Variant
3171 ReDim row (DB (QRDBIndex). Header. ColCount - 1)
3172 For i = 0 To DB (QRDBIndex). Header. ColCount - 1
3173 row (i) = DB (QRDBIndex). Cols (i). DefValue
3174 Next i
3175 If (Not FindRow (QRDBIndex, row)) Then
3176 Call AddField (QRDBIndex, row)
3177 Else
3178 Call MsgForm. ErrorMsg ("Додається стовпець дублюється!")
3179 End If
3180 Else
3181 Call MsgForm. ErrorMsg ("Не можна додавати записи в БД без полів!")
3182 End If
3183 End Select
3184
3185End Sub
3186
3187Sub DelRun (what $, str $)
3188 p% = InStr (1, str, ",")
3189 If TestZero (p) Then Exit Sub
3190 IndexStr $ = Trim (Left (str, p - 1))
3191 If (Not IsInteger (IndexStr)) Then
3192 Call ErrorInQuery
3193 Exit Sub
3194 End If
3195 Index% = CInt (IndexStr)
3196 str = Mid (str, p + 1)
3197 ConfirmStr $ = Trim (str)
3198 Dim Confirm As Boolean
3199 Select Case ConfirmStr
3200 Case sYes
3201 Confirm = True
3202 Case sNo
3203 Confirm = False
3204 Case Default
3205 Call ErrorInQuery
3206 Exit Sub
3207 End Select
3208
3209 Select Case what
3210 Case sCol
3211 If (DB (QRDBIndex). Header. ColCount> 0) Then
3212 Call DelCol_ (QRDBIndex, Index, Confirm)
3213 Else
3214 Call MsgForm. ErrorMsg ("В БД немає полів!")
3215 Exit Sub
3216 End If
3217 Case sRow
3218 If (DB (QRDBIndex). Header. RowCount> 0) Then
3219 Call DelRow_ (QRDBIndex, Index, Confirm)
3220 Else
3221 Call MsgForm. ErrorMsg ("В БД немає записів!")
3222 Exit Sub
3223 End If
3224 End Select
3225End Sub
3226
3227Sub SortRun (str $)
3228 If (DB (QRDBIndex). Header. ColCount = 0) Or (DB (QRDBIndex). Header. RowCount = 0) Then
3229 Call MsgForm. ErrorMsg ("Нема чого сортувати!")
3230 Exit Sub
3231 End If
3232
3233 p% = InStr (1, str, ",")
3234 If TestZero (p) Then Exit Sub
3235 what $ = Trim (Left (str, p - 1))
3236
3237 If (Not IsInteger (what)) Then
3238 Call ErrorInQuery
3239 Exit Sub
3240 End If
3241
3242 whatint% = CInt (what)
3243
3244 If (whatint <0) Or (whatint> DB (QRDBIndex). Header. ColCount - 1) Then
3245 Call ErrorInQuery
3246 Exit Sub
3247 End If
3248
3249 Mode $ = Trim (Mid (str, p + 1))
3250
3251 Select Case Mode
3252 Case sAZ
3253 s $ = "А-> Я"
3254 Case sZA
3255 s $ = "Я-> А"
3256 Case Default
3257 Call ErrorInQuery
3258 Exit Sub
3259 End Select
3260
3261 Count% = MainForm. TabStrip. Tabs. Count
3262 ReDim Preserve DB (Count)
3263
3264 DB (Count) = DB (QRDBIndex)
3265
3266 MainForm. TabStrip. Tabs. Add pvCaption: = s, pvImage: = 1
3267
3268 Dim find As Boolean, needswap As Boolean
3269 Dim tmp As TDBElem
3270 With DB (Count)
3271 Do
3272 find = False
3273 For R% = 1 To. Header. RowCount - 1
3274 If (Mode = sZA) Then
3275 needswap = (. Rows (R). Fields (whatint)>. Rows (R - 1). Fields (whatint))
3276 Else
3277 needswap = (. Rows (R). Fields (whatint) <. Rows (R - 1). Fields (whatint))
3278 End If
3279 If (needswap) Then
3280 tmp =. Rows (R)
3281. Rows (R) =. Rows (R - 1)
3282. Rows (R - 1) = tmp
3283 find = True
3284 End If
3285 Next R
3286 Loop While (find)
3287 End With
3288End Sub
3289
3290Function Equal (ByVal col%, ByVal row%, ByVal cmpstr $) As Long
3291 If (DB (QRDBIndex). Cols (col). Class = ccInteger) Then
3292 Rval = CLng (DB (QRDBIndex). Rows (row). Fields (col))
3293 Equal = (Rval - CLng (cmpstr))
3294 Else
3295 Rval = CStr (DB (QRDBIndex). Rows (row). Fields (col))
3296 If (Rval = cmpstr) Then
3297 Equal = 0
3298 Else
3299 If (Rval> cmpstr) Then
3300 Equal = 1
3301 Else
3302 Equal = - 1
3303 End If
3304 End If
3305 End If
3306End Function
3307
3308Function CalcCount (Index%, c%, value $) As Integer
3309 Count% = 0
3310 For i% = 0 To (DB (Index). Header. RowCount - 1)
3311 If (CStr (DB (Index). Rows (i). Fields (c)) = value) Then Count = Count + 1
3312 Next i
3313 CalcCount = Count
3314End Function
3315
3316Function EarlierDontFind (Index%, c%, R%, value $) As Boolean
3317 For i% = 0 To (R - 1)
3318 If (CStr (DB (Index). Rows (i). Fields (c)) = value) Then
3319 EarlierDontFind = False
3320 Exit Function
3321 End If
3322 Next i
3323 EarlierDontFind = True
3324End Function
3325
3326Public Function FindRow (Index%, row ())
3327 For R% = 0 To DB (Index). Header. RowCount - 1
3328 Sum% = 0
3329 For c% = 0 To DB (Index). Header. ColCount - 1
3330 If (CStr (DB (Index). Rows (R). Fields (c)) = row (c)) Then Sum = Sum + 1
3331 Next c
3332 If (Sum = DB (Index). Header. ColCount) Then
3333 FindRow = True
3334 Exit Function
3335 End If
3336 Next R
3337 FindRow = False
3338End Function
3339
3340Sub OutRun (str $)
3341 If (DB (QRDBIndex). Header. ColCount = 0) Or (DB (QRDBIndex). Header. RowCount = 0) Then
3342 Call MsgForm. ErrorMsg ("Не з чим порівнювати!")
3343 Exit Sub
3344 End If
3345
3346 p% = InStr (1, str, ",")
3347 what $ = Trim (Left (str, p - 1))
3348
3349 If (Not IsInteger (what)) Then
3350 Call ErrorInQuery
3351 Exit Sub
3352 End If
3353
3354 whatint% = CInt (what)
3355
3356 If (whatint <0) Or (whatint> DB (QRDBIndex). Header. ColCount - 1) Then
3357 Call ErrorInQuery
3358 Exit Sub
3359 End If
3360
3361 pi% = p + 1
3362 Do
3363 Mode $ = Trim (Mid (str, pi, 1))
3364 pi = pi + 1
3365 Loop While (Mode = "")
3366 Mode = Mode + Mid (str, pi, 1)
3367
3368 If (Mode <> sEqual) And (Mode <> sAbove) And (Mode <> sBelow) And (Mode <> sCountEqual) And (Mode <> sCountAbove) And (Mode <> sCountBelow) Then
3369 Call ErrorInQuery
3370 Exit Sub
3371 End If
3372
3373 Dim CalcMode As Boolean
3374 CalcMode = (Mode = sCountEqual) Or (Mode = sCountAbove) Or (Mode = sCountBelow)
3375
3376 str = Trim (Mid (str, pi + 1))
3377
3378 If (str = "") Then
3379 Call ErrorInQuery
3380 Exit Sub
3381 End If
3382
3383 'перевірка на наявність індексу таблиці
3384 p = InStr (1, str, ",")
3385 tableindex% = - 1
3386 If (p <> 0) Then
3387 tableindexstr $ = Trim (Mid (str, p + 1))
3388 If Not IsInteger (tableindexstr) Then
3389 Call ErrorInQuery
3390 Exit Sub
3391 End If
3392 tableindex% = CLng (tableindexstr)
3393 If (tableindex <0) Or (tableindex> MainForm. TabStrip. Tabs. Count - 1) Then
3394 Call ErrorInQuery
3395 Exit Sub
3396 End If
3397 str = Trim (Left (str, p - 1))
3398 End If
3399
3400 Dim GlobEqual As Boolean
3401 If (Not IsInteger (str)) And (DB (QRDBIndex). Cols (whatint). Class = ccInteger) Then
3402 Call MsgForm. ErrorMsg ("Еквівалентом виведення цілочисельного стовпця не є ціле число!" + VbCrLf + _
3403 "Умова завжди істинне!")
3404 GlobEqual = True
3405 Else
3406 GlobEqual = False
3407 End If
3408
3409 Count% = MainForm. TabStrip. Tabs. Count
3410 If (tableindex = - 1) Then
3411 ReDim Preserve DB (Count)
3412
3413 DB (Count). Header = DB (QRDBIndex). Header
3414 DB (Count). Header. RowCount = 0
3415 DB (Count). Cols = DB (QRDBIndex). Cols
3416
3417 MainForm. TabStrip. Tabs. Add pvCaption: = "Висновок" + Mode + str, pvImage: = 1
3418 Else
3419 Count = tableindex
3420 End If
3421
3422 Dim NeedAdd As Boolean
3423 With DB (Count)
3424 Dim Rval
3425 For R% = 0 To DB (QRDBIndex). Header. RowCount - 1
3426 If (Not GlobEqual) Then
3427 Select Case Mode
3428 Case sEqual
3429 NeedAdd = (Equal (whatint, R, str) = 0)
3430 Case sAbove
3431 NeedAdd = (Equal (whatint, R, str)> 0)
3432 Case sBelow
3433 NeedAdd = (Equal (whatint, R, str) <0)
3434 Case sCountEqual
3435 value $ = CStr (DB (QRDBIndex). Rows (R). Fields (whatint))
3436 NeedAdd = ((CStr (CalcCount (QRDBIndex, whatint, value)) = str) And (EarlierDontFind (QRDBIndex, whatint, R, value)))
3437 Case sCountAbove
3438 value $ = CStr (DB (QRDBIndex). Rows (R). Fields (whatint))
3439 NeedAdd = ((CStr (CalcCount (QRDBIndex, whatint, value))> str) And (EarlierDontFind (QRDBIndex, whatint, R, value)))
3440 Case sCountBelow
3441 value $ = CStr (DB (QRDBIndex). Rows (R). Fields (whatint))
3442 NeedAdd = ((CStr (CalcCount (QRDBIndex, whatint, value)) <str) And (EarlierDontFind (QRDBIndex, whatint, R, value)))
3443 End Select
3444 Else
3445 NeedAdd = True
3446 End If
3447 If (NeedAdd) Then
3448 ReDim tmparr (DB (QRDBIndex). Header. ColCount)
3449 tmparr = DB (QRDBIndex). Rows (R). Fields
3450 If (Not FindRow (Count, tmparr)) Then
3451 addindex% = DB (Count). Header. RowCount
3452 ReDim Preserve DB (Count). Rows (addindex)
3453 ReDim DB (Count). Rows (addindex). Fields (DB (Count). Header. ColCount - 1)
3454 DB (Count). Rows (addindex). Fields = DB (QRDBIndex). Rows (R). Fields
3455 DB (Count). Header. RowCount = DB (Count). Header. RowCount + 1
3456 Else
3457 Call MsgForm. ErrorMsg ("Додається запис вже існує!")
3458 End If
3459 End If
3460 Next R
3461 End With
3462End Sub
3463
3464Sub SwapRun (what $, str $)
3465 p% = InStr (1, str, ",")
3466 If TestZero (p) Then Exit Sub
3467 index1str $ = Trim (Left (str, p - 1))
3468 index2str $ = Trim (Mid (str, p + 1))
3469
3470 If (Not IsInteger (index1str)) Then
3471 Call ErrorInQuery
3472 Exit Sub
3473 End If
3474
3475 index1% = CInt (index1str)
3476 index2% = CInt (index2str)
3477
3478 If (index1 <0) Or (index2 <0) Or (index1 = index2) Then
3479 Call ErrorInQuery
3480 Exit Sub
3481 End If
3482
3483 Select Case what
3484 Case sCol
3485 With DB (QRDBIndex)
3486 If (index1>. Header. ColCount - 1) Or (index2>. Header. ColCount - 1) Then
3487 Call ErrorInQuery
3488 Exit Sub
3489 End If
3490 'обмін полів
3491 Dim tmpcol As TDBElemData
3492 tmpcol =. Cols (index1)
3493. Cols (index1) =. Cols (index2)
3494. Cols (index2) = tmpcol
3495 'обмін полів записів
3496 Dim tmpcell As Variant
3497 For R% = 0 To. Header. RowCount - 1
3498 tmpcell =. Rows (R). Fields (index1)
3499. Rows (R). Fields (index1) =. Rows (R). Fields (index2)
3500. Rows (R). Fields (index2) = tmpcell
3501 Next R
3502
3503 End With
3504 Case sRow
3505 With DB (QRDBIndex)
3506 If (index1>. Header. RowCount - 1) Or (index2>. Header. RowCount - 1) Then
3507 Call ErrorInQuery
3508 Exit Sub
3509 End If
3510 Dim tmprow As TDBElem
3511 tmprow =. Rows (index1)
3512. Rows (index1) =. Rows (index2)
3513. Rows (index2) = tmprow
3514 End With
3515 End Select
3516End Sub
3517
3518Sub ChangeRun (what $, param $)
3519 Select Case what
3520 Case sType '**************...::: Type :::... ***************
3521 If Not IsInteger (param) Then
3522 Call ErrorInQuery
3523 Exit Sub
3524 End If
3525 colindex% = CLng (param)
3526 If (colindex <0) Or (colindex> DB (QRDBIndex). Header. ColCount - 1) Then
3527 Call ErrorInQuery
3528 Exit Sub
3529 End If
3530 If (DB (QRDBIndex). Cols (colindex). Class = ccString) Then
3531 If (MsgForm. QuestMsg ("Поле строкового типу перетвориться в числовий тип." + _
3532 "Все нечислові значення будуть перетворені в 0." + _
3533 "Продовжити?") <> ResOk) Then Exit Sub
3534
3535 End If
3536 For i% = 0 To (DB (QRDBIndex). Header. RowCount - 1)
3537 Select Case DB (QRDBIndex). Cols (colindex). Class
3538 Case ccInteger
3539 DB (QRDBIndex). Rows (i). Fields (colindex) = CStr (DB (QRDBIndex). Rows (i). Fields (colindex))
3540 Case ccString
3541 If Not IsInteger (DB (QRDBIndex). Rows (i). Fields (colindex)) Then
3542 DB (QRDBIndex). Rows (i). Fields (colindex) = 0
3543 Else
3544 DB (QRDBIndex). Rows (i). Fields (colindex) = CLng (DB (QRDBIndex). Rows (i). Fields (colindex))
3545 End If
3546 End Select
3547 Next i
3548 Select Case DB (QRDBIndex). Cols (colindex). Class
3549 Case ccInteger
3550 DB (QRDBIndex). Cols (colindex). Class = ccString
3551 Case ccString
3552 DB (QRDBIndex). Cols (colindex). Class = ccInteger
3553 End Select
3554
3555 Case sName '**************...::: Name :::... ***************
3556 p% = InStr (1, param, ",")
3557 If TestZero (p) Then Exit Sub
3558 colindexstr $ = Trim (Left (param, p - 1))
3559 If Not IsInteger (colindexstr) Then
3560 Call ErrorInQuery
3561 Exit Sub
3562 End If
3563 colindex% = CLng (colindexstr)
3564 param = Trim (Mid (param, p + 1))
3565 If (param = "") Then
3566 Call ErrorInQuery
3567 Exit Sub
3568 End If
3569 'пошук на дублікат
3570 For i% = 0 To DB (QRDBIndex). Header. ColCount - 1
3571 If (DB (QRDBIndex). Cols (i). Title = param) And (i <> colindex) Then
3572 Call MsgForm. ErrorMsg ("Поле з назвою" + param + "вже існує!")
3573 Exit Sub
3574 End If
3575 Next i
3576 DB (QRDBIndex). Cols (colindex). title = param
3577 DB (QRDBIndex). Cols (colindex). TitleLen = Len (param)
3578 Case Default '**************!! ***************
3579 Call ErrorInQuery
3580 End Select
3581End Sub
3582
3583Public Sub RunQuery (DBIndex_%, query $)
3584 Dim s1 $, p%
3585
3586 s1 = Mid (query, 4)
3587 query = Left (query, 3)
3588
3589 QRDBIndex = DBIndex_
3590
3591 Select Case query
3592 Case sAdd
3593 query = Left (s1, 3)
3594 s1 = Mid (s1, InStr (1, s1, "("))
3595 If (Left (s1, 1) <> "(") Or (Right (s1, 1) <> ")") Or ((Len (s1) <8) And (query = sCol)) Then
3596 Call ErrorInQuery
3597 Else
3598 Call AddRun (query, Trim (Mid (s1, 2, Len (s1) - 2)))
3599 End If
3600 Case sDel
3601 query = Left (s1, 3)
3602 s1 = Mid (s1, InStr (1, s1, "("))
3603 If (Left (s1, 1) <> "(") Or (Right (s1, 1) <> ")") Or (Len (s1) <5) Then
3604 Call ErrorInQuery
3605 Else
3606 Call DelRun (query, Trim (Mid (s1, 2, Len (s1) - 2)))
3607 End If
3608 Case sSort
3609 If (Left (s1, 1) <> "(") Or (Right (s1, 1) <> ")") Or (Len (s1) <5) Then
3610 Call ErrorInQuery
3611 Else
3612 Call SortRun (Trim (Mid (s1, 2, Len (s1) - 2)))
3613 End If
3614 Case sOut
3615 If (Left (s1, 1) <> "(") Or (Right (s1, 1) <> ")") Or (Len (s1) <5) Then
3616 Call ErrorInQuery
3617 Else
3618 Call OutRun (Trim (Mid (s1, 2, Len (s1) - 2)))
3619 End If
3620 Case sSwap
3621 query = Left (s1, 3)
3622 s1 = Mid (s1, InStr (1, s1, "("))
3623 If (Left (s1, 1) <> "(") Or (Right (s1, 1) <> ")") Or ((Len (s1) <5) And (query = sCol)) Then
3624 Call ErrorInQuery
3625 Else
3626 Call SwapRun (query, Trim (Mid (s1, 2, Len (s1) - 2)))
3627 End If
3628 Case sChange
3629 query = Left (s1, 4)
3630 s1 = Mid (s1, InStr (1, s1, "("))
3631 If (Left (s1, 1) <> "(") Or (Right (s1, 1) <> ")") Or (Len (s1) <3) Then
3632 Call ErrorInQuery
3633 Else
3634 Call ChangeRun (query, Trim (Mid (s1, 2, Len (s1) - 2)))
3635 End If
3636 End Select
3637
3638End Sub