IPB
ЛогинПароль:

 
 Ответить  Открыть новую тему 
> Игра "Виселица"
сообщение
Сообщение #1


Гость






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.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






Смоделировать игру "Поле чудес" со следующими правилам: ЭВМ загадывает слово, случайным образом считывая его из некоторого файла и выдавая вам его из первую и последную буквы (если эти буквы встречаются в слове в двух местах, они также выводятся на экран, например: "С*****С*Ь"). Вы отгадываете букву за буквой, при неугадывании очередной буквы строящаяся в углу экрана висилица пополняется новым элементом.    
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

Группа: Пользователи
Сообщений: 38

Репутация: -  0  +


О !! :))) Дык это ж я писал :)))))))
В pascal.sources.ru :))))
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


...
*****

Группа: Пользователи
Сообщений: 1 347
Пол: Мужской

Репутация: -  3  +


Проснулся smile.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Новичок
*

Группа: Пользователи
Сообщений: 38

Репутация: -  0  +


Ну я просто в этом форуме недавно :)
А игрушку и в правду я писал.. не помню для кого уже :))
Помнится мне с пьяну :)))
И ещё помню, что когдато такое уже и раньше писал, только так коряво.. ну так коряво :)))))
З.Ы. А у вас тут много моих программ :)) приятно посмотреть :)))
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


...
*****

Группа: Пользователи
Сообщений: 1 347
Пол: Мужской

Репутация: -  3  +


Радуйся...у тебя старый код не сохранился?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Новичок
*

Группа: Пользователи
Сообщений: 38

Репутация: -  0  +


Нет, что ты :)))))
Писал лет 5 назад :)) у меня с того времени компов штук 5 сменилось :))))) (о.. получается по 1 на год) :))
А проги старые помню точно что вместе с вичестером как то забыл в маршрутке :((((( Жалко было, не передать :)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 30.09.2020 14:22
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name