unit uMainTestTask;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, DB, ADODB, uSystem, jpeg;

type

  TfMainTestTask = class(TForm)
    Label1: TLabel;
    mQuestion: TMemo;
    rgAnswers: TRadioGroup;
    btnNext: TButton;
    Image1: TImage;
    procedure btnExitClick(Sender: TObject);
    procedure btnNextClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
  Public
     Answers  : TStringList;  // Список ответов для соответствующего вопроса
     Question : TQuestion;    // Текущий вопрос


     TaskQuestions      : Array[1..9] of TQuestion; // перечень вопросов для теста
     UserResultsArray   : Array[1..9] of Byte;   // Вектор результатов
     PupilResultsArray  : Array[1..9] of Byte;
     TestResultArray    : Array[1..8] of Byte;

     QuestionCount      : Word;     // Общее количество вопросов для данного теста
     BaseQuestion       : Integer;  // "центральный" вопрос

     StepsCounter       : Byte; // текущий шаг
     ResultsCounter     : Byte;  // текущая позиция в PupilResultsArray

     LeftQuestionNo     : Byte; // текущий номер "левого" вопроса
     RightQuestonNo     : Byte; // текущий номер "правого" вопроса

     Matrix     : TMatrix;
     BaseVector : TVektor;
     i, j       : Integer;
     N,D1,D2    : integer;

     Procedure ReDraw;
     Procedure InitTaskValues;

     Function GetStrPupilArray : String;
     Function GetStrTestArray  : String;
     Function GetResult(PupilVector, TestVector : String) : Integer;

  End;

var
  fMainTestTask: TfMainTestTask;

implementation

uses uMain;

{$R *.dfm}

Procedure TfMainTestTask.InitTaskValues;
Var
  i, j     : Integer;
Begin
  QuestionCount    := 9;  // Общее количество вопросов для данного теста
  StepsCounter     := 0;
  ResultsCounter   := 0;
  BaseQuestion     := 5;
  LeftQuestionNo   := BaseQuestion - 1;  // счётчик для понижения сложности
  RightQuestonNo   := BaseQuestion + 1;  // счётчик для повышения сложности.

  Question.Chapter := fMain.ActiveChapter;
  Question.Type_   := 'Задача';

  // Первоначально создаём список вопросов со сложностями от 1 до 9
  For i := 1 to 9 do
  Begin
    GetTaskQuestion(Question, i);
    TaskQuestions[i] := Question;
  End;

  // Инициализируем констатнтный вектор
  For i := 1 to _2_N(nMax) do
    BaseVector[i] := _2_N(nMax) - i + 1;

  // Инициализируем матрицу
  For i := 1 to _2_N(nMax) do
  Begin
     For j := 1 to (_2_N(nMax) div 2) do
     Begin
        Matrix[i, j] := BaseVector[GetNumber(i, j, nMax) + 1];
     End;
  End;
  
End;

Procedure TfMainTestTask.ReDraw;
Var
  i : Word;
  QuestionPos : Integer;
Begin
   Question.Type_ := 'Задача';
   Answers        := TStringList.Create;
   QuestionPos    := BaseQuestion;  // номер выбираемого вопроса

   If BaseQuestion < 0 then  // необходимо понизить сложность ?
      Begin
         If StepsCounter <> 0 then  // если выполняем не первый раз
         Begin
           QuestionPos := LeftQuestionNo; // понижаем сложность
           Dec(LeftQuestionNo);
           PupilResultsArray[ResultsCounter] := 2;
         End;
      End
   Else
      Begin
         If StepsCounter <> 0 then
         Begin
           QuestionPos := RightQuestonNo;  // повышаем сложность
           PupilResultsArray[ResultsCounter] := 1;
           Inc(RightQuestonNo);
         End;
      End;

   Question := TaskQuestions[QuestionPos];

   GetAnswers(Question, Answers); // Выбираем ответы

   mQuestion.Text := Question.Value;
   rgAnswers.Items.Clear;

   rgAnswers.Height := 0;

   For i := 0 to Answers.Count-1 do
   Begin
      rgAnswers.Items.Add(Answers[i]);
      rgAnswers.Height := rgAnswers.Height + 35;
   End;

   Height := rgAnswers.Top + rgAnswers.Height + 50;
   rgAnswers.ItemIndex := -1;

   Answers.Free;

   If StepsCounter <> 0 then Inc(ResultsCounter);  //если выполняем не первый раз

   Inc(StepsCounter);
End;

Procedure TfMainTestTask.FormShow(Sender: TObject);
Begin
  InitTaskValues;
  ReDraw;
End;

procedure TfMainTestTask.btnExitClick(Sender: TObject);
begin
  If Application.MessageBox('Вы уверены, то хотите закончить тестирование?',
                            'Внимание',
                             MB_ICONEXCLAMATION+MB_YESNO) = idYes then
  Begin
    Close;
  End;

End;

procedure TfMainTestTask.btnNextClick(Sender: TObject);
Var
  TestVector  : String;
  PupilVector : String;
  Result,Result1      : Integer;
Begin

 If rgAnswers.ItemIndex = -1 then Application.MessageBox('Ответ не выбран!',
                                                         'Внимание',
                                                          MB_ICONEXCLAMATION+MB_OK)
 Else
   Begin
     If IsAnswerTrue(Question, rgAnswers.Items[rgAnswers.ItemIndex]) = True then
       Begin
         PupilResultsArray[ResultsCounter] := 1;
         If BaseQuestion < 0 then BaseQuestion := Abs(BaseQuestion);
       End
     Else
       Begin
         PupilResultsArray[ResultsCounter] := 2;
         BaseQuestion := -Abs(BaseQuestion);
       End;

     Inc(ResultsCounter);

     If StepsCounter >= Abs(BaseQuestion) then
       Begin
        PupilVector := GetStrPupilArray;
        TestVector  := GetStrTestArray;
        Result := GetResult(PupilVector, TestVector);

        If (Result <= 512) and (Result >= 420) then
        Begin
          ShowMessage('Результат: 5 ');
          Result1:=5;
        End;

        If (Result < 420) and (Result >= 312) then
        Begin
          ShowMessage('Результат: 4 ');
          Result1:=4;
        End;

        If (Result < 312) and (Result >= 212) then
        Begin
          ShowMessage('Результат: 3 ');
          Result1:=3;
        End;

        If (Result < 212)  then
        Begin
          ShowMessage(' Вы плохо усвоили материал, результаты вашего теста очень плохие.' + 
  ' Поэтому Вы переходите на полную форму обучения!');
          fMain.IsFullType := True;
          Result1:=2;
       End;
            //начали заносить информацию в базу данных

            With fMain.Query do
            Begin
                Close;
                SQL.Clear;
                SQL.Add('INSERT INTO Тесты ');
                SQL.Add('(КодУченика,ТипТеста,Оценка) VALUES('+IntToStr(fMain.KodUchenika)+
  ',"Задача",'+ IntToStr(Result1) +');');
                ExecSQL;
            end;
            //закончили заносить информацию в базу данных
         fMainTestTask.Close;
       End
     Else
       ReDraw;
   End;
End;

function TfMainTestTask.GetStrTestArray: String;
Var
  i : Word;
  S : String;
begin
  S := '';
  For i := 1 to 8 do
  Begin
    TestResultArray[i] := PupilResultsArray[i];
    S :=  S + IntToStr(PupilResultsArray[i]);
  End;

  GetStrTestArray := S;
end;

function TfMainTestTask.GetStrPupilArray: String;
Var
  i : Word;
  S : String;
begin
  S := '';
  For i := 1 to 9 do
  Begin
    S :=  S + IntToStr(PupilResultsArray[i]);
  End;

   GetStrPupilArray := S;
end;

function TfMainTestTask.GetResult(PupilVector,
  TestVector: String): Integer;
Var
  X, Y : Word;
  i    : Integer;
begin
  For i := 1 to 9 do
  Begin
    If PupilVector[i] = '2' then
      PupilVector[i] := '1'
    Else
      PupilVector[i] := '0';
  End;

  For i := 1 to 8 do
  Begin
    If TestVector[i] = '2' then
      TestVector[i] := '1'
    Else
      TestVector[i] := '1';
  End;

  X := ToDec(PupilVector, 2);
  Y := ToDec(TestVector, 2);

  GetResult := Matrix[X, Y];
end;

End.

Unit uSystem;

Interface

Uses SysUtils, Classes, DB, ADODB;

Const
   nMax = 9;

Type
   TMatrix = array [ 1..512, 1..256 ] of Integer;

   TVektor = array [ 1..512 ]         of Integer;

  Function GetTaskQuestion(Var Question : TQuestion; Level : Byte) : Boolean;

  Function _2_N ( N : Integer ) : Integer;
  Function Bit( X : Integer;  N : Integer ) : Integer;
  Function Vektor( X, N : Integer ) : String;
  Function GetNumber ( n1, n2, n : Integer ) : Integer;
  function ToDec(n:string; radix:longint):longint;

Implementation

uses uMain;

Var
  i, QuestionNo, QuestionsCount : Word;


Function GetTaskQuestion(Var Question : TQuestion; Level : Byte) : Boolean;
Var
  i, QuestionNo, QuestionsCount : Word;
Begin
  // Получаем список всех вопросов главы Question.Chapters
  With fMain.Query do
  Begin
     Close;
     SQL.Clear;
     SQL.Add(' SELECT * ');
     SQL.Add(' FROM Вопросы ');
     SQL.Add(' WHERE КодГлавы   = '  + IntToStr(Question.Chapter.Key) + '  ');
     SQL.Add('   AND Тип        = "Задача" ');
     SQL.Add('   AND Сложность  = "'  + IntToStr(Level)       + '" ');
     SQL.Add(' ORDER BY Вопрос ');

     Open;

     If IsEmpty then
     Begin
        GetTaskQuestion := False;
        Exit;
     End;

     // Получаем количество вопросов для данной главы
     QuestionsCount := 0;
     First;
     While Not EOF do
     Begin
       Inc(QuestionsCount);
       Next;
     End;

     // Случайным образом выбираем вопрос
     Randomize;
     QuestionNo := Random(QuestionsCount) + 1;

     // Переходим на запись QuestionNo
     First;
     For i := 1 to QuestionNo do Next;

     Question.Key   := FieldByName('КодВопроса').AsInteger;
     Question.Value := FieldByName('Вопрос').AsString;
  End;

  GetTaskQuestion := True;
End;

Function _2_N ( N : Integer ) : Integer;
Begin
  _2_N := 1 shl n;  
End;

Function Bit( X : Integer;  N : Integer ) : Integer;
Var
   B : Integer;
Begin
  B := 1 shl (n-1);
  Bit := 0;

  If (X and B) <> 0 then
    Bit:=1;
End;

Function Vektor( X, N : Integer ) : String;
Var
  I : Integer;
  S : String;
Begin
  S := '( ';

  For i := 1 to n do
  Begin
     If Bit(X, N - i + 1 ) = 0 then
       S := S + '1, '
     Else
       S := S + '2, ';
  End;

  S[ Length(S) - 1 ] := ' ';
  S[ Length(S)     ] := ')';

  Vektor := S;
End;

Function GetNumber ( n1, n2, n : Integer ) : Integer;
var
  i, k, rez : integer;
Begin
  k := Bit(n1,n);
  Rez:=k shl (n-1);

  For i := n - 1 downto 1 do
  Begin
    If (i and 1) = 0 then
    Begin
      k   := Bit(n2 shl k,i);
      Rez := Rez or (k shl (i-1));
    End
    Else
    Begin
       k   := Bit(n1 shl k,i+1);
       Rez := rez or (k shl (i-1));
    End;
  End;
  GetNumber := Rez;
End;

function ToDec(n:string; radix:longint):longint; // перевод двоичного в десятичное
const
  digit : string[16] = '0123456789ABCDEF';
var
  m, i       : longint;
begin
  m:=0;
  while n[1]='0' do
     delete(n,1,1); 
  for i:=1 to length(n) do
      m:=m*radix+pos(n[i],digit)-1;
      ToDec:=m;
end;

End.