7. ЭКОНОМИЧЕСКИЙ РАЗДЕЛ
При расчете экономической эффективности разработки программного обеспечения “Универсальной обучающе-контролирующей системы” необходимо сопоставить затраты на решение задачи при ручном методе ее решения с затратами, связанными с ее автоматизацией.
Определение годового экономического эффекта от сокращения ручного труда при обработке информации производится в описанной ниже последовательности.
Годовые эксплуатационные расходы при ручной обработке информации определяются по формуле
Зр = Тр*к*tчр*(1+q)*(1+a)*(1+b), | (7.1.) |
гдеТр — трудоемкость разового решения задачи вручную, чел-ч. (Тр = 3.5),
к — периодичность решения задачи в течение года (к = 200),
tчр — среднечасовая ставка работника, осуществляющего ручной расчет задачи, руб.,
q — коэффициент, учитывающий процент премий (q = 0.4),
а — коэффициент, учитывающий дополнительную заработную плату (а = 0.15),
b — коэффициент, учитывающий начисления на заработную плату, включая отчисления в фонд социальной защиты населения — 35%, детских учреждений — 5% и чрезвычайный чернобыльский налог — 12% (b = 0.52).
Трудоемкость разового решения задачи вручную определяется по нормам времени на разработку конструкторской или технологической документации [19].
Среднечасовая ставка работника определяется исходя из Единой тарифной системы оплаты труда в Республике Беларусь по следующей формуле
tчр = О1*kт/167, | (7.2.) |
гдеО1 — среднемесячная заработная плата работника 1 разряда (по состоянию на 01.04.97 — 170000 руб.),
kт — тарифный коэффициент работника соответствующего разряда (kт = 4.06),
167 — нормативное количество рабочих часов в месяце.
Разряд работника, выполняющего ручной расчет задачи, и соответствующий ему тарифный коэффициент выбирается из табл.7.1.
Таблица 7.1
Тарифные коэффициенты специалистов с высшим образованием
Категория работников | Разряд | Тарифные коэффициенты |
Специалисты с высшим образованием: без категории | 8 | 3.69 |
2 категории | 9 | 4.06 |
1 категории | 10 | 4.47 |
высшей категории | 11 | 4.78 |
tчр = 170000*4.06/167 = 4132.93 (руб), |
Зр = 3.5*200*4132.93*(1+0.4)*(1+0.15)*(1+0.52) = 7079874.41(руб) |
Годовые текущие затраты, связанные с эксплуатацией задачи, определяются по формуле
Зт = Зп+За, | (7.3.) |
гдеЗп — затраты на заработную плату пользователя программы,
За — затраты на оплату аренды ЭВМ при решении задачи.
Затраты на заработную плату пользователя программы определяются по формуле
Зп = Тз*к*tчп*(1+q)*(1+a)*(1+b), | (7.4.) |
гдеТз — время решения задачи на ЭВМ, час.,
tчп — среднечасовая ставка пользователя программы, руб. (определяется аналогично ставке работника, осуществляющего ручной расчет, кт = 3.69).
Время решения задачи на ЭВМ определяется по формуле
Тз = (Твв+Тр+Твыв)*(1+dпз)/60, | (7.5.) |
гдеТвв — время ввода в ЭВМ исходных данных, необходимых для решения задачи, мин.,
Тр — время вычислений, мин.( Тр = 0.1),
Твыв — время вывода результатов решения задачи (включая время распечатки на принтере и графопостроителе), мин. (Твыв = 4),
dпз — коэффициент, учитывающий подготовительно-заключительное время (dпз = 0.20).
Время ввода в ЭВМ исходных данных может быть определено по формуле
Твв = Кz*Hz/100, | (7.6.) |
гдеКz — среднее количество знаков, набираемых с клавиатуры при вводе исходных данных (Кz = 250),
Hz — норматив набора 100 знаков, мин. (Hz = 2).
Время вычислений и время вывода информации может быть определено экспериментальным путем при отладке контрольного примера.
tчп = 170000*3.69/167 = 3756.29 (руб), |
Твв = 250*2/100 = 5 (мин), |
Тз = (5+0.1+4)*(1+0.20)/60 = 0.182 (час), |
Зп = 0.182*200*3756.29*(1+0.4)*(1+0.15)*(1+0.52) = 334603.10 (руб). |
Затраты на оплату аренды ЭВМ для решения задачи определяются по следующей формуле
За = Тз*к*Sмч, | (7.7.) |
гдеSмч — стоимость одного машино-часа работы ЭВМ, руб.
Стоимость машино-часа работы ЭВМ определяется по формуле
Sмч = Сэ+(Аэвм+Рэвм+Апл+Рпл+Нн)/Фэвм, | (7.8.) |
гдеСэ — расходы на электроэнергию за час работы ЭВМ, руб.,
Аэвм — годовая величина амортизационных отчислений на реновацию ЭВМ, руб.,
Рэвм — годовые затраты на ремонт и техническое обслуживание ЭВМ, руб.,
Апл — годовая величина амортизационных отчислений на реновацию производственных площадей, занимаемых ЭВМ, руб.,
Рпл — годовые затраты на ремонт и содержание производственных площадей, руб.,
Нн — годовая величина налога на недвижимость, руб.,
Фэвм — годовой фонд времени работы ЭВМ, час.
Расходы на электроэнергию за час работы ЭВМ определяются по формуле
Сэ = Nэ*kис*Цэ или Сэ = Чэл*Цэ, | (7.9.) |
гдеNэ — установленная мощность электродвигателя ЭВМ, кВт (Nэ = 0.2),
kис — коэффициент использования энергоустановок по мощности (kис = 0.9),
Цэ — стоимость 1 кВт-часа электроэнергии, руб. (Цэ = 690),
Чэл — среднечасовое потребление электроэнергии ЭВМ, кВт.
Сэ = 0.2*0.9*690 = 124.2 (руб). |
Годовая величина амортизационных отчислений на реновацию ЭВМ определяется по формуле
Аэвм = Цэвм*kу*kм*Наэвм/100 = Цбэвм*Наэвм/100, | (7.10.) |
гдеЦэвм — цена ЭВМ на момент ее выпуска, руб. (Цэвм = 17500000),
kу — коэффициент удорожания ЭВМ (зависит от года выпуска). В том случае, когда в качестве цены используется цена 1997г., коэффициент удорожания kу = 1,
kм — коэффициент, учитывающий затраты на монтаж и транспортировку ЭВМ (kм = 1.1),
Наэвм — норма амортизационных отчислений на ЭВМ, % (Наэвм = 10),
Цбэвм — балансовая стоимость ЭВМ, руб.
Цбэвм = 17500000*1*1.1 = 19250000 (руб), |
Аэвм = 17500000*1*1.1*10/100 = 1925000 (руб). |
Годовые затраты на ремонт и техническое обслуживание ЭВМ укрупненно могут быть определены по формуле
Рэвм = Цбэвм*kро, | (7.11.) |
гдеkро — коэффициент, учитывающий затраты на ремонт и техническое обслуживание ЭВМ, в том числе затраты на запчасти, зарплату ремонтного персонала и др. (kро = 0.1).
Рэвм = 19250000*0.1 = 1925000 (руб). |
Годовая величина амортизационных отчислений на реновацию производственных площадей, занятых ЭВМ определяется по формуле
Апл = Цбпл*Напл/100 = Sэвм*kд*Цпл*Напл/100, | (7.12.) |
гдеЦбпл — балансовая стоимость площадей, руб.,
Напл — норма амортизационных отчислений на производственные площади, % (Напл = 1.2 ),
Sэвм — площадь, занимаемая ЭВМ, кв. м. (Sэвм = 1 кв. м.),
kд — коэффициент, учитывающий дополнительную площадь (kд = 3),
Цпл — цена 1 квадратного метра площади, руб. (Цпл = 4363837.5).
Цбпл = 1*3*4363837.5 = 13091512.5 (руб), |
Апл = 13091512.5*1.2/100 = 157098.15 (руб). |
Годовые затраты на ремонт и содержание производственных площадей укрупненно могут быть определены по формуле
Рпл = Цбпл*kрэ, | (7.13.) |
гдеkрэ — коэффициент, учитывающий затраты на ремонт и эксплуатацию производственных площадей (kрэ = 0.05).
Рпл = 13091512.5*0.05 = 654575.63 (руб). |
Величина налога на недвижимость определяется по формуле
Нн = (Цбэвм+Цбпл)*Снн, | (7.14.) |
гдеСнн — ставка налога на недвижимость (Снн = 0.01).
Нн = (19250000+13091512.5)*0.01 = 323415.13 (руб). |
Годовой фонд времени работы ЭВМ определяется исходя из режима ее работы и может быть рассчитан по формуле
Фэвм = tсс*Тсг, | (7.15.) |
гдеtсс — среднесуточная фактическая загрузка ЭВМ, час. (tсс = 8),
Тсг — среднее количество дней работы ЭВМ в год (Тсг = 250).
Фэвм = 8*250 = 2000 (час), |
Sмч = 124.2+(1925000+1925000+157098.15+654575.63+323415.13)/2000 = 2504.96 (руб). |
Прирост условной прибыли в результате внедрения задачи определяется по формуле
Пу = (Зр-Зт)*(1-Снп), | (7.16.) |
гдеСнп — ставка налога на прибыль (Снп = 0.3).
За = 0.182*200*2504.96 = 91180.54 (руб), |
Зт = 334603.10 + 91180.54 = 425783.64 (руб), |
Пу = (7079874,41-425783,64)*(1-0,3) = 4657863.54 (руб). |
Для определения годового экономического эффекта от разработанной программы необходимо определить суммарные капитальные затраты на разработку и внедрение программы по формуле
Ко = Кз+Цпр, | (7.17.) |
гдеКз — капитальные и приравненные к ним затраты, руб.,
Цпр — отпускная цена программы, руб.,
Капитальные и приравненные к ним затраты определяются по формуле
Кз = Цбэвм*(1-X*Наэвм/100)*Тз*к/Фэвм,, | (7.18.) |
гдеХ — количество лет выработки ЭВМ, лет.
Кз = 19250000*(1-5*10/100)*0.182*200/ 2000 = 175175 (руб). |
Отпускная цена программы определяется по формуле
Цпр = Цо+(Зрз+Пр)*Ндоб, | (7.19.) |
гдеЦо — оптовая цена программы, руб.,
Зрз — затраты на заработную плату разработчиков программы, руб.,
Пр — размер плановой прибыли на программу, руб.,
Ндоб — ставка налога на добавленную стоимость (Ндоб = 0.20).
Затраты на заработную плату разработчиков программы определяются по формуле
Зрз = Трз*tчрз*(1+q)*(1+a)*(1+b), | (7.20.) |
гдеТрз — трудоемкость разработки программы, час.,
tчрз — среднечасовая ставка работника, осуществляющего разработку программы, руб.
Трудоемкость разработки программы включает время на постановку задачи и время на программирование задачи и определяется по формуле
nэnэ | |
Трз = (åТпосi+åТпргi)*8, | (7.21.) |
i=1i=1 |
|
гдеnэ — количество этапов разработки программы,
Тпосi — трудоемкость постановки задачи на i-м этапе разработки программы, дней,
Тпргi — трудоемкость программирования задачи на i-м этапе разработки программы, дней.
Разработка пакета программ, представленного в настоящем проекте, включала в себя 4 этапа:
1. Проектирование структур баз данных (Тпос = 1, Тпрг = 3);
2. Разработка программы создания и модификации тестов (Тпос = 0.4, Тпрг = 18);
3. Разработка программы контроля знаний (Тпос = 0.3, Тпрг = 15);
4. Разработка программы администрирования (Тпос = 0.3, Тпрг = 11);
Трз = 392 (час), |
tчрз = 170000*4.78/167 = 4865.87 (руб), |
Зрз = 392*4865.87*(1+0.4)*(1+0.15)*(1+0.52) = 4667840.77 (руб). |
Нормы времени учитывают ряд факторов, наибольшим образом влияющих на трудоемкость разработки проекта:
· количество разновидностей форм входной информации;
· количество разновидностей форм выходной информации;
· степень новизны задачи;
· сложность алгоритма;
· вид используемой информации;
· сложность контроля входной и выходной информации;
· язык программирования;
· объем входной информации;
· использование типовых решений, типовых проектов и программ,
· стандартных модулей.
Предусмотрено четыре степени новизны разрабатываемых задач:
· А — разработка задач, предусматривающая применение принципиально новых методов разработки, проведение научно-исследовательских работ;
· Б — разработка типовых проектных решений, оригинальных задач и систем, не имеющих аналогов;
· В — разработка проекта с использованием типовых проектных решений при условии их изменения, разработка проектов, имеющих аналогичные решения;
· Г — привязка типовых проектных решений.
Сложность алгоритма представлена тремя группами:
· 1 — алгоритмы оптимизации и моделирования систем и объектов;
· 2 — алгоритмы учета, отчетности, статистики и поиска;
· 3 — алгоритмы, реализующие стандартные методы решения, а также не предусматривающие применения сложных численных и логических методов.
Пакет программ, представленный в настоящем проекте, относится к степени В новизны разрабатываемой задачи. Сложность алгоритма решаемой задачи — 3.
Плановая прибыль на программу определяется по формуле
Пр = Спр*Нп,, | (7.22.) |
гдеСпр — себестоимость программы, руб.,
Нп — норма прибыли проектной организации (Нп = 0.25).
Себестоимость программы определяется по формуле
Спр = Зрз*F+Зот, | (7.23.) |
гдеF — коэффициент накладных расходов проектной организации без учета эксплуатации ЭВМ (F = 1.15),
Зот — затраты на отладку программы.
Затраты на отладку программы определяются по формуле
Зот = Тотл*Sмч, | (7.24.) |
гдеТотл — трудоемкость отладки программы, час. (Тотл = 32).
Зот = 32* 2504.96 = 80159 (руб), |
Спр = 4667840.77*1.15+80159= 5448175.89 (руб). |
Оптовая цена программы определяется по формуле
Цо = Спр+Пр. | (7.25.) |
Пр = 5448175.89 *0.25 = 1362043.97 (руб), |
Цо = 5448175.89 + 1362043.97 = 5440712.13 (руб), |
Цпр = 5440712.13+(4667840.77+1362043.97)*0.2 = 6646689.08 (руб). |
Ожидаемый годовой экономический эффект от сокращения ручного труда при обработке информации определяется по формуле
ЭФ = Пу-Е*Ко = Пу-Е*(Кз+Цпр), | (7.26.) |
гдеЕ — коэффициент эффективности, равный ставке за кредиты на рынке долгосрочных кредитов (Е = 0.25).
Ко = 175175+6646689.08 = 6821864.08 (руб), |
ЭФ = 4657863.54 -0.25*6821864.08= 2952397.52 (руб). |
Срок возврата инвестиций определяется по формуле
Тв = Ко/Пу, | (7.27.) |
Тв = 6821864.08/ 4657863.54 = 1.46 (лет). |
Результаты расчета сведены в табл. 7.2.
Таблица 7.2
Технико‑экономические показатели проекта
Наименование показателя | Базовый вариант | Проектный вариант |
Трудоемкость решения задачи, час. | 4 | 0.182 |
Периодичность решения задачи, раз/год | 200 | 200 |
Годовые текущие затраты, связанные с решением задачи, млн. руб. | 7.080 | 0.335 |
Отпускная цена программы, млн. руб. | — | 6.647 |
Степень новизны программы | — | В |
Группа сложности алгоритма | — | 3 |
Прирост условной прибыли, млн. руб. | — | 4.658 |
Ожидаемый годовой экономический эффект, млн. руб. | — | 2.952 |
Срок возврата инвестиций, лет | — | 1.46 |
Разработанная «Обучающе-контролирующая система» обеспечивает получение годового экономического эффекта в сумме 2.952 млн. рублей. Прирост условной прибыли составляет 4.658 млн. рублей. При отпускной цене программы в 6.647 млн. рублей проект обеспечивает возврат инвестиций за 1.46 года.
ЗАКЛЮЧЕНИЕ
В результате дипломного проектирования разработана универсальная обучающе-контролирующая система, состоящая из следующих функциональных частей:
1) программа для создания и модификации тестов;
2) сервисная программа администрирования;
3) программа контроля знаний.
Разработанная универсальная обучающе-контролирующая система обладает следующими возможностями:
· создание на основе имеющихся баз знаний тестов по различным предметам;
· модификация созданных тестов;
· формирование билетов;
· задание времени ответа на вопросы билета;
· задание системы оценки результатов тестирования;
· контроль знаний обучаемых посредством тестирования;
· возможность работы системы в ЛВС;
· просмотр и распечатка результатов (протокола) тестирования на принтере
и может быть использована в учебном процессе преподавателями вузов, техникумов и средних школ.
Перспективным направлением дальнейших разработок по проблематике обучающе-контролирующих систем может служить применение в таких системах OLE и мультимедиа технологий.
Все задачи, поставленные при постановке задания, выполнены. Проведенный расчет говорит о экономической целесообразности разработки системы и возможности использования ее в учебном процессе.
Приложение 1
ТЕКСТ ПРОГРАММЫ TESTBUILDER
program TestBuilder;
uses
Forms,
S2 in 'S2.PAS' {TreeForm},
db_unit in 'db_unit.pas' {EditForm},
addtema in 'addtema.pas' {WinEditTema},
progrInd in 'progrInd.pas' {ProcessForm};
{$R *.RES}
begin
Application.Title:= 'TestBuilder';
Application.CreateForm(TTreeForm, TreeForm);
Application.CreateForm(TEditForm, EditForm);
Application.CreateForm(TWinEditTema, WinEditTema);
Application.CreateForm(TProcessForm, ProcessForm);
Application.Run;
end.
Текст модуля DB_Unit
unit S2;
interface
uses
SysUtils, WinTypes,{ Windows,} Messages, Classes, Graphics, Controls,
Forms, Dialogs, Buttons, StdCtrls, Grids, Outline, ComCtrls, DBCtrls,
DBTables, DB;
type
TTreeForm = class(TForm)
MainTree: TOutline;
AddDocBut: TSpeedButton;
DeleteBut: TSpeedButton;
FullExpBut: TSpeedButton;
FullColBut: TSpeedButton;
ExitBut: TSpeedButton;
AddTemaBut: TSpeedButton;
TemaSource: TDataSource;
QuestSource: TDataSource;
DBTema: TTable;
DBTemaTema_id: TAutoIncField;
DBTemaTema_name: TStringField;
DBQuest: TTable;
DBQuestTema_id: TIntegerField;
DBQuestQuest_id: TAutoIncField;
DBQuestQuest_name: TMemoField;
procedure AddDocButClick(Sender: TObject);
procedure MainTreeClick(Sender: TObject);
procedure DeleteButClick(Sender: TObject);
procedure FullExpButClick(Sender: TObject);
procedure FullColButClick(Sender: TObject);
procedure ExitButClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure AddTemaButClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure AppendQuestion(temaId: longint);
procedure ClearQuestion;
private
{ Private declarations }
x1,x2: integer; {вспомогательные переменные}
CreateMainForm: boolean;
public
{ Public declarations }
end;
var
TreeForm: TTreeForm;
implementation
uses db_unit, addtema, progrInd;
{$R *.DFM}
procedure TTreeForm.AddDocButClick(Sender: TObject);
var
Nodename: string;
number,ind,docindex: longint;
begin
If MainTree.Items[MainTree.SelectedItem].Level = 1 then Exit;
If MainTree.Items[MainTree.SelectedItem].Level = 2 then {в NUMBER заносится номер темы }
begin
number:= longint(MainTree.Items[MainTree.SelectedItem].Data);{в NUMBER заносится номер темы}
ind:= MainTree.SelectedItem;
end
else
begin
number:= longint(MainTree[MainTree.SelectedItem].Parent.Data);
ind:= MainTree[MainTree.SelectedItem].Parent.Index;
end;
AppendQuestion(number); {добавление нового вопроса в БД вопросов}
With MainTree.Items[ind] do
If HasItems then number:= GetLastChild - GetFirstChild + 2 {определение числа потомков + 2}
else number:= 1;
Str(number,Nodename); {номер вопроса в теме}
If MainTree.Items[MainTree.SelectedItem].Level = 2 then
begin
docIndex:= MainTree.AddChildObject(MainTree.SelectedItem,NodeName,
pointer(DBQuest.Fields[1].AsInteger));
MainTree.Items[MainTree.SelectedItem].Expand;
end
else {if... = 3}
docIndex:= MainTree.AddObject(MainTree.SelectedItem,NodeName,
pointer(DBQuest.Fields[1].AsInteger));
MainTree.Selecteditem:= docIndex; {установление фокуса на new вопрос}
end;
procedure TTreeForm.MainTreeClick(Sender: TObject);
Var
cur_id: longint;
NewAnswer: TAnswer;
del_count,i: integer;
begin
if MainTree.Items[MainTree.SelectedItem].Level = 1 then
begin
EditForm.QuestLabel.Hide;
EditForm.DBEditTema.Hide;
EditForm.MemoQuest.Hide;
EditForm.MemoScroll.Enabled:= False;
EditForm.AddAnswerBut.Enabled:= False;
EditForm.DelAnswerBut.Enabled:= False;
Exit;
end;
cur_id:= Longint(MainTree.Items[MainTree.SelectedItem].Data);
EditForm.QuestLabel.Show;
if MainTree.Items[MainTree.SelectedItem].Level = 3 then
begin
With TreeForm.DBQuest do begin {установка фильтра на БД вопросов }
SetKey;
Fields[1].AsInteger:= cur_id;
GotoKey;
end;
EditForm.DBEditTema.Hide;
EditForm.QuestLabel.Caption:= 'Текст вопроса';
EditForm.MemoQuest.Show;
EditForm.MemoScroll.Enabled:= True;
EditForm.AddAnswerBut.Enabled:= True;
EditForm.DelAnswerBut.Enabled:= True;
i:= 0; {индекс ДЛЯ ОБЪЕКТА TMemo в списке}
EditForm.DBAnswer.First; {чтобы не было глюков при повторном щелчке на вопросе}
while NOT EditForm.DBAnswer.Eof do
begin
If (i+1) > EditForm.MemoScroll.ComponentCount then
NewAnswer:= TAnswer.Create(EditForm.MemoScroll,100); {добавление new варианта ответа в список}
TMemo(EditForm.MemoScroll.Components[i]).Text:=
EditForm.DBAnswer.Fields[2].AsString; {Otvet_name}
TCheckBox(EditForm.MemoScroll.Components[i+1]).Checked:=
EditForm.DBAnswer.Fields[3].AsBoolean; {Otvet_name}
inc(i,2); // <--- увеличение индекса ДЛЯ ОБЪЕКТА TMemo в списке
EditForm.DBAnswer.Next;
end;
While i< EditForm.MemoScroll.ComponentCount do {удаление из списка лишних вариантов ответа}
TAnswer.DeleteAnswer(EditForm.MemoScroll,EditForm.MemoScroll.ComponentCount - 2);
If EditForm.MemoScroll.ComponentCount > 0 then TMemo(EditForm.MemoScroll.Components[0]).SetFocus; {Set focus on first answer.}
end
else {if level = 2, т.е. выбрана тема}
begin
With TreeForm.DBTema do begin {установка фильтра на БД тем }
SetKey;
Fields[0].AsInteger:= cur_id;
GotoKey;
end;
EditForm.AddAnswerBut.Enabled:= False;
EditForm.DelAnswerBut.Enabled:= False;
EditForm.MemoScroll.Enabled:= False;
EditForm.MemoQuest.Hide;
EditForm.QuestLabel.Caption:= 'Название темы';
EditForm.DBEditTema.Show;
end;
end;
procedure TTreeForm.DeleteButClick(Sender: TObject);
begin
If Maintree.SelectedItem = 1 then Exit;
If MainTree.Items[MainTree.SelectedItem].Level = 3 then
begin
If Application.MessageBox('Удалить вопрос ?','Удаление вопроса',
mb_YesNo+mb_IconQuestion+MB_DEFBUTTON2) = IdYes then
begin
ClearQuestion; // логическое удаление вопроса из БД
MainTree.Delete(MainTree.SelectedItem); {удаление текущего узла дерева}
end;
end
else
If Application.MessageBox('Удалить раздел ?','Удаление раздела',
mb_YesNo+mb_IconQuestion+MB_DEFBUTTON2) = IdYes then
begin
DBQuest.IndexName:= 'tema_ind';
DBQuest.SetKey;
DBQuest.Fields[0].AsInteger:= DBTema.Fields[0].AsInteger; // Fields[0] - Tema_Id
While DBQuest.GotoKey do ClearQuestion; // логическое удаление всех вопросов, принадлежащих теме
DBQuest.IndexName:= '';
DBTema.Delete; { Удаление выбранной темы }
{ DBTema.Edit; DBTema.Fields[1].Clear; DBTema.Post; // logical delete }
MainTree.Delete(MainTree.SelectedItem); {удаление текущего узла дерева}
end;
end;
procedure TTreeForm.FullExpButClick(Sender: TObject);
begin
MainTree.FullExpand;
end;
procedure TTreeForm.FullColButClick(Sender: TObject);
begin
MainTree.FullCollapse;
end;
procedure TTreeForm.ExitButClick(Sender: TObject);
begin
TreeForm.Close;
end;
procedure TTreeForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:= caFree;
EditForm.DBAnswer.Active:= False;
DBQuest.Active:= False;
DBTema.Active:= False;
end;
procedure TTreeForm.AddTemaButClick(Sender: TObject);
var
index: Longint;
FoundEmpty: boolean;
begin
WinEditTema.ShowModal;
If WinEditTema.ModalResult = mrOk then begin
FoundEmpty:= False;
DBTema.First;
While (not DBTema.EOF) and (not FoundEmpty) do {поиск записи в DBTEMA с пустым полем Tema_name}
begin
If DBTema.Fields[1].IsNull Then FoundEmpty:= True
else DBTema.Next;
end;
If FoundEmpty then DBTema.Edit
else DBTema.Append; {добавление новой темы в БД, если не найдено пустой}
DBTema['Tema_name']:= WinEditTema.TemaEdit.Text;
DBTema.Post;
AppendQuestion(DBTema.Fields[0].AsInteger); {добавление нового вопроса в БД }
index:= MainTree.AddChildObject(1,
DBTema.Fields[1].AsString,
pointer(DBTema.Fields[0].AsInteger)); {добавление new темы}
MainTree.AddChildObject(index,'1',
pointer(DBQuest.Fields[1].AsInteger)); {добавление пустого вопроса в тему}
If not MainTree.Items[1].Expanded then
MainTree.Items[1].Expand; {раскрытие корневого узла}
MainTree.Items[index].Expand; {раскрытие узла темы}
MainTree.Selecteditem:= index; {установление фокуса на new тему}
end;
end;
procedure TTreeForm.FormShow(Sender: TObject);
Var
cur_node,i: Longint;
node_name: string;
begin
if CreateMainForm then
begin
ProcessForm.Show;
DBTema.Active:= True; {Открытие БД тем и вопросов}
DBQuest.Active:= True;
ProcessForm.ProgressBar.Max:= DBTema.RecordCount + DBQuest.RecordCount;
While not DBTema.EOF do begin {загрузка дерева из БД}
ProcessForm.ProgressBar.StepIt;
If not DBTema.Fields[1].IsNull then
begin
cur_node:= MainTree.AddChildObject(1,
DBTema.Fields[1].AsString,
pointer(DBTema.FieldByName('Tema_id').AsInteger)); {добавление темы в дерево}
i:= 1;
While not DBQuest.EOF do begin
ProcessForm.ProgressBar.StepIt;
Str(i,node_name);
MainTree.AddChildObject(cur_node,node_name,
pointer(DBQuest.Fields[1].AsInteger));{добавление вопроса в тек.тему}
DBQuest.Next; inc(i);
end;
end;
DBTema.Next;
end; {while}
DBQuest.IndexName:= ''; {отключение связи между DBTema и DBQuest}
DBQuest.MasterFields:= '';
ProcessForm.Close;
CreateMainForm:= False;
end;
EditForm.Show;
end;
procedure TTreeForm.FormResize(Sender: TObject);
begin
if TreeForm.Height >= 300 then
MainTree.Height:= TreeForm.ClientHeight - Maintree.Top - x1
else
TreeForm.Height:= 300;
IF TreeForm.Width >= 263 then
MainTree.Width:= TreeForm.ClientWidth - MainTree.Left - x2
else
TreeForm.Width:= 263;
end;
procedure TTreeForm.FormCreate(Sender: TObject);
begin
CreateMainForm:= True;
x1:= ClientHeight - MainTree.Top - MainTree.Height;
x2:= ClientWidth - MainTree.Left - Maintree.Width;
TreeForm.Height:= GetSystemMetrics(SM_CYMAXIMIZED) - 10;
end;
procedure TTreeForm.AppendQuestion(temaId: longint);
{ Добавляет в таблицу DBQuest новый вопрос.
temaId - содержит значение темы, которой принадлежит вопрос
}
begin
DBQuest.IndexName:= 'tema_ind'; {подключение вторичного индекса}
DBQuest.SetKey; {поиск записи с 0-ым значением DBQuest.Tema_id}
DBQuest.Fields[0].AsInteger:= 0;
If DBQuest.GotoKey then {если найдена запись, то редактируем ее поля}
begin
DBQuest.IndexName:= ''; {отключение вторичного индекса}
DBQuest.Edit;
end
else {если не найдена такая запись, то добавляем новую}
begin
DBQuest.IndexName:= ''; {отключение вторичного индекса}
DBQuest.Append;
end;
DBQuest['Tema_id']:= TemaId;
DBQuest.Post;
end;
procedure TTreeForm.ClearQuestion;
{осуществляет логическое удаление текущего вопроса из БД}
begin
{обнуление параметра Quest_id во всех связанных записях БД answer.db}
EditForm.DBAnswer.First;
While not EditForm.DBAnswer.Eof do EditForm.ClearAnswer;
{обнуление tema_id текущего вопроса}
DBQuest.Edit;
DBQuest.Fields[0].AsInteger:= 0; // DBQUEST.Tema_id
DBQuest.Fields[2].AsString:= ''; // DBQUEST.QUest_name
DBQuest.Post;
end;
end.
Текст модуля DB_Unit
unit db_unit;
interface
uses
SysUtils, Windows, Messages, Classes, Graphics, Controls,
StdCtrls, Forms, Mask, Buttons,
DBTables, DB, DBCtrls;
type
TEditForm = class(TForm)
MemoQuest: TDBMemo;
QuestName: TLabel;
QuestLabel: TLabel;
DBEditTema: TDBEdit;
MemoScroll: TScrollBox;
AddAnswerBut: TSpeedButton;
DelAnswerBut: TSpeedButton;
DBAnswer: TTable;
AnswerSource: TDataSource;
DBAnswerOtvet_id: TAutoIncField;
DBAnswerQuest_id: TIntegerField;
DBAnswerOtvet_name: TMemoField;
DBAnswerTrued: TBooleanField;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure DBEditTemaChange(Sender: TObject);
procedure AddAnswerButClick(Sender: TObject);
procedure DelAnswerButClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure AppendAnswer(QuestId: longint);
procedure ClearAnswer;
procedure FormResize(Sender: TObject);
procedure MemoScrollResize(Sender: TObject);
private
x1,x2: integer; {вспомогательные переменные}
public
end;
TAnswer = Class(TObject)
memo: TMemo;
check: TCheckBox;
constructor Create(AOwner:TComponent;Height_: Integer);
procedure Free;
procedure CheckClick(Sender: TObject);
procedure MemoChange(Sender: TObject);
class procedure DeleteAnswer(AOwner: TComponent;Number: integer);
private
nocreate: boolean; {TRUE - if don't run the CREATE-constructor}
end;
var
EditForm: TEditForm;
implementation
uses S2;
{$R *.DFM}
procedure TEditForm.AppendAnswer(QuestId: longint);
{ Добавляет в таблицу DBQuest новый вопрос.
temaId - содержит значение темы, которой принадлежит вопрос
}
Var
i: integer;
Isinsert: boolean;
NewAnswer: TAnswer;
begin
IsInsert:= false; {True if NOT APPEND new record into database}
DBAnswer.MasterFields:= '';
DBAnswer.SetKey; {поиск записи с 0-ым значением DBAnswer.Tema_id}
DBAnswer.Fields[1].AsInteger:= 0;
If DBAnswer.GotoKey then
begin
DBAnswer.Edit;
IsInsert:= True;
end
else DBAnswer.Append;{если не найдена запись, то добавляем новую}
DBAnswer.Fields[1].AsInteger:= QuestId;
DBAnswer.Post;
DBAnswer.MasterFields:= 'Quest_id';
NewAnswer:= TAnswer.Create(MemoScroll,100); {добавление new варианта ответа в список}
If IsInsert then
begin
DBAnswer.First; i:=0;
While i < MemoScroll.ComponentCount do
begin
DBAnswer.Edit;
DBAnswerOtvet_name.Assign(Tmemo(MemoScroll.Components[i]).Lines);
DBAnswer.Fields[3].AsBoolean:= TCheckBox(MemoScroll.Components[i+1]).Checked;
DBAnswer.Post;
DBAnswer.Next; inc(i,2);
end;
end; {endif}
end;
procedure TEditForm.ClearAnswer;
{логическое удаление из БД текущего варианта ответа для текущнго вопроса}
begin
DBAnswer.Edit;
DBAnswer['Quest_id']:= 0;
DBAnswer.Fields[2].Clear; { Otvet_name }
DBAnswer['Trued']:= False;
DBAnswer.Post;
end;
constructor TAnswer.Create(AOwner:TComponent;Height_: Integer);
begin
NoCreate:= False;
memo:= TMemo.Create(Aowner);
memo.Parent:= TWinControl(AOwner);
With memo do begin
If ComponentIndex = 0 then
begin
Left:= 0; Top:= 0;
end
else
begin
Left:= 0;
Top:= TMemo(AOwner.Components[ComponentIndex-2]).Top +
TMemo(AOwner.Components[ComponentIndex-2]).Height;
end;
Width:= TScrollBox(AOwner).Width - 60;
Height:= Height_;
If (ComponentIndex div 2 + 1)*Height > TScrollBox(AOwner).VertScrollBar.Range
then TScrollBox(AOwner).VertScrollBar.Range:= (ComponentIndex div 2 + 1)*Height;
OnChange:= MemoChange;
SetFocus;
end; {end Init Memo}
check:= TCheckBox.Create(AOwner);
check.Parent:= TWinControl(AOwner);
With check do begin
Left:= Memo.Left + Memo.Width + 15;
Top:= Memo.Top + Memo.Height div 2;
Height:= 17;
Width:= 17;
OnClick:= CheckClick;
end;
NoCreate:= True;
end;
procedure TAnswer.Free;
begin
check.Free;
memo.Free;
end;
procedure TAnswer.CheckClick(Sender: TObject);
begin
If nocreate then begin
EditForm.DBAnswer.First;
EditForm.DBAnswer.MoveBy((Check.Componentindex-1) div 2);
EditForm.DBAnswer.Edit;
EditForm.DBAnswer['Trued']:= check.checked;
EditForm.DBAnswer.Post;
end;
end;
procedure TAnswer.MemoChange(Sender: TObject);
begin
If memo.Modified then
begin
EditForm.DBAnswer.First;
EditForm.DBAnswer.MoveBy(Memo.Componentindex div 2);
EditForm.DBAnswer.Edit;
EditForm.DBAnswerOtvet_name.Assign(Memo.Lines);
EditForm.DBAnswer.Post;
end;
end;
class procedure TAnswer.DeleteAnswer(AOwner: TComponent;Number: integer);
Var
i: integer;
{удаленние из списка объекта NUMBER и NUMBER+1}
begin
TCheckBox(AOwner.Components[number+1]).Free;
TMemo(AOwner.Components[number]).Free;
For i:= Number to AOwner.ComponentCount-1 do {перерисовка компонентов в ScrollBox}
If AOwner.Components[i] is TMemo then
TMemo(AOwner.Components[i]).Top:= TMemo(AOwner.Components[i]).Top -
TMemo(AOwner.Components[i]).Height
else
TCheckBox(AOwner.Components[i]).Top:= TCheckBox(AOwner.Components[i]).Top -
TMemo(AOwner.Components[i-1]).Height;
If AOwner.ComponentCount > 0 then
TScrollBox(AOwner).VertScrollBar.Range:= (AOwner.ComponentCount div 2)*
TMemo(AOwner.Components[0]).Height;
end;
procedure TEditForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
TreeForm.Close; {закрыть окно, содержащее дерево}
end;
procedure TEditForm.DBEditTemaChange(Sender: TObject);
begin
If DBEditTema.Modified Then
begin
TreeForm.DBTema.Post;
TreeForm.MainTree.Items[TreeForm.MainTree.SelectedItem].Text:= TreeForm.DBTema.Fields[1].AsString;
{модификация названия узла дерева, содержащего тему}
end;
end;
procedure TEditForm.AddAnswerButClick(Sender: TObject);
begin
AppendAnswer(TreeForm.DBQuest.Fields[1].AsInteger);
end;
procedure TEditForm.DelAnswerButClick(Sender: TObject);
var
CurAnswer,i: integer;
begin {удаленние из списка CURRENT ANSWER, если на нем стоит курсор}
i:= 0;
CurAnswer:= -1;
While i < MemoScroll.ComponentCount do
begin
If TMemo(MemoScroll.Components[i]).Focused then
CurAnswer:= TMemo(MemoScroll.Components[i]).ComponentIndex;
inc(i,2);
end;
if CurAnswer > -1 then
begin
EditForm.DBAnswer.First;
EditForm.DBAnswer.MoveBy(CurAnswer div 2);
ClearAnswer;
TAnswer.DeleteAnswer(MemoScroll,CurAnswer);
end;
end;
procedure TEditForm.FormCreate(Sender: TObject);
begin
EditForm.DBAnswer.Active:= True; {Открытие БД ответов}
x1:= ClientHeight - MemoScroll.Top - MemoScroll.Height;
x2:= ClientWidth - MemoScroll.Left - MemoScroll.Width;
EditForm.Height:= GetSystemMetrics(SM_CYMAXIMIZED) - 10;
end;
procedure TEditForm.FormResize(Sender: TObject);
begin
if EditForm.Height >= 300 then
MemoScroll.Height:= EditForm.ClientHeight - MemoScroll.Top - x1
else EditForm.Height:= 300;
IF EditForm.Width >= 300 then
begin
MemoScroll.Width:= EditForm.ClientWidth - MemoScroll.Left - x2;
MemoQuest.Width:= EditForm.ClientWidth - MemoQuest.Left - x2;
DBEditTema.Width:= EditForm.ClientWidth - DBEditTema.Left - x2;
end
else EditForm.Width:= 300;
end;
procedure TEditForm.MemoScrollResize(Sender: TObject);
var
i: integer;
begin
i:= 0;
While i < (MemoScroll.ComponentCount-1) do
begin
TMemo(MemoScroll.Components[i]).Width:= MemoScroll.Width - 60;
TCheckBox(MemoScroll.Components[i+1]).Left:=
TMemo(MemoScroll.Components[i]).Left + TMemo(MemoScroll.Components[i]).Width + 15;
inc(i,2);
end;
end;
end.
Текст модуля AddTema
unit addtema;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls;
type
TWinEditTema = class(TForm)
TemaEdit: TEdit;
TemaNameLabel: TLabel;
OkBtn: TBitBtn;
CancelBtn: TBitBtn;
procedure butCancelClick(Sender: TObject);
procedure butOkClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
WinEditTema: TWinEditTema;
implementation
{$R *.DFM}
procedure TWinEditTema.butCancelClick(Sender: TObject);
begin
Modalresult:= mrCancel;
end;
procedure TWinEditTema.butOkClick(Sender: TObject);
begin
Modalresult:= mrOk;
end;
end.
Текст модуля ProgrInd
unit progrInd;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls, ComCtrls;
type
TProcessForm = class(TForm)
Bevel1: TBevel;
ProgressBar: TProgressBar;
private
{ Private declarations }
public
{ Public declarations }
end;
var
ProcessForm: TProcessForm;
implementation
{$R *.DFM}
end.
Приложение 2
ТЕКСТ ПРОГРАММЫ TESTADMIN
program TestAdmin;
uses
Forms,
main in 'main.pas' {AdminForm},
TQDialog in 'TQDialog.pas' {CreateTickDlg},
ResultReport in 'ResultReport.pas' {ReportForm};
{$R *.RES}
begin
Application.Title:= 'TestAdmin';
Application.CreateForm(TAdminForm, AdminForm);
Application.CreateForm(TCreateTickDlg, CreateTickDlg);
Application.CreateForm(TReportForm, ReportForm);
Application.Run;
end.
Текст модуля Main
unit main;
interface
uses
Dialogs,IniFiles,SysUtils,Forms, DB, DBTables, Classes, Controls, Grids, DBGrids,
StdCtrls, Spin, ExtCtrls,Windows, Buttons, ComCtrls;
type
TAdminForm = class(TForm)
ControlSource: TDataSource;
DBControl: TTable;
DBControlId: TAutoIncField;
DBControlName: TStringField;
DBControlMark: TFloatField;
DBControlDate: TDateField;
DBControlTime: TTimeField;
Journal: TDBGrid;
DBControlTicket_num: TIntegerField;
DBControlOcenka: TFloatField;
Maxmark: TSpinEdit;
TestTime: TSpinEdit;
TimeLabel: TLabel;
MarkLabel: TLabel;
CreateTicketBtn: TBitBtn;
Bevel1: TBevel;
QuitBtn: TBitBtn;
ClearBtn: TBitBtn;
PrintBtn: TBitBtn;
Bevel2: TBevel;
Label1: TLabel;
StatusBar: TStatusBar;
procedure ShowHint(Sender: TObject);
procedure DBControlCalcFields(DataSet: TDataSet);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TestTimeChange(Sender: TObject);
procedure MaxmarkChange(Sender: TObject);
procedure CreateTicketBtnClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure QuitBtnClick(Sender: TObject);
procedure CreateNewDBControl;
procedure ClearBtnClick(Sender: TObject);
procedure PrintBtnClick(Sender: TObject);
private
CreateForm: boolean;
public
IniFile: TIniFile;
end;
var
AdminForm: TAdminForm;
implementation
uses TQDialog, PathDialog, ResultReport;
{$R *.DFM}
procedure TAdminForm.ShowHint(Sender: TObject);
begin
StatusBar.SimpleText:= Application.Hint;
end;
procedure TAdminForm.DBControlCalcFields(DataSet: TDataSet);
begin
DBControl.Fields[3].AsFloat:= DBControl.Fields[2].AsFloat * MaxMark.Value; // fields[2] - 'Mark'
end;
procedure TAdminForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
IniFile.Free;
Action:= caFree;
end;
procedure TAdminForm.TestTimeChange(Sender: TObject);
begin
IniFile.WriteInteger('Options', 'TestTime', TestTime.Value * 60000);
end;
procedure TAdminForm.MaxmarkChange(Sender: TObject);
begin
IniFile.WriteInteger('Options', 'MaxMark',MaxMark.Value);
end;
procedure TAdminForm.CreateTicketBtnClick(Sender: TObject);
begin
CreateTickDlg.ShowModal;
end;
procedure TAdminForm.CreateNewDBControl;
{создает новую таблицу DBControl. изменяет состояние DBControl.Active:= False}
begin
//--------- Create new local table CONTROL.DB --------------
with DBControl do
begin
Active:= False;
DatabaseName:= 'Common_base';
TableName:= 'Control';
TableType:= ttParadox;
with FieldDefs do
begin
Clear;
Add('Id',ftAutoInc, 0, False);
Add('Ticket_num', ftInteger, 0, False);
Add('Name',ftString, 40, False);
Add('Mark',ftFloat, 0, False);
Add('Date',ftDate, 0, False);
Add('Time',ftTime, 0, False);
end;
with IndexDefs do
begin
Clear;
Add('Id', 'Id', [ixPrimary, ixUnique]);
end;
CreateTable;
end;
//--------- end of create -------------------------
end;
procedure TAdminForm.FormShow(Sender: TObject);
Var
List: TStrings;
AliasPath: string;
begin
If CreateForm then
begin
Session.ConfigMode:= cmAll; {Global and local aliases !!!}
try
List:= TStringList.Create;
Session.GetAliasParams('Common_base',List); // may be occurs an error
AliasPath:= List.Values['PATH'];
List.Free;
except
end;
IniFile:= TIniFile.Create(AliasPath+'\Test.INI');
TestTime.Value:= IniFile.ReadInteger('Options', 'TestTime', 600000{10 min})div 60000;
MaxMark.Value:= IniFile.ReadInteger('Options', 'MaxMark', 5);
// CreateTickDlg.MaxTicket.Value:= IniFile.ReadInteger('Options', 'MaxTicket', 1);
try
DBControl.Active:= True;
except
CreateNewDBControl;
DBControl.Active:= True;
end;
CreateForm:= False;
end;
end;
procedure TAdminForm.FormCreate(Sender: TObject);
begin
CreateForm:= True;
Application.OnHint:= ShowHint;
end;
procedure TAdminForm.QuitBtnClick(Sender: TObject);
begin
Close;
end;
procedure TAdminForm.ClearBtnClick(Sender: TObject);
begin
CreateNewDBControl;
DBControl.Active:= True;
end;
procedure TAdminForm.PrintBtnClick(Sender: TObject);
begin
ReportForm.QuickReport.Preview;
end;
end.
Текст модуля TQDialog
unit TQDialog;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls, Spin, DB, DBTables, Grids, DBGrids;
type
TCreateTickDlg = class(TForm)
OKBtn: TBitBtn;
CancelBtn: TBitBtn;
Bevel1: TBevel;
QuestCount: TSpinEdit;
MaxTicket: TSpinEdit;
TickLabel: TLabel;
QuestLabel: TLabel;
DBGrid1: TDBGrid;
DBTicket: TTable;
TicketSource: TDataSource;
TemaSource: TDataSource;
DBTema: TTable;
DBQuest: TTable;
QuestSource: TDataSource;
procedure QuestCountEnter(Sender: TObject);
procedure OKBtnClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
CreateTickDlg: TCreateTickDlg;
implementation
uses main;
{$R *.DFM}
procedure TCreateTickDlg.QuestCountEnter(Sender: TObject);
begin
QuestCount.MaxValue:= DBQuest.RecordCount;
If QuestCount.MaxValue >1 then QuestCount.Increment:=1
else
begin
QuestCount.Value:= QuestCount.MaxValue;
QuestCount.Increment:= 0;
end;
end;
procedure TCreateTickDlg.OKBtnClick(Sender: TObject);
Var
List,List2: TList;
i,j,n: longint;
begin
//--------- Create new empty table TICKETS.DB --------------
with DBTicket do
begin
Active:= False;
DatabaseName:= 'Common_base';
TableName:= 'Tickets';
TableType:= ttParadox;
IndexName:= 'many_ind';
with FieldDefs do
begin
Clear;
Add('Ticket_id', ftAutoInc, 0, False);
Add('Ticket_num', ftInteger, 0, False);
Add('Quest_id', ftInteger, 0, False);
end;
with IndexDefs do
begin
Clear;
Add('', 'Ticket_id', [ixPrimary, ixUnique]);
Add('many_ind','Ticket_num;Quest_id',[ixCaseInsensitive]);
end;
CreateTable;
end;
//--------- end of create -------------------------
DBTicket.Active:= True;
DBQuest.First;
List:= TList.Create;
List2:= TList.Create;
for i:=1 to CreateTickDlg.QuestCount.Value do
begin
for j:=1 to CreateTickDlg.MaxTicket.Value do List.Add(pointer(j)); // fill list
randomize;
repeat
n:= random(List.Count-1);
DBTicket.SetKey;
DBTicket['Ticket_num']:= longint(List.Items[n]);
DBTicket['Quest_id']:= DBQuest['Quest_id'];
If DBTicket.GotoKey then
begin
List2.Add(List.Items[n]);
List.Delete(n);
Continue;
end
else
begin
DBTicket.Append;
DBTicket['Ticket_num']:= longint(List.Items[n]);
DBTicket['Quest_id']:= DBQuest['Quest_id'];
DBTicket.Post;
DBQuest.Next; If DBQuest.EOF then DBQuest.First;
List.Delete(n); //List.Pack;
While (List2.count > 0) do
begin
List.Add(List2.Items[0]);
List2.Delete(0);
end;
end;
until List.Count = 0;
end;
DBTicket.IndexName:= '';
DBTicket.DeleteIndex('many_ind');
DBTicket.AddIndex('tick_ind','Ticket_num',[ixCaseInsensitive]);
DBTicket.Active:= False;
List.Free;
List2.Free;
AdminForm.IniFile.WriteInteger('Options', 'MaxTicket',MaxTicket.Value);
Application.MessageBox('Формирование билетов завершено!','',MB_ICONINFORMATION);
end;
procedure TCreateTickDlg.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
DBQuest.Active:= False;
DBTema.Active:= False;
end;
procedure TCreateTickDlg.FormShow(Sender: TObject);
begin
DBTema.Active:= True;
DBQuest.Active:= True;
end;
end.
Текст модуля ResultReport
unit ResultReport;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Quickrep, StdCtrls, ExtCtrls;
type
TReportForm = class(TForm)
QuickReport: TQuickReport;
PageHeader: TQRBand;
Detail: TQRBand;
QRLabel1: TQRLabel;
TicketField: TQRDBText;
NameField: TQRDBText;
OcenkaField: TQRDBText;
DateField: TQRDBText;
ColumnHeader: TQRBand;
QRLabel2: TQRLabel;
QRLabel3: TQRLabel;
CurrentNum: TQRSysData;
QRLabel4: TQRLabel;
QRLabel5: TQRLabel;
QRLabel6: TQRLabel;
QRBand1: TQRBand;
QRLabel7: TQRLabel;
PageNum: TQRSysData;
private
{ Private declarations }
public
{ Public declarations }
end;
var
ReportForm: TReportForm;
implementation
uses main;
{$R *.DFM}
end.
Приложение 3
ТЕКСТ ПРОГРАММЫ TESTCLIENT
program TestClient;
uses
Forms,
Sdimain in 'SDIMAIN.PAS' {ClientForm},
DlgUnit in 'DlgUnit.pas' {BeginDataDlg},
PathDialog in '\$$$\ADMIN\PathDialog.pas' {PathDlg};
{$R *.RES}
begin
Application.Title:= 'TestClient';
Application.CreateForm(TClientForm, ClientForm);
Application.CreateForm(TBeginDataDlg, BeginDataDlg);
Application.Run;
end.
Текст модуля SdiMain
unit Sdimain;
interface
uses Windows,DBTables, DB, ExtCtrls, StdCtrls, Forms, Classes, Controls,
ComCtrls,SysUtils, Gauges, DBCtrls,Graphics;
type
TClientForm = class(TForm)
QuestList: TListBox;
Timer: TTimer;
TicketSource: TDataSource;
DBTicket: TTable;
DBTicketTicket_id: TAutoIncField;
DBTicketTicket_num: TIntegerField;
DBTicketQuest_id: TIntegerField;
AnswerSource: TDataSource;
DBAnswer: TTable;
DBAnswerOtvet_id: TAutoIncField;
DBAnswerQuest_id: TIntegerField;
DBAnswerOtvet_name: TMemoField;
DBAnswerTrued: TBooleanField;
ResultSource: TDataSource;
DBResult: TTable;
DBResultAnswer_id: TIntegerField;
DBResultTrued: TBooleanField;
MemoScroll: TScrollBox;
PrevBut: TButton;
NextBut: TButton;
ExitBut: TButton;
TestGauge: TGauge;
ControlSource: TDataSource;
DBControl: TTable;
QuestName: TDBMemo;
QuestSource: TDataSource;
DBQuest: TTable;
StatusBar: TStatusBar;
procedure ShowHint(Sender: TObject);
procedure QuestListClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ExitButClick(Sender: TObject);
procedure PrevButClick(Sender: TObject);
procedure NextButClick(Sender: TObject);
procedure TimerTimer(Sender: TObject);
procedure RefreshAnswers;
procedure DeleteAnswer(AOwner: TComponent;Number: integer);
procedure FormResize(Sender: TObject);
procedure MemoScrollResize(Sender: TObject);
private
x1,x2: integer;
public
CreateMainForm: boolean;
TestTime: LongInt; {время тестирования в миллисекундах }
MaxMark: LongInt; {система оценки(балл)}
ticket: longint; {Users ticket}
StudentName: string[40];
end;
TAnswer = Class(TObject)
memo: TMemo;
check: TCheckBox;
constructor Create(AOwner:TComponent;Height_: Integer);
procedure Free;
procedure CheckClick(Sender: TObject);
procedure MemoClick(Sender: TObject);
private
nocreate: boolean; {TRUE - if don't run the CREATE-constructor}
end;
var
ClientForm: TClientForm;
implementation
uses DlgUnit, PathDialog;
{$R *.DFM}
{----------------------------------}
procedure TClientForm.RefreshAnswers;
{Изменяет размеры области вывода ответов,содержимое ответов,число ответов
в зависимости от выбранного вопроса.}
Var
NewAnswer: TAnswer;
i: integer;
begin
DBTicket.First;
DBTicket.MoveBy(QuestList.ItemIndex); {Go to the selected Question}
i:= 0; {индекс ДЛЯ ОБЪЕКТА TMemo в списке}
DBAnswer.First; {чтобы не было глюков при повторном щелчке на вопросе}
while NOT DBAnswer.Eof do
begin
If (i+1) > MemoScroll.ComponentCount then
NewAnswer:= TAnswer.Create(MemoScroll,100); {добавление new варианта ответа в список}
TMemo(MemoScroll.Components[i]).Text:= DBAnswer['Otvet_name']; {Otvet_name}
TCheckBox(MemoScroll.Components[i+1]).Checked:= DBResult['Trued'];
inc(i,2); // <--- увеличение индекса ДЛЯ ОБЪЕКТА TMemo в списке
DBAnswer.Next;
end;
While i< MemoScroll.ComponentCount do {удаление из списка лишних вариантов ответа}
DeleteAnswer(MemoScroll,MemoScroll.ComponentCount - 2);
If MemoScroll.ComponentCount > 0 then
begin
TMemo(MemoScroll.Components[0]).SetFocus; {Set focus on first answer.}
QuestList.SetFocus; {and tnen set focus on questions-list}
end;
ClientForm.MemoScrollResize(MemoScroll); {изменение размеров областей вывода ответов}
end;
{----------------------------------}
constructor TAnswer.Create(AOwner:TComponent;Height_: Integer);
begin
NoCreate:= False;
memo:= TMemo.Create(Aowner);
with memo do begin
Parent:= TWinControl(AOwner);
ReadOnly:= True;
TabStop:= False;
Left:= 0;
OnClick:= MemoClick;
end;
check:= TCheckBox.Create(AOwner);
With check do begin
Parent:= TWinControl(AOwner);
Height:= 17;
Width:= 17;
TabStop:= False;
OnClick:= CheckClick;
end;
NoCreate:= True;
end;
procedure TAnswer.Free;
begin
check.Free;
memo.Free;
end;
procedure TAnswer.MemoClick(Sender: TObject);
begin
ClientForm.QuestList.SetFocus;
end;
procedure TAnswer.CheckClick(Sender: TObject);
begin
If nocreate then begin
ClientForm.DBAnswer.First; {передвигаем указатель в DBAnswer и вместе с ним в DBResult}
ClientForm.DBAnswer.MoveBy((Check.Componentindex-1) div 2);
ClientForm.DBResult.Edit;
ClientForm.DBResult['Trued']:= Check.Checked;
ClientForm.DBResult.Post;
ClientForm.QuestList.SetFocus;
end;
end;
procedure TClientForm.DeleteAnswer(AOwner: TComponent;Number: integer);
Var
i: integer;
{удаленние из списка объекта NUMBER и NUMBER+1}
begin
TCheckBox(AOwner.Components[number+1]).Free;
TMemo(AOwner.Components[number]).Free;
For i:= Number to AOwner.ComponentCount-1 do {перерисовка компонентов в ScrollBox}
If AOwner.Components[i] is TMemo then
TMemo(AOwner.Components[i]).Top:= TMemo(AOwner.Components[i]).Top -
TMemo(AOwner.Components[i]).Height
else
TCheckBox(AOwner.Components[i]).Top:= TCheckBox(AOwner.Components[i]).Top -
TMemo(AOwner.Components[i-1]).Height;
If AOwner.ComponentCount > 0 then
TScrollBox(AOwner).VertScrollBar.Range:= (AOwner.ComponentCount div 2)*
TMemo(AOwner.Components[0]).Height;
end;
procedure TClientForm.ShowHint(Sender: TObject);
begin
StatusBar.SimpleText:= Application.Hint;
end;
procedure TClientForm.FormShow(Sender: TObject);
begin
If CreateMainForm then BeginDataDlg.ShowModal;
end;
procedure TClientForm.QuestListClick(Sender: TObject);
begin
RefreshAnswers;
end;
procedure TClientForm.FormClose(Sender: TObject; var Action: TCloseAction);
Var
Quest_cnt, {всего вопросов}
MyAnswerTrued, {1 - если ответ правильный}
TruedCnt: word; {количество правильных ответов}
SumTrued: real; {относительная оценка}
S: string;
begin
{действия по получению оценки и выводу ее на экран и в БД}
If BeginDataDlg.ModalResult <> mrOk then Exit;
quest_cnt:= 0; SumTrued:= 0; MyAnswerTrued:= 0; TruedCnt:= 0;
DBTicket.First;
while not DBTicket.EOF do
begin
inc(quest_cnt);
DBAnswer.First;
while not DBAnswer.EOF do
begin
If DBResult['Trued'] = DBAnswer['Trued'] then MyAnswerTrued:= 1
else
begin
MyAnswerTrued:= 0; {Ответ на вопрос неверен.}
Break; {выход из цикла}
end;
DBAnswer.Next;
end;
DBTicket.Next;
TruedCnt:= TruedCnt + MyAnswerTrued;
end;
SumTrued:= TruedCnt / quest_cnt; {средний бал 0..1}
Str((SumTrued*ClientForm.MaxMark):5:2,S);
Application.MessageBox(PChar('Правильных ответов: '+
IntToStr(TruedCnt)+' из '+IntToStr(Quest_cnt)+
#13+'Оценка: ' + s),
'Результат тестирования',MB_ICONINFORMATION);
DBResult.Active:= False; {Close databases}
DBAnswer.Active:= False;
DBQuest.Active:= False;
DBTicket.Active:= False;
DBControl.Active:= True; {Save info of current user in CONTROL.DB}
DBControl.Append;
DBControl['Date']:= Date;
DBControl['Time']:= Time;
DBControl['Ticket_num']:= ticket;
DBControl['Mark']:= SumTrued;
DBControl['Name']:= StudentName;
DBControl.Post;
DBControl.Active:= False;
end;
procedure TClientForm.FormCreate(Sender: TObject);
begin
CreateMainForm:= True;
x1:= ClientHeight - MemoScroll.Top - MemoScroll.Height;
x2:= ClientWidth - MemoScroll.Left - MemoScroll.Width;
ClientForm.Height:= GetSystemMetrics(SM_CYMAXIMIZED) - 10;
end;
procedure TClientForm.ExitButClick(Sender: TObject);
begin
Close;
end;
procedure TClientForm.PrevButClick(Sender: TObject);
begin
QuestList.ItemIndex:= QuestList.ItemIndex - 1;
RefreshAnswers;
end;
procedure TClientForm.NextButClick(Sender: TObject);
begin
QuestList.ItemIndex:= QuestList.ItemIndex + 1;
RefreshAnswers;
end;
procedure TClientForm.TimerTimer(Sender: TObject);
begin
TestGauge.AddProgress(Timer.Interval);
TestTime:= TestTime - Timer.Interval;
If TestGauge.PercentDone > 75 then TestGauge.BackColor:= clYellow;
If TestTime = 0 then Close; {в OnClose д/б предусмотрен расчет оценки и запись ее в БД}
end;
procedure TClientForm.FormResize(Sender: TObject);
begin
if ClientForm.Height >= 400 then
begin
MemoScroll.Height:= ClientForm.ClientHeight - MemoScroll.Top - x1;
QuestList.Height:= ClientForm.ClientHeight - QuestList.Top - x1;
StatusBar.Top:= ClientForm.ClientHeight - StatusBar.Height;
PrevBut.Top:= StatusBar.Top - PrevBut.Height - 6; {modify buttons place}
NextBut.Top:= PrevBut.Top; ExitBut.Top:= NextBut.Top;
end
else ClientForm.Height:= 400;
IF ClientForm.Width >= 440 then
begin
MemoScroll.Width:= ClientForm.ClientWidth - MemoScroll.Left - x2;
QuestName.Width:= ClientForm.ClientWidth - QuestName.Left - x2;
TestGauge.Width:= ClientForm.ClientWidth - TestGauge.Left - x2;
StatusBar.Width:= ClientForm.ClientWidth;
end
else ClientForm.Width:= 440;
end;
procedure TClientForm.MemoScrollResize(Sender: TObject);
{этот обработчик вызывается также в RefreshAnswers}
var
i,CommonHeight: integer;
begin
i:= 0; CommonHeight:= 0;
While i < (MemoScroll.ComponentCount-1) do
begin
If i>0 then TMemo(MemoScroll.Components[i]).Top:=
TMemo(MemoScroll.Components[i-2]).Top +
TMemo(MemoScroll.Components[i-2]).Height;
TMemo(MemoScroll.Components[i]).Width:= MemoScroll.Width - 60;
TMemo(MemoScroll.Components[i]).Height:=
Trunc((2-1/3)*Abs(TMemo(MemoScroll.Components[i]).Font.Height)*
TMemo(MemoScroll.Components[i]).Lines.Count);
TCheckBox(MemoScroll.Components[i+1]).Left:=
TMemo(MemoScroll.Components[i]).Left + TMemo(MemoScroll.Components[i]).Width + 15;
TCheckBox(MemoScroll.Components[i+1]).Top:=
TMemo(MemoScroll.Components[i]).Top + (TMemo(MemoScroll.Components[i]).Height-
TCheckBox(MemoScroll.Components[i+1]).Height) div 2;
CommonHeight:= CommonHeight + TMemo(MemoScroll.Components[i]).Height;
inc(i,2);
end;
MemoScroll.VertScrollBar.Range:= CommonHeight;
end;
end.
Текст модуля DlgUnit
unit DlgUnit;
interface
uses Db,Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
IniFiles,Buttons, ExtCtrls, Spin, ComCtrls;
type
TBeginDataDlg = class(TForm)
EditName: TEdit;
Label1: TLabel;
TicketEdit: TSpinEdit;
Label2: TLabel;
Bevel1: TBevel;
OkBut: TBitBtn;
QuitBut: TBitBtn;
StatusBar: TStatusBar;
procedure ShowHint(Sender: TObject);
procedure OkButClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
BeginDataDlg: TBeginDataDlg;
implementation
uses Sdimain, PathDialog;
{$R *.DFM}
procedure TBeginDataDlg.ShowHint(Sender: TObject);
begin
StatusBar.SimpleText:= Application.Hint;
end;
procedure TBeginDataDlg.OkButClick(Sender: TObject);
Var
i: integer;
begin
with ClientForm do
begin
StudentName:= EditName.Text;
Ticket:= TicketEdit.Value;
DBTicket.Active:= True;
{Выбор номера билета. Выбранный номер билета заносим в Ticket}
DBTicket.SetRangeStart; {установка фильтра}
DBTicket['Ticket_num']:= ticket;
DBTicket.SetRangeEnd;
DBTicket['Ticket_num']:= ticket;
DBTicket.ApplyRange;
DBQuest.Active:= True;
with DBResult do //--------- Create new local table RESULT.DB ----------
begin
Active:= False;
DatabaseName:= '';
TableName:= 'Result';
TableType:= ttParadox;
with FieldDefs do
begin
Clear;
Add('Answer_id', ftInteger, 0, False);
Add('Trued', ftBoolean, 0, False);
end;
with IndexDefs do
begin
Clear;
Add('Answer_ind', 'Answer_id', [ixPrimary, ixUnique]);
end;
CreateTable;
end; //--------- end of create -------------------------
DBAnswer.Active:= True;
DBresult.Active:= True;
i:=0; {заполнение QuestList номерами вопросов}
While not DBTicket.EOF do
begin
inc(i);
QuestList.Items.Add(IntToStr(i));
While not DBAnswer.EOF do {Fill RESULT-table}
begin
DBResult.Append;
DBResult['Answer_id']:= DBAnswer['Otvet_id'];
DBResult['Trued']:= False;
DBResult.Post;
DBAnswer.Next;
end;
DBTicket.Next;
end;
RefreshAnswers;
WindowState:= wsNormal;
Application.OnHint:= ShowHint;
TestGauge.MaxValue:= TestTime; {Set max value of indicator }
Timer.Enabled:= True; { Activate the timer.}
CreateMainForm:= False;
end; { of with ClientForm}
end;
procedure TBeginDataDlg.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
If Modalresult <> mrOk then ClientForm.Close;
Action:= caFree;
end;
procedure TBeginDataDlg.FormShow(Sender: TObject);
Var
IniFile: TIniFile;
List: TStringList;
AliasPath: string;
begin
Application.OnHint:= ShowHint;
Session.ConfigMode:= cmAll; {Global and local aliases !!!}
try
List:= TStringList.Create;
Session.GetAliasParams('Common_base',List); // may be occurs an error
AliasPath:= List.Values['PATH'];
List.Free;
except
Application.CreateForm(TPathDlg, PathDlg);
PathDlg.ShowModal;
If PathDlg.Modalresult = mrOk then
begin
AliasPath:= PathDlg.DirectoryList.Directory;
Session.AddStandardAlias('Common_base',AliasPath,'PARADOX'); {add NEW alias if none}
Session.SaveConfigFile;
end
else Modalresult:= mrCancel;
end;
IniFile:= TIniFile.Create(AliasPath+'\Test.INI');
ClientForm.TestTime:= IniFile.ReadInteger('Options', 'TestTime', 600000{10 min});
TicketEdit.MaxValue:= IniFile.ReadInteger('Options', 'MaxTicket', 1);
If TicketEdit.MaxValue = 1 then TicketEdit.Increment:= 0;
IniFile.Free;
end;
end.
Текст модуля PathDialog
unit PathDialog;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls, FileCtrl;
type
TPathDlg = class(TForm)
OKBtn: TButton;
CancelBtn: TButton;
DirectoryList: TDirectoryListBox;
DriveBox: TDriveComboBox;
PathLabel: TEdit;
Label1: TLabel;
procedure DriveBoxChange(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure DirectoryListChange(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
PathDlg: TPathDlg;
implementation
{$R *.DFM}
procedure TPathDlg.DriveBoxChange(Sender: TObject);
begin
DirectoryList.Drive:= DriveBox.Drive;
end;
procedure TPathDlg.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:= caFree;
end;
procedure TPathDlg.DirectoryListChange(Sender: TObject);
begin
PathLabel.Text:= DirectoryList.Directory;
end;
procedure TPathDlg.FormActivate(Sender: TObject);
begin
PathLabel.Text:= DirectoryList.Directory;
end;
end.
0 комментариев