? если нетрудно помогите хоть чемнибуть а то 1.5 недели осталось а я ток титульник зделал
?
Где прячется Усама Бен Ладен?
В Афганистане.
В США.
@На Марсе.
В России.
Клюет ли сегодня акула на Австралийском побережье?
Нет.
Да.
Может быть.
@Да, но только не на Австралийском побережье, а в Париже, и не акула, а Ягуар, и не сегодня, а третьего дня, и не клюет, а стоял в пробке..
type
tTask= record
question: string;
answer: array[1..4]of string;
Correct,k: integer
end;
var
Tasks: array[1..15]of tTask;
n:=0;
while not EoF(f) do begin
Inc(n);
with Task[n] do begin
ReadLn(f,question);
k:=0;
repeat
ReadLn(f,s);
if s<>'' then begin
Inc(k);
if s[1]='@' then begin
correct:=k;
Delete(s,1,1)
end;
answer[k]:=s
end
until s=''
end
end
program millioner;
uses crt;
type
Tquestions = record
questions:string[254]; {вопрос}
answers:array ['a'..'d',1..2] of string[254]; {4 варианта ответа, 2 поле T(True) или F(false)}
ball:integer; {бал за ответ}
end;
TfileQuestions = file of Tquestions;
Tresult = record
name:string[254]; {имя}
ball:integer; {заработано балов}
end;
TfileResult = file of Tresult;
procedure show(q:Tquestions);
begin
writeln(q.questions);
writeln('Answers:');
writeln('a) ',q.answers['a',1]);
writeln('b) ',q.answers['b',1]);
writeln('c) ',q.answers['c',1]);
writeln('d) ',q.answers['d',1]);
end;
procedure show2(var f2:TfileResult);
var
profil:Tresult;
begin
Writeln('Inwi resultatu');
while not eof(f2) do
begin
read(f2,profil);
Writeln(profil.name,' ',profil.ball);
end;
end;
var
Q:Tquestions;
f1:TfileQuestions;
f2:TfileResult;
profil:Tresult;
otv:char;
begin
assign(f1,'questions.rec');
assign(f2,'result.rec');
reset(f1);
reset(f2);
Writeln('Enter your name:');
readln(profil.name);
profil.ball:=0;
while not eof(f1) do
begin
read(f1,q);
show(q);
write('Your answers: ');
readln(otv);
if (q.answers[otv,2]='T') or (q.answers[otv,2]='t') then
profil.ball:=profil.ball+q.ball
else
begin
Writeln('An answer is incorrect!!');
break;
end;
readln;
clrscr;
end;
Writeln('You have: ',profil.ball);
seek(f2,filesize(f2));
write(f2,profil);
readln;
show2(f2);
readln;
end.
program millioner;
uses crt;
type
Tquestions = record
questions:string[254]; {вопрос}
answers:array ['a'..'d',1..2] of string[254]; {4 варианта ответа, 2 поле T(True) или F(false)}
ball:integer; {бал за ответ}
end;
TfileQuestions = text;
Tresult = record
name:string[254]; {имя}
ball:integer; {заработано балов}
end;
TfileResult = file of Tresult;
procedure read_from_file(var f1:TfileQuestions; var q:Tquestions);
var
i:char;
begin
readln(f1,q.questions);
for i:='a' to 'd' do
begin
readln(f1,q.answers[i,1]);
if q.answers[i,1][1]='@' then
begin
q.answers[i,2]:='T';
delete(q.answers[i,1],1,1);
end
else
q.answers[i,2]:='N';
end;
readln(f1,q.ball);
end;
procedure show(q:Tquestions);
begin
writeln(q.questions);
writeln('Answers:');
writeln('a) ',q.answers['a',1]);
writeln('b) ',q.answers['b',1]);
writeln('c) ',q.answers['c',1]);
writeln('d) ',q.answers['d',1]);
end;
procedure show2(var f2:TfileResult);
var
profil:Tresult;
begin
Writeln('Inwi resultatu');
while not eof(f2) do
begin
read(f2,profil);
Writeln(profil.name,' ',profil.ball);
end;
end;
var
Q:Tquestions;
f1:TfileQuestions;
f2:TfileResult;
profil:Tresult;
otv:char;
begin
clrscr;
assign(f1,'data.txt');
assign(f2,'result.rec');
reset(f1);
reset(f2);
Writeln('Enter your name:');
readln(profil.name);
profil.ball:=0;
while not eof(f1) do
begin
read_from_file(f1,q);
show(q);
write('Your answers: ');
readln(otv);
if (q.answers[otv,2]='T') then
profil.ball:=profil.ball+q.ball
else
begin
Writeln('An answer is incorrect!!');
break;
end;
end;
Writeln('You have: ',profil.ball);
seek(f2,filesize(f2));
write(f2,profil);
close(f2);
readln;
reset(f2);
show2(f2);
close(f2);
readln;
end.
reset(f2);
{$I-}
Reset(F2);
{$I+}
If IOResult=0 Then reset(f2)
else rewrite(f2);
немогу пока разобратся
немогу пока разобратсяEnter your name:
bbb
chislo pI=?
Answers:
a) 3.14
b) 2
c) 4.123
d) 1
Your answers: a
R9d Fibanachi
Answers:
a) 1 1 2 3 5
b) 1 1 1 3
c) 1 2 3
d) 1 2 4
Your answers: a
You have: 300
Inwi resultatu
aaa 0
bbb 300
Enter your name:
bbb
chislo pI=?
Answers:
a) 3.14
b) 2
c) 4.123
d) 1
Your answers: a
R9d Fibanachi
Answers:
a) 1 1 2 3 5
b) 1 1 1 3
c) 1 2 3
d) 1 2 4
Your answers: a
You have: 300
Inwi resultatu
aaa 0
bbb 300
Uses Mouse, Crt,graph;
Const FileName = 'test.dat';
TestName = 'Modernas tehnologijas.';
Max = 15;
Type Test = record
Num : Byte;
Name : String [100];
V1 : String [3];
O1 : Byte;
V2 : String [3];
O2 : Byte;
End;
Var
Mas : Array [1..15] of Test;
F : File Of Test;
Sum : Word;
I : Byte;
L,R : Boolean;
X,Y : Word;
Select : Byte;
MousePresent : Boolean;
Function IntToStr(I : Longint) : String;
{ Преобразовывает значение типа Integer в строку }
Var S : String [11];
Begin
Str(I, S);
IntToStr:=S;
End;
Procedure Button( A, M : Byte);
Begin
Window(20, 18, 35, 18);
TextBackground(Green);
If A=0 Then TextColor(White)
Else TextColor(Black);
ClrScr;
GotoXY(Round((15-Length(Mas[M].V1))/2),1);
Write(Mas[M].V1);
Window(45, 18, 60, 18);
TextBackground(Green);
If A=1 Then TextColor(White)
Else TextColor(Black);
ClrScr;
GotoXY(Round((15-Length(Mas[M].V2))/2),1);
Write(Mas[M].V2);
End;
Function Vopros(N : Byte):Byte;
Var
Sx, Sy : Byte;
Flag : Boolean;
K : Char;
Function Key(V : Byte):Integer;
Begin
Key := -1;
If Select = 0 Then Key := Mas[V].O1;
If Select = 1 Then Key := Mas[V].O2;
End;
Function Res(RX, RY, V : Byte):Integer;
Var X1, X2, Y1, Y2 : Byte;
Begin
Res := -1;
X1 := 20;
X2 := 35;
Y1 := 18;
Y2 := 18;
If (RX >= X1) And (RX <= X2) And
(RY >= Y1) And (RY <= Y2) Then Res := Mas[V].O1;
X1 := 45;
X2 := 60;
Y1 := 18;
Y2 := 18;
If (RX >= X1) And (RX <= X2) And
(RY >= Y1) And (RY <= Y2) Then Res := Mas[V].O2;
End;
Begin
Button (Select, N);
Window(7, 7, 73, 16);
TextBackground(LightGray);
ClrScr;
TextColor(Red);
WriteLn('Вопрос: ',Mas[N].Num);
WriteLn;
TextColor(Blue);
WriteLn(Mas[N].Name);
Window(1, 1, 80, 25);
TextBackground(Black);
TextColor(LightGray);
If MousePresent Then Begin { подключил крысу - получи гранату! }
Flag := False;
While Not(Flag) Do Begin
GETMOUSE(l,r,x,y);
Sx := Round(X/8)+1;
Sy := Round(Y/8)+1;
If L Then Begin
If Res(SX,SY,N) <> -1 Then Flag := True;
Sound(020); { Звук с частотой 20 Гц }
Delay(200); { На 200 миллисекунд }
NoSound; { Выключаем динамик }
VOPROS := Res(SX,SY,N);
End;
End;
End Else Begin { мышА не подаёт признаков жизни }
Flag := False;
While Not(Flag) Do Begin
K := ReadKey;
If K = #09 Then Begin
Select := 1-Select;
Button (Select, N);
End;
If (K=#32) Or (K=#13) Then Begin
If Key(N) <> -1 Then Flag := True;
Sound(020); { Звук с частотой 20 Гц }
Delay(200); { На 200 миллисекунд }
NoSound; { Выключаем динамик }
VOPROS := Key(N);
End;
End;
End;
End;
BEGIN
MousePresent := DetectMouse;
I := 1;
Assign(F, FileName);
ReSet(F);
While Not(EOF(F)) Do Begin
Read(F,Mas[I]);
Inc(I);
End;
Close(F);
TextBackground(Black);
TextColor(LightBlue);
ClrScr;
GotoXY(Round((80-Length(TestName))/2),2);
WriteLn(TestName);
Window(5, 5, 75, 20);
TextBackground(Blue);
ClrScr;
Window(6, 6, 74, 19);
TextBackground(LightGray);
TextColor(Black);
ClrScr;
Sum := 0;
If MousePresent Then MOUSEON;
For I := 1 To Max Do Begin
Select := 0;
Sum := Sum + VOPROS(I);
End;
If MousePresent Then MOUSEOFF;
Window(7, 7, 73, 16);
TextBackground(LightGray);
TextColor(Black);
ClrScr;
If (Sum >= 11) And (Sum <= 15) Then Begin
WriteLn('Вы удивительно внимательны и проницательны.');
WriteLn('Вашей памяти можно только позавидовать.');
End;
If (Sum >= 5) And (Sum <= 10) Then Begin
Write('Вы достаточно внимательны, не забываете ничего важного. Однако и на');
WriteLn('старуху бывает проруха - кое-что можете запамятовать.');
WriteLn('И всё же вы способны в ответственный момент сосредоточиться и недопустить промашки.');
End;
If (Sum >= 0) And (Sum <= 4) Then Begin
Write('Вы очень рассеянны, и в этом причина многих бед. Но вы упорно не придаёте значения таким "пустякам", ');
WriteLn('хотя из-за вашего невнимания неприятности терпят и окружающие.');
Write('Что значит, например, забыть завернуть водопроводный кран или потерять взятую у кого-то книгу? ');
WriteLn('А ведь и в зрелые годы (тем более в молодые) каждому под силу быть собранным, натренировать память.');
End;
Window(20, 18, 60, 18);
TextBackground(Green);
TextColor(Black);
ClrScr;
Write('ENTER продолжит работу...');
Window(1, 1, 80, 25);
TextBackground(Black);
TextColor(LightGray);
ReadLn;
ClrScr;
END.