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

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Игра виселица, Помогите с двумя условиями!!!Спасибо!!!!
сообщение
Сообщение #1


Новичок
*

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

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


Ребят подгоните пожайлуста исходник под 3 условия:
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.

Ребята все кто может наложите на исходник эти два условия это очень нужно!!!Очень срочно!!!Заранее ОГРОМНОЕ СПАСИБО всем кто откликнулся!!!!! smile.gif

Сообщение отредактировано: volvo -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме
dct   Игра виселица   3.01.2005 8:44
volvo   dct Ну а в чем проблема? Просто напиши свою функц…   3.01.2005 15:13
dct   он пишет что:Unknow identetifer ch:!!…   3.01.2005 18:03
volvo   dct Исправлено. Добавить переменную большая пробл…   3.01.2005 18:25
Altair   volvo, если не знать какого она типа, то да :) (вс…   3.01.2005 18:28
dct   ourword:=upchar(GetRandomWordFromFile('er.txt…   3.01.2005 18:30
volvo   offtop А какого типа она может быть, если возвраща…   3.01.2005 18:31
dct   эту ф-цию надо было занести в Const function myRe…   3.01.2005 18:31
volvo   dct А вот это уже Ваша проблема... Я в программу…   3.01.2005 18:33
dct   Ну так что сделать вот что объясни лучше!…   3.01.2005 18:33
dct   она работала это 100%   3.01.2005 18:34
volvo   Думать начинай... :angry: Что, разжевать и в рот…   3.01.2005 18:35
dct   ourword:=upchar(GetRandomWordFromFile('word.tx…   3.01.2005 18:44
Romtek   dct, тебе уже ответили в Помогите пожайлуста с игр…   3.01.2005 18:45
volvo   uses crt; const charSet: set of char = [#27, …   3.01.2005 18:45
dct   Спасибо вот другой вопрос эта игра реализованна за…   3.01.2005 19:03
volvo   dct Вот в этом куске кода: Там, где стоят комме…   3.01.2005 19:10
dct   я понимаю !!!(не совсем дерево!…   3.01.2005 19:13
volvo   Тогда тебе всю логику менять придется... как ты хо…   3.01.2005 19:17
dct   Увеличивая переменную попытку чтобы за одну ошибку…   3.01.2005 19:20
volvo   dct Единственное, что могу предложить - вместо …   3.01.2005 19:34
dct   Спасибо!!!!!!!!…   3.01.2005 19:39
Romtek   Сначала подумать, а потом сделать. За тебя никто н…   3.01.2005 19:42
Altair   Дело в том, что некоторые думают, что можно не за…   3.01.2005 19:58
dct   Я не понимаю чё разорались???Я нормально человеку …   3.01.2005 20:06
dct   Он на самом деле мне очень помог и не плакал как в…   3.01.2005 20:10
dct   ты так вообще на ботаника похож!!!…   3.01.2005 20:11


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

 





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