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
|