Игра виселица, Помогите с двумя условиями!!!Спасибо!!!! Опции

[dct]

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

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

Сообщение отредактировано: volvo - 3.01.2005 10:07

[volvo]

dct
Ну а в чем проблема? Просто напиши свою функцию вместо ReadKey...
Например, так:

const
  charSet: set of char = [#27, 'A' .. 'Z'];
{сюда поставь все символы, которые должны обрабатываться программой (в верхнем регистре)}

function myReadKey: Char;

    function upchar(ch:char):char;
    {Поднимает символ в верхний регистр}
    begin
      upchar:=char(byte(ch)-$20*byte(ch>#96)-$30*byte(ch>#$DF));
    end; 

  var ch: char;
  begin
    repeat
      ch := upchar(readkey);
    until ch in charSet;
    exclude(charset, ch);
    myReadKey := ch
  end;

А в основной программе вместо

c:=up(readkey);

используй

c:=myreadkey;

Сообщение отредактировано: volvo - 4.11.2010 12:35

[dct]

он пишет что:Unknow identetifer ch:!!!!!!!!!!!!!!!!!!

[volvo]

dct
Исправлено.
Добавить переменную большая проблема?

[Altair]

volvo, если не знать какого она типа, то да
(вспомни меня вчра с этим thandle - самому стыдно )

[dct]

ourword:=upchar(GetRandomWordFromFile('er.txt'));теперь здесь тоже самое

[volvo]

offtop
А какого типа она может быть, если возвращается из функции UpChar?
/offtop

[dct]

эту ф-цию надо было занести в Const
function myReadKey: Char;

[volvo]

dct

ourword:=upchar(GetRandomWordFromFile('er.txt'));теперь здесь тоже самое

А вот это уже Ваша проблема... Я в программу не лез - исходя из принципа "не навреди"... Если она не работает, значит и не работала...

P.S.

эту ф-цию надо было занести в Const
function myReadKey: Char;

Функцию в Const? Это что-то новое...

Сообщение отредактировано: volvo - 3.01.2005 14:34

[dct]

offtop
А какого типа она может быть, если возвращается из функции UpChar? 
/offtop

Ну так что сделать вот что объясни лучше!!!

[dct]

она работала это 100%

[volvo]

Ну так что сделать вот что объясни лучше!!!

Думать начинай... Что, разжевать и в рот положить?

[dct]

ourword:=upchar(GetRandomWordFromFile('word.txt'));-теперь пишет TYpe mistmash

[Romtek]

dct, тебе уже ответили в Помогите пожайлуста с игрой Виселица что надо делать. Пораскинь немного мозгами.

[volvo]

uses crt;

const
 charSet: set of char = [#27, 'A' .. 'Z'];
{сюда поставь все символы, которые должны обрабатываться программой (в верхнем регистре)}

function myReadKey: Char;

   function upchar(ch:char):char;
   {Поднимает символ в верхний регистр}
   begin
     upchar:=char(byte(ch)-$20*byte(ch>#96)-$30*byte(ch>#$DF));
   end;

 var ch: char;
 begin
   repeat
     ch := upchar(readkey);
   until ch in charSet;
   exclude(charset, ch);
   myReadKey := ch
 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:=myreadkey;
  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 - 4.11.2010 12:34

[dct]

Спасибо вот другой вопрос эта игра реализованна за 13 попыток а мне надо за 7 как увеличить переменную а главное какую?????

[volvo]

dct
Вот в этом куске кода:

write((7-popitka):2); (** Здесь **)
textcolor(7);
gotoxy(1,5+popitka);
if popitka=7 then (** Здесь **)
begin
writeln;
writeln('ВЫ ПРОИГРАЛИ !!!!');
halt;
end else
if CheckForAllLetters then
begin
writeln;
writeln('ВЫ ВЫИГРАЛИ !!!!');
halt;
end;

Там, где стоят комментарии, я изменил "13" на "7"... Попробуй...

[dct]

я понимаю !!!(не совсем дерево!!!) но виселица будет не дорисовываться !!!! и обрываться на 7 куске !!!

[volvo]

Тогда тебе всю логику менять придется... как ты хочешь 13 элементов отрисовать за 7 ходов?

[dct]

Увеличивая переменную попытку чтобы за одну ошибку вырисовывалось две части виселицы!!Но вот как это сделать???