Курсовая ( Мюнсберга и Когана ) / Filippse_Half

unit Filippse_Half;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Buttons, Data.DB, Data.Win.ADODB, Vcl.Grids, HTMLHelpViewer,
Vcl.DBGrids;

type
TFTest = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
Panel4: TPanel;
LHint: TLabel;
LOk: TLabel;
TimerAll: TTimer;
ADOQProt: TADOQuery;
ADOQRes: TADOQuery;
ADOQResID: TAutoIncField;
ADOQResID_Result: TIntegerField;
ADOQResID_Testing: TIntegerField;
ADOQResID_Param: TIntegerField;
ADOQResValue_Result: TWideStringField;
ADOQParamRes: TADOQuery;
ADOQParamResID: TAutoIncField;
ADOQParamResID_ParamResult: TIntegerField;
ADOQParamResParametr: TWideStringField;
ADOQParamResMin_Value: TWideStringField;
ADOQParamResMax_Value: TWideStringField;
BBVse: TBitBtn;
MText: TMemo;
ESlovo: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
ADOQAnsw: TADOQuery;
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure FormActivate(Sender: TObject);
procedure TimerAllTimer(Sender: TObject);
procedure BBVseClick(Sender: TObject);
procedure ESlovoKeyPress(Sender: TObject; var Key: Char);
procedure FormCreate(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;

var
FTest: TFTest;
t1 , t2: integer;

implementation
Uses
Main, Variable, result1, unit2;

{$R *.dfm}

{var

FF : textfile;}

procedure TFTest.FormKeyPress(Sender: TObject; var Key: Char);
begin

// выход из программы по клавише эскейп
If Key = #27 then
begin
Close;
end;
end;

procedure TFTest.FormActivate(Sender: TObject);

begin
i:=1;
// подготовка формы к запуску, запуск таймера
TimerAll.Enabled := true;
TAll:=now;
TAnsw:=now;

SetBounds( Left - ClientOrigin.X, Top - ClientOrigin.Y, GetDeviceCaps(
Canvas.handle, HORZRES ) + (Width - ClientWidth), GetDeviceCaps( Canvas.handle,VERTRES )
+ (Height - ClientHeight ));
LOk.Left:= 2 * (FTest.Width div 4) - (LOk.Width div 2);
BBVse.Left:= 2 * (FTest.Width div 4) - (BBVse.Width div 2);
ESlovo.Left:= 2 * (FTest.Width div 4) - (ESlovo.Width div 2);
Label3.Left:= 2 * (FTest.Width div 4) - (Label3.Width div 2);
MText.Left:= 2 * (FTest.Width div 4) - (MText.Width div 2);
Label1.Left:= 2 * (FTest.Width div 8) - (Label1.Width div 2);
Label2.Left:= Label1.Left;


end;

procedure TFTest.FormCreate(Sender: TObject);
begin
{ TTimeNow.Enabled:=true; }
end;

procedure TFTest.BBVseClick(Sender: TObject);
const
KeySlova :array [1..25] of string = ('солнце', 'район', 'новость', 'факт', 'экзамен', 'прокурор', 'теория', 'хоккей', 'троица', 'телевизор', 'память', 'восприятие', 'любовь', 'спектакль', 'радость', 'народ', 'репортаж', 'конкурс', 'личность', 'комедия', 'отчаяние', 'лаборатория', 'основание', 'кентавр', 'психиатрия');
var
code_param, j,k : integer;
bilo : set of 0..25;
TimeN : TDateTime;

begin
bilo:=[0];
// подсчёт набранного балла
for k := 1 to 50 do
begin
for j := 1 to 25 do
begin
if (Slova[k]=keyslova[j]) and not(j in bilo) then
begin
res:=res+1;
bilo:=bilo+[j]; //проверка на то, было ли уже это слово или нет
end;
end;
end;
i:=1;
// загрузка результата тестирования в бд
ADOQParamRes.SQL.Clear;
ADOQParamRes.SQL.Add('SELECT * FROM ParamResult WHERE Parametr = '+QuotedStr('Ваш балл:'));
ADOQParamRes.Active := True;
Code_Param := ADOQParamRes.FieldByName('ID_ParamResult').AsInteger;
ADOQRes.SQL.Clear;
ADOQRes.SQL.Add('INSERT INTO Result (ID_Result, ID_Testing, ID_Param, Value_Result)VALUES('+IntToStr(FStart.LRes.ItemIndex + 1)+',1,'+IntToStr(Code_Param)+', '+IntToStr(res)+')');
ADOQRes.ExecSQL;
TimeN:=now; // определение времени прохождения тестирования
TAll:=TimeN-TAll;
with ADOQProt do // занесение времени в протокол в бд
begin
with SQL do
begin
Clear;
Add('INSERT INTO Protocol (ID_Protocol, ID_Testing, TimeAnswer)VALUES('+IntToStr(FStart.LRes.ItemIndex + 1)+',1,'+QuotedStr(TimeToStr(TAll))+')');
ExecSQL;
end;
end;
close;
Main.FMain.BBTest.Visible := false;
Main.FMain.BBRes.Visible := true;
end;



procedure TFTest.ESlovoKeyPress(Sender: TObject; var Key: Char);
var
TAnswN,time: TDateTime;
word: string;

begin
if Key= #13 then // при нажатии на <enter> запись очередного слова и вывод его справа
begin
inc(ID_Answer);
Slova[i]:=ESlovo.Text;
i:=i+1;
label1.Caption:=slova[i-1];
label2.Visible:=True;
TAnswN := Now;
Time := TAnswN - TAnsw;
TAnsw := TAnswN;
word:=ESlovo.Text;
with ADOQAnsw do
begin
with SQL do
begin
Clear;
Add('INSERT INTO Answer (ID_ProtocolAnsw, ID_Testing, ID_Answer, TimeAnswer, AnswerWord)VALUES(1,1, '+IntToStr(ID_Answer)+','+QuotedStr(TimeToStr(Time))+','+QuotedStr(word)+')');
ExecSQL;
end;
end;
ESlovo.Text:='';
end;
end;





procedure TFTest.TimerAllTimer(Sender: TObject);
const
KeySlova :array [1..25] of string = ('солнце', 'район', 'новость', 'факт', 'экзамен', 'прокурор', 'теория', 'хоккей', 'троица', 'телевизор', 'память', 'восприятие', 'любовь', 'спектакль', 'радость', 'народ', 'репортаж', 'конкурс', 'личность', 'комедия', 'отчаяние', 'лаборатория', 'основание', 'кентавр', 'психиатрия');
var
code_param, j, k : integer;
TimeN : TDateTime ;
bilo : set of 0..25;
begin
TimeN:=now;

// завершить тестирование по истечении времени
MessageDlg('Время выполнения теста истекло!', mtWarning, [mbOk], 0);
// тест выполнен по окончанию времени
// необходимо в БД записать результаты тестирования
bilo:=[0];
// подсчёт набранного балла
for k := 1 to 50 do
begin
for j := 1 to 25 do
begin
if (Slova[k]=keyslova[j]) and not(j in bilo) then
begin
res:=res+1;
bilo:=bilo+[j]; //проверка на то, было ли уже это слово или нет
end;
end;
end;
ADOQParamRes.SQL.Clear;
ADOQParamRes.SQL.Add('SELECT * FROM ParamResult WHERE Parametr = '+QuotedStr('Ваш балл:'));
ADOQParamRes.Active := True;
Code_Param := ADOQParamRes.FieldByName('ID_ParamResult').AsInteger;
ADOQRes.SQL.Clear;
ADOQRes.SQL.Add('INSERT INTO Result (ID_Result, ID_Testing, ID_Param, Value_Result)VALUES('+IntToStr(FStart.LRes.ItemIndex + 1)+',1,'+IntToStr(Code_Param)+', '+IntToStr(res)+')');
ADOQRes.ExecSQL;
// занесение времени прохождения в протокол при остановке таймером
TAll:=TimeN-TAll;
with ADOQProt do
begin
with SQL do
begin
Clear;
Add('INSERT INTO Protocol (ID_Protocol, ID_Testing, TimeAnswer)VALUES('+IntToStr(FStart.LRes.ItemIndex + 1)+',1,'+Quotedstr(TimeToStr(TAll))+')');
ExecSQL;
end;
end;
Main.FMain.BBTest.Visible := false;
Main.FMain.BBRes.Visible := true;
FTest.Close;
TimerAll.Enabled := false;

end;

end.