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.

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

О !! :))) Дык это ж я писал :)))))))
В pascal.sources.ru :))))

Проснулся

Ну я просто в этом форуме недавно :)
А игрушку и в правду я писал.. не помню для кого уже :))
Помнится мне с пьяну :)))
И ещё помню, что когдато такое уже и раньше писал, только так коряво.. ну так коряво :)))))
З.Ы. А у вас тут много моих программ :)) приятно посмотреть :)))

Радуйся...у тебя старый код не сохранился?

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