pascal
Главная | Каталог статей | Регистрация | Вход
Суббота
08.02.2025
20:08
Приветствую Вас Гость | RSS
Главная » Статьи » Pascal » Программы

Викторина

 uses
    quizGraph,
    GraphABC;
 const
     pu ='quest\';
 
 var
   f,us : string;
   l,t,p : integer;
 begin
  quizGraph.Window();
  writeln ('Укажите имя опроса, (не забедьте поместитт его в папку)');
  readln (f);
  f := pu+f;
  writeln ('Укажите ваш индификатор');
  readln (us);
   l := long (f);
   if l <> 0 then
    begin
     t := 0;
     for p := 1 to l do
      if question(p,f) then
       t := t +1;
     Res(t,l);
     delete (f,1,Length(pu));
     ResFile (t,l,f,us);
     readln();
     CloseWindow();
    end
   else
    begin
     writeln ('Файл не найден либо поврежден');
     readln();
     CloseWindow();
    end;
 end.

 unit
    quizGraph;
    
 interface
  uses
     GraphABC,
     time;
  const
     x = 500; // размер окна
     xw = x div 2;
     right = '*';//символ, обозначающий верный ответ
     
  procedure Window ();
  function question(p : integer;fl : string) : boolean;
  function long (fl : string) : integer;
  procedure Res (r,l : integer);
  procedure ResFile (p,l : integer; fl,u : string);
 
 implementation
  procedure Window ();
   begin
    SetWindowHeight (x);
    SetWindowWidth (x);
    SetWindowIsFixedSize (true);
    //SetWindowTitle ('');
   end;
   
  function question(p : integer;fl : string) : boolean;
   const
       z = 5;

       xp = xw div 2;
       xx = x div 10;
   var
     t : text;
     i,j : integer;
     tr : integer := 0;
     q : array [1..z] of string;
     s :string;
     reply : char;
   begin
    If fileExists (fl) then
     begin
      assign (t,fl);
      reset (t);
       
       readln (t);
       for i := 1 to p-1 do
        for j := 1 to z do
         readln (t);
       
       for i := 1 to z do
        begin
         readln (t,q[i]);
         s := q[i];
          if s[1] = right then
           begin
            tr := i-1;
            delete (q[i],1,1);
           end;
        end;
       
      close (t);
      
      
      CLearWindow();
      Line (0,xw,x,xw);
      Line (xw,0,xw,x);
      
      
      SetWindowTitle ('('+IntToStr(p)+')'+' '+q[1] );
      TextOut (xx,xw-xp,q[2]);
      TextOut (xx,xw+xp,q[3]);
      TextOut (xw+xx,xw-xp,q[4]);
      TextOut (xw+xx,xw+xp,q[5]);
      
      readln (reply);
       if StrToInt(reply) = tr then
        Result := true
       else
        Result := false;
     end;
     
     
   end;
 
  function long (fl : string) : integer;
   var
     t : text;
     l : integer := 0;
   begin
    if FileExists(fl) then
     begin
      assign (t,fl);
      reset (t);
       readln (t,l);
      close (t);
      result := l;
     end;
   end;
   
   procedure Res (r,l : integer);
    begin
     ClearWindow();
     TextOut (xw div 2,xw,'Вы ответили правильно на '+IntToStr(r)+' из '+IntToStr(l)+' вопросов');
    end;
   procedure ResFile (p,l : integer; fl,u : string);
    var
      f : text;
      t,d,m : string;

    begin
     t := timen();
     d := dayn();
     m := Mayn();
      assign (f,'R'+fl);
       if FileExists (fl) then
        rewrite (f)
       else
        append(f);
       writeln (f,u);
       writeln (f,M,'.',d,' ',t);
       writeln (f,'Вы ответили правильно на ',p,' из ',l,' вопросов');
      close (f);
    end;
 
 end.

Шаблон файла вопросов

2 //кол-во вопросов
Who a you //вопрос
qwest1 //варианты ответа
qwest2
*qwest3
qwest4
Test ques?
1
2
3
*4

Категория: Программы | Добавил: cccc1808 (28.05.2015)
Просмотров: 731 | Рейтинг: 0.0/0
Всего комментариев: 0
avatar
Вход на сайт
Поиск
Copyright MyCorp © 2025
Бесплатный хостинг uCoz