Правила форума
Прочтите прежде чем задавать вопрос!
1)Буквы не могут повторятся
2)Клавиши должны фильтроваться только буквенные клавиши и клавиша ESC
Вот исходник:
Код
uses crt;
type
tWiselicaSymbol=record
x,y:byte; {Координаты символа}
s:char; {Номер символа}
c:byte; {Цвет символа}
end;
tWiselica=array[1..13] of tWiselicaSymbol;
tSetOfChar=set of char;
const
wiselica:tWiselica=((x:0;y:4;s:'¦';c:15),(x:0;y:3;s:'¦';c:15),(x:0;y:2;s :'¦';c:15),(x:0;y:1;s:'¦';c:15),
(x:0;y:0;s:'г';c:15),(x:1;y:0;s:'=';c:15),(x:2;y:0;s:'=';c:15),(x:3;y:0; s:'¬';c:15),
(x:3;y:1;s:'o';c:14), (x:3;y:2;s:'O';c:9), (x:2;y:2;s:'/';c:6), (x:4;y:2;s:'\';c:6),
(x:3;y:3;s:'П';c:6));
var
ourword:string;
WordCharSet:tSetOfChar;
quit:boolean;
popitka:byte;
c:string[1];
function GetRandomWordFromFile(FileName:string):string;
var {Возвращает случайным образом слово из файла FileName}
f:text;
p,o:word;
s:string;
begin
assign(f,filename);
reset(f);
p:=0;
while not eof(f) do
begin
readln(f);
inc(p);
end;
close(f);
reset(f);
o:=random(p)+1;
p:=0;
while not eof(f) do
begin
readln(f,s);
inc(p);
if p=o then break;
end;
close(f);
GetRandomWordFromFile:=s;
end;
procedure ShowPartOfWiselica(x,y,PartNumber:byte);
begin {Изображает на экране в заданном месте определённую часть виселицы}
if PartNumber=0 then exit;
gotoxy(x+wiselica[PartNumber].x,y+wiselica[PartNumber].y);
textcolor(wiselica[PartNumber].c);
write(wiselica[PartNumber].s);
textcolor(7);
gotoxy(1,1);
end;
procedure ShowWord(x,y:byte);
var p:byte; {Показывает слово, учитывая известные буквы}
begin
gotoxy(x,y);
textcolor(15);
for p:=1 to length(ourword) do
if ourword[p] in WordCharSet then write(ourword[p]) else write('.');
gotoxy(1,1);
textcolor(7);
end;
function CheckForAllLetters:boolean;
var p:byte; {Проверяет, все ли буквы уже отгаданы}
begin
checkforallLetters:=true;
for p:=1 to length(ourword) do if not (ourword[p] in WordCharSet) then checkforallLetters:=false;
end;
function CheckForLetterInWord(c:string):boolean;
begin {Проверяет, есть ли буква С в слове}
if(pos(c,OurWord)<>0)and not (c[1] in WordCharSet) then CheckForLetterInWord:=true else CheckForLetterInWord:=false;
end;
function up(s:string):string;
var p:byte; {Поднимает символ в верхний регистр}
begin
up[0]:=s[0];
for p:=1 to length(s) do
up[p]:=char(byte(s[p])-$20*byte(s[p]>#96)-$30*byte(s[p]>#$DF));
end;
begin
randomize;
ourword:=up(GetRandomWordFromFile('word.txt'));
wordcharset:=[ourword[1]];
wordcharset:=wordcharset+[ourword[length(ourword)]];
clrscr;
writeln(' ':31,'ИГРА "ВИСЕЛИЦА"');
writeln;
write('Слово:',' ':50,' Попыток осталось:');
popitka:=0;
repeat
ShowWord(8,3);
ShowPartOfWiselica(60,5,popitka);
gotoxy(75,3);
textcolor(15);
write((13-popitka):2);
textcolor(7);
gotoxy(1,5+popitka);
if popitka=13 then
begin
writeln;
writeln('ВЫ ПРОИГРАЛИ !!!!');
halt;
end else
if CheckForAllLetters then
begin
writeln;
writeln('ВЫ ВЫИГРАЛИ !!!!');
halt;
end;
write('Введите букву (ESC - выход): ');
c:=up(readkey);
if c=#27 then halt;
gotoxy(29,5+popitka);
textcolor(15);
write©;
textcolor(7);
if CheckForLetterInWord© then WordCharSet:=WordCharSet+[c[1]] else
begin
write(' - НЕПРАВИЛЬНО !');
inc(popitka);
end;
until false;
end.
type
tWiselicaSymbol=record
x,y:byte; {Координаты символа}
s:char; {Номер символа}
c:byte; {Цвет символа}
end;
tWiselica=array[1..13] of tWiselicaSymbol;
tSetOfChar=set of char;
const
wiselica:tWiselica=((x:0;y:4;s:'¦';c:15),(x:0;y:3;s:'¦';c:15),(x:0;y:2;s :'¦';c:15),(x:0;y:1;s:'¦';c:15),
(x:0;y:0;s:'г';c:15),(x:1;y:0;s:'=';c:15),(x:2;y:0;s:'=';c:15),(x:3;y:0; s:'¬';c:15),
(x:3;y:1;s:'o';c:14), (x:3;y:2;s:'O';c:9), (x:2;y:2;s:'/';c:6), (x:4;y:2;s:'\';c:6),
(x:3;y:3;s:'П';c:6));
var
ourword:string;
WordCharSet:tSetOfChar;
quit:boolean;
popitka:byte;
c:string[1];
function GetRandomWordFromFile(FileName:string):string;
var {Возвращает случайным образом слово из файла FileName}
f:text;
p,o:word;
s:string;
begin
assign(f,filename);
reset(f);
p:=0;
while not eof(f) do
begin
readln(f);
inc(p);
end;
close(f);
reset(f);
o:=random(p)+1;
p:=0;
while not eof(f) do
begin
readln(f,s);
inc(p);
if p=o then break;
end;
close(f);
GetRandomWordFromFile:=s;
end;
procedure ShowPartOfWiselica(x,y,PartNumber:byte);
begin {Изображает на экране в заданном месте определённую часть виселицы}
if PartNumber=0 then exit;
gotoxy(x+wiselica[PartNumber].x,y+wiselica[PartNumber].y);
textcolor(wiselica[PartNumber].c);
write(wiselica[PartNumber].s);
textcolor(7);
gotoxy(1,1);
end;
procedure ShowWord(x,y:byte);
var p:byte; {Показывает слово, учитывая известные буквы}
begin
gotoxy(x,y);
textcolor(15);
for p:=1 to length(ourword) do
if ourword[p] in WordCharSet then write(ourword[p]) else write('.');
gotoxy(1,1);
textcolor(7);
end;
function CheckForAllLetters:boolean;
var p:byte; {Проверяет, все ли буквы уже отгаданы}
begin
checkforallLetters:=true;
for p:=1 to length(ourword) do if not (ourword[p] in WordCharSet) then checkforallLetters:=false;
end;
function CheckForLetterInWord(c:string):boolean;
begin {Проверяет, есть ли буква С в слове}
if(pos(c,OurWord)<>0)and not (c[1] in WordCharSet) then CheckForLetterInWord:=true else CheckForLetterInWord:=false;
end;
function up(s:string):string;
var p:byte; {Поднимает символ в верхний регистр}
begin
up[0]:=s[0];
for p:=1 to length(s) do
up[p]:=char(byte(s[p])-$20*byte(s[p]>#96)-$30*byte(s[p]>#$DF));
end;
begin
randomize;
ourword:=up(GetRandomWordFromFile('word.txt'));
wordcharset:=[ourword[1]];
wordcharset:=wordcharset+[ourword[length(ourword)]];
clrscr;
writeln(' ':31,'ИГРА "ВИСЕЛИЦА"');
writeln;
write('Слово:',' ':50,' Попыток осталось:');
popitka:=0;
repeat
ShowWord(8,3);
ShowPartOfWiselica(60,5,popitka);
gotoxy(75,3);
textcolor(15);
write((13-popitka):2);
textcolor(7);
gotoxy(1,5+popitka);
if popitka=13 then
begin
writeln;
writeln('ВЫ ПРОИГРАЛИ !!!!');
halt;
end else
if CheckForAllLetters then
begin
writeln;
writeln('ВЫ ВЫИГРАЛИ !!!!');
halt;
end;
write('Введите букву (ESC - выход): ');
c:=up(readkey);
if c=#27 then halt;
gotoxy(29,5+popitka);
textcolor(15);
write©;
textcolor(7);
if CheckForLetterInWord© then WordCharSet:=WordCharSet+[c[1]] else
begin
write(' - НЕПРАВИЛЬНО !');
inc(popitka);
end;
until false;
end.
Ребята все кто может наложите на исходник эти два условия это очень нужно!!!Очень срочно!!!Заранее ОГРОМНОЕ СПАСИБО всем кто откликнулся!!!!!
Сообщение отредактировано: volvo -
Что, разжевать и в рот положить?
