Перейти из форума на сайт.

НовостиФайловые архивы
ПоискАктивные темыТоп лист
ПравилаКто в on-line?
Вход Забыли пароль? Первый раз на этом сайте? Регистрация
Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Задачи на Pascal/Object Pascal/Free Pascal (Delphi/Lazarus)

Модерирует : ShIvADeSt

 Версия для печати • ПодписатьсяДобавить в закладки
На первую страницук этому сообщениюк последнему сообщению

Открыть новую тему     Написать ответ в эту тему

CAHEK_KZ

Newbie
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору

Код:
 
uses crt;
const
   norm=$17;
   sel=$70;
   n=3;
var
   menu:array[1..n] of string;
   punkt:integer;
   x,z:integer;
   f:text;
   p,r:integer;
   ch:char;
   y,d,s,q,g:string;
{============================================================================}
procedure menutoscr;
var i:integer;
begin
clrscr;
for i:=1 to n do begin
gotoxy(x,z+i-1);
write(menu[punkt]);
end;
TextAttr:=sel;
gotoxy(x,z+punkt-1);
write(menu[punkt]);
TextAttr:=norm;
end;
{============================================================================}
procedure proverka;
var s:string;
begin
read(f,q);
if q=s then begin
p:=length(q);
delete(q,1,p);
end;
end;
{============================================================================}
procedure vashxod;
begin
clrscr;
writeln;
      writeln('vvedite gorod');
      read(s);
      p:=length(s);
      d:=copy(s,p,1);
      clrscr;
      repeat
            proverka;
            readln(f,q);
            g:=copy(q,1,1);
            if d=g then begin
                    writeln(s,' - ',q);
                    p:=length(q);
                    delete(q,1,p);
            end;
       until eof(f);
readln;
end;
{=========================================================================}
procedure xodcompa;
begin
clrscr;
writeln;
      readln(f,q);
      writeln(q);
      writeln('vvedite gorod');
      read(s);
      writeln(s,' - ',q);
      p:=length(s);
      d:=copy(s,p,1);
      repeat
            readln(f,q);
            g:=copy(q,1,1);
            if d=g then begin
                    writeln(s,' - ',q);
            end;
       until eof(f);
readln;
end;
{============================================================================}
procedure igra;
var
a:integer;
begin
a:=random(2);
if a=1 then vashxod;
if a=2 then  xodcompa;
end;
{===========osnova===========================================================}
begin
clrscr;
assign(f,'c:\goroda.txt');
reset(f);
clrscr;
menu[1]:='Igra';
menu[2]:='Pomosh';
menu[3]:='Vixod';
punkt:=1;
x:=35;
z:=12;
TextAttr:=norm;
MenuToScr;
repeat
      ch:=Readkey;
      if ch=chr(0) then begin
      ch:=readkey;
      case ch of
      chr(80):If punkt<N then begin
                 GotoXY(x,z+punkt-1);
                 write(menu[punkt]);
                 punkt:=punkt+1;
                 TextAttr:=sel;
                 GotoXY(x,z+punkt-1);
                 write(menu[punkt]);
                 TextAttr:=norm;
                 end;
     chr(72):If punkt>1 then begin
                 GotoXY(x,z+punkt-1);
                 write(menu[punkt]);
                 punkt:=punkt-1;
                 TextAttr:=sel;
                 GotoXY(x,z+punkt-1);
                 write(menu[punkt]);
                 TextAttr:=norm;
                 end;
      end;
      end;
     if ch=chr(13) then begin
     case punkt of
          1:igra;
          2:ch:=chr(27);
          3:ch:=chr(27);
     end;
     menutoscr;
    end;
Until ch=chr(27);
end.
 

Всего записей: 5 | Зарегистр. 28-12-2007 | Отправлено: 17:55 03-01-2008 | Исправлено: CAHEK_KZ, 19:18 03-01-2008
Открыть новую тему     Написать ответ в эту тему

На первую страницук этому сообщениюк последнему сообщению

Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Задачи на Pascal/Object Pascal/Free Pascal (Delphi/Lazarus)


Реклама на форуме Ru.Board.

Powered by Ikonboard "v2.1.7b" © 2000 Ikonboard.com
Modified by Ru.B0ard
© Ru.B0ard 2000-2024

BitCoin: 1NGG1chHtUvrtEqjeerQCKDMUi6S6CG4iC

Рейтинг.ru