Курсовая ( Мюнсберга и Когана ) / 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.