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;

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.