Программирование тестовой программы

    procedure zapis_v_data_base; // запись результата в файл

    function proverka:boolean;

    procedure n7click(sender:tobject); //информация о прогр.

    procedure otvetkeypress(sender:tobject;var key:char);

  private

  { Private declarations }

    vse_voprosy:array[1..max_voprosov]of tvse_voprosy;

    ispol_voprosy:array[1..voprosov_v_teste] of integer;

    schitano_voprosov:integer;

    tek_vopros,nomer:integer;

    file_s_voprosami:text;

    otvety_na_voprosy:array[1..voprosov_v_teste] of boolean;

  public

   student:tstudents;

   students:array[1..200] of tstudents;

  end;

var

  Form1: TForm1;

  s:tstrings;

implementation

{$R *.dfm}

function tform1.proverka:boolean; // проверка, проходили вы

тест или нет

var file_db:textfile;

    n,vsego_proshli:integer;

    str:string;

begin

if not fileexists(put_k_data_base+rasshirenie_file_data_base)then

  begin

   proverka:=false;

   exit;

  end;

assignfile(file_db,put_k_data_base+rasshirenie_file_data_base);

reset(file_db);

if ioresult=0 then

  begin

    n:=0;

    while not(eof(file_db))do

    begin

     n:=n+1;

     readln(file_db,students[n].name);

     delete(students[n].name,1,4);

     readln(file_db,students[n].familiya);

     delete(students[n].familiya,1,8);

     readln(file_db,str);

     readln(file_db,str);

     readln(file_db,str);

     readln(file_db,str);

    end; 

    vsego_proshli:=n;

    for n:=1 to vsego_proshli do

     begin 

      if (students[n].name=student.name) and

          (students[n].familiya=student.familiya) then

          begin

           messagedlg('Извините, вы уже проходили этот тест отойдите, пожалуйста, от омпьютера',mtinformation,[mbok],0);

           proverka:=true;

           exit;

          end;

     end;  

  end   

   else  proverka:=false;

   closefile(file_db);

end;

procedure tform1.otvetkeypress(sender:tobject;var key:char);

// принять ответ

begin

  if  key=#13 then

   otvetgotov.Click;    

end;

procedure tform1.zapis_v_data_base; // запись результата

var file_db:textfile;

begin

if fileexists(put_k_data_base+rasshirenie_file_data_base) then

  begin

   assignfile(file_db,put_k_data_base+rasshirenie_file_data_base);

   append(file_db);

  end

  else

   begin

    assignfile(file_db,put_k_data_base+rasshirenie_file_data_base);

    rewrite(file_db);

   end;

writeln(file_db,'Имя '+student.name);

writeln(file_db,'Фамилия '+student.familiya);

writeln(file_db,'Группа '+student.group);

writeln(file_db,'Дата '+datetostr(date));

writeln(file_db,'Время '+timetostr(time));

writeln(file_db,'Результат '+student.resultat);

writeln(file_db,'        ');

{ flush(file_db);}

closefile(file_db);

end;

function tform1.resultat:integer; // вывод результата

var i,kol_vo_pravilnyh:integer;

begin

  kol_vo_pravilnyh:=0;

  for i:=1 to voprosov_v_teste do

   begin

     if form1.otvety_na_voprosy[i] then

       kol_vo_pravilnyh:=kol_vo_pravilnyh+1;

   end;

   resultat:=round(10*(kol_vo_pravilnyh/voprosov_v_teste));

end;

procedure tform1.chtenie_voprosov; // считывание вопросов

label 1,2;

var

    schyotchik,i,j:integer;

    str:string;

    b1,b2:boolean;

begin

str:=put_k_voprosam1;

b1:=FileExists(put_k_voprosam1);

b2:=FileExists(put_k_voprosam2);

if (b1) and (b2 )then

  begin

   str:=put_k_voprosam1;

  end;

if (b1) and (not (b2))then

  begin

   str:=put_k_voprosam1;

  end;

if (b2) and (not (b1)) then

  begin

   str:=put_k_voprosam2;

  end;

if (not (b1))and(not (b2)) then

  begin

   showmessage('Не найден файл с вопросами');

   halt;

  end;

    try

schyotchik:=0;

assignfile(file_s_voprosami,str);

reset(file_s_voprosami);

while not(seekeof(file_s_voprosami)) do

   begin {n 001}

   schyotchik:=schyotchik+1;

   i:=0;

    repeat

    i:=i+1;

readln(file_s_voprosami,vse_voprosy[schyotchik].vopros[i]);

    until  vse_voprosy[schyotchik].vopros[i]='end of question';

     vse_voprosy[schyotchik].vopros[i]:='';

           for i:=1 to max_otvetov-1 do

            begin 

             readln(file_s_voprosami,vse_voprosy[schyotchik].otvety[i]);

             if vse_voprosy[schyotchik].otvety[i]='end' then

               begin 

                 for j:=i to max_otvetov do

                 vse_voprosy[schyotchik].otvety[j]:=kluch;

                goto 1;

               end;  

            end;             

1:end;   2:

closefile(file_s_voprosami);

schitano_voprosov:=schyotchik;

if schitano_voprosov<voprosov_v_teste then

  begin

  MessageDlg('Количество вопросов в тесте превышает количество вопросов в базе данных пожалуйста обновите Базу Данных',mterror,[mbok],0);

   exit;

  end;

   except

    MessageDlg('Неверен формат Базы Данных',mterror,[mbok],0);

   end;

end;

procedure tform1.vivod_poley_voprosa; // границы вопроса

var sam_vopros:string;

    i:integer;

begin

   labelvopros.Visible:=true;

   vopros.Visible:=true;

   otvet.Visible:=true;

   labelotvet.Visible:=true;

   otvetgotov.Visible:=true;

   sam_vopros:='';

    for i:=1 to strok_v_voprose do

     sam_vopros:=sam_vopros+vse_voprosy[nomer].vopros[i];

   if length(sam_vopros)>7*109 then

     begin

      //vopros.ScrollBars:=ssVertical;

    vopros.Height:=100

     end

       else

        begin

         //vopros.ScrollBars:=ssnone;

         vopros.Height:=17*(trunc(length(sam_vopros)/72)+1);

        end;                  

end;

procedure tform1.vivod_voprosa;  // вывод вопроса на форму

label 1;

var i,j:integer;

begin

form1.vopros.Caption:='';

randomize;

labelvopros.Caption:='Вопрос №'+inttostr(tek_vopros);

1:nomer:=trunc(random(schitano_voprosov))+1;

if tek_vopros>=1 then

for i:=1 to tek_vopros do

  begin

   if (ispol_voprosy[i]=nomer) or (nomer>schitano_voprosov) then goto 1;

  end

   else nomer:=trunc(schitano_voprosov)+1;

ispol_voprosy[tek_vopros]:=nomer;

form1.vivod_poley_voprosa;

j:=1;

  for i:=1 to strok_v_voprose do

   begin

  for j:=1 to  Trunc(length(vse_voprosy[nomer].vopros[i])/bukv_stroke_voprosa)+1 do

   if not((i=1) and (j=1))  then

  vopros.Caption:=vopros.Caption+#13+copy(vse_voprosy[nomer].vopros[i],(j-1)*bukv_stroke_voprosa+1,bukv_stroke_voprosa)

                            else

  vopros.Caption:=vopros.Caption+copy(vse_voprosy[nomer].vopros[i],(j-1)*bukv_stroke_voprosa-1,bukv_stroke_voprosa)

   end;

otvet.Text:='';

end;

procedure TForm1.CancelClick(Sender: TObject); // выход

begin

close;

end;

procedure TForm1.nachaloClick(Sender: TObject);//начать тест

begin

  form2.ShowModal;

if not(form2.vvedenie_imeni) then exit

                              else

                               begin

         student.name:=form2.name.Text;

         student.familiya:=form2.Familiya.Text;

         student.group:=form2.gruppa.Text;

         if form1.proverka then close;

                               end;

screen.Cursor:=crappstart;

form1.chtenie_voprosov;

screen.Cursor:=crdefault;

tek_vopros:=1;

form1.vivod_voprosa;

otvet.SetFocus;

N5.Enabled:=true;

end;

procedure TForm1.OtvetgotovClick(Sender: TObject); //принять

ответ

var i:integer;

begin

for i:=1 to max_otvetov-1 do

  begin   

   if otvet.Text=vse_voprosy[nomer].otvety[i] then

     begin   

      messagedlg('Ответ правильный',mtconfirmation,[mbok],0);

      otvety_na_voprosy[tek_vopros]:=true;

      tek_vopros:=tek_vopros+1;

      otvet.SetFocus;

      if tek_vopros=voprosov_v_teste+1 then

  begin 

   messagedlg('Вы закончили тест и получили (из 10 возможных баллов) - '+inttostr(form1.resultat),mtconfirmation,[mbok],0);

   student.resultat:=inttostr(form1.resultat);

   form1.zapis_v_data_base;

   close;

  end; 

  form1.vivod_voprosa;

      exit;

     end;  

  end;   

if not(otvety_na_voprosy[tek_vopros]) then

  begin  

   messagedlg('Ответ неправильный',mtconfirmation,[mbok],0);

   otvety_na_voprosy[tek_vopros]:=false;

   tek_vopros:=tek_vopros+1;

   if tek_vopros=voprosov_v_teste+1 then

  begin   

   messagedlg('Вы закончили тест и получили (из 10 возможных баллов) - '+inttostr(form1.resultat),mtconfirmation,[mbok],0);

    student.resultat:=inttostr(form1.resultat);

    form1.zapis_v_data_base;

    close;

  end;    

  form1.vivod_voprosa;

  end;    

otvet.SetFocus;

end;

procedure TForm1.FormCreate(Sender: TObject); //инф.о форме

var i,j:integer;

begin            // цикл вывода вопроса на форму

for j:=1 to max_voprosov do

  for i:=1 to strok_v_voprose do

   begin

   vse_voprosy[j].vopros[i]:='';

   end;

for i:=1 to voprosov_v_teste do

begin

   otvety_na_voprosy[i]:=false;

   ispol_voprosy[i]:=0;

end;

if fileexists(put_k_parolu) then

   begin

   end;

end;

procedure tform1.n7click(sender:tobject); // инф.о программе

begin

aboutbox.ShowModal; // открытие окна другой формы

end;

end.

2