Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 12.10.2011, 21:52   #1
Китос
Пользователь
 
Регистрация: 24.09.2011
Сообщений: 26
Сообщение Типизированные файлы(Паскаль)

есть программа создания лабиринта:
Код:
program redaktor;
 uses
  crt;
 const
  size=17;
 type
  stroka=string[size];
  tlab=array[1..size,1..size] of record
                                  b:boolean;
                                  a:char;
                                 end;
 var
  s: stroka;
  f: file of tlab;
  lab: tlab;
  n: char;
  name: string[5];
  i,j: byte;
 begin
  writeln('1. Редактировать лабиринт(не работает)',#10#13,'2. Создать лабиринт',#10#13,'3. Выход');
  write('Введите номер выполняемого действия:'); n:=readkey(); writeln; writeln;
  case n of
   '1': begin
         write('Введите имя лабиринта: '); readln(name);
         assign(f, name+'.lb');
        end;
   '2': begin
         write('Введите имя лабиринта: '); readln(name);
         assign(f, name+'.lb');
         rewrite(f);
         clrscr;
         for i:=1 to size do
          begin
           readln(s);
           for j:=1 to size do
            begin
             if (s[i]=' ') and ((i=1) or (j=1)) then
              begin
               lab[i,j].a:=chr(25);
               lab[i,j].b:=false;
              end
             else if (s[i]='0') then
              begin
               lab[i,j].a:='0';
               lab[i,j].b:=false;
              end
             else
              begin
               lab[i,j].a:=' ';
               lab[i,j].b:=true;
              end; 
            end;
           write(f,lab);
          end;
         close(f);
         writeln;
         writeln('Лабиринт сохранен.');
        end;
    '3': exit;    
   end;
 end.
и есть программа которая должна этот лабиринт считывать и решать:
(функция считывания ZagrLab и вывода VivLab если чо)

Код:
program labirint;
 uses
  crt;
 const
  size=17;
 type
  tlab=array[1..size,1..size] of record
                                  b:boolean;
                                  a:char;
                                 end;
  slovo=record
         x: byte;
         y: byte;
        end;
 var
  i,j: byte;
  win: boolean;
  steck: array[1..9] of slovo;
  lab: tlab;
 procedure VivLab;
  var
   i,j: byte;
  begin
   clrscr;
   for i:=1 to size do
    begin
     for j:=1 to size do
      begin
       if lab[i,j].a=chr(25) then textcolor(red)
        else if lab[i,j].a='0' then
         textcolor(green)
        else textcolor(yellow);
       write(lab[i,j].a);
      end;
     writeln;
    end;
  end;
 procedure ZagrLab;
  var
   f: file of tlab;
   name: string[5];
  begin 
   write('Введите имя лабиринта: '); readln(name);
   assign(f,name+'.lb');
   reset(f);
   read(f,lab);
   close(f);
  end;
 function KV(i,j: byte):byte;
   var
    n: integer;
   begin
    n:=0;
    kv:=1;
    if lab[i+1,j].b then inc(n);
    if lab[i-1,j].b then inc(n);
    if lab[i,j+1].b then inc(n);
    if lab[i,j-1].b then inc(n);
    if n>1 then KV:=2 else
     if n=0 then KV:=0;
   end;
 procedure zSteck(var i,j: byte);
  var
   k: integer;
  begin
   if KV(i,j)=2 then
    begin
     for k:=9 downto 2 do
      begin
       steck[k].x:=steck[k-1].x;
       steck[k].y:=steck[k-1].y;
      end;
     steck[1].x:=i;
     steck[1].y:=j;
    end
   else if KV(i,j)=0 then
    begin
     lab[i,j].b:=false;
     i:=steck[1].x;
     j:=steck[1].y;
     for k:=1 to 8 do
      begin
       steck[k].x:=steck[k+1].x;
       steck[k].y:=steck[k+1].y;
      end;
    end;
  end; 
 begin
  ZagrLab;
  VivLab;
  {lab[1,2].a:=chr(25);
  lab[17,16].a:=chr(25);
  i:=2; j:=2;
  lab[1,2].b:=false;
  win:=false;
  repeat
   zsteck(i,j);
   lab[i,j].b:=false;
   if (i=16) and (j=16) then win:=true
    else if lab[i,j-1].b then
      begin
       dec(j);
       lab[i,j].a:=chr(17);
      end
    else if lab[i+1,j].b then
     begin
      inc(i);
      lab[i,j].a:=chr(31);
     end
    else if lab[i-1,j].b then
      begin
       dec(i);
       lab[i,j].a:=chr(30);
      end
     else if lab[i,j+1].b then
      begin
       inc(j);
       lab[i,j].a:=chr(16);
      end;
   VivLab;
  until win;}
 end.
но что-то в этом всем не хочет работать(
толи в файл не правильно записывается, толи считывается(
в общем помогите)

Последний раз редактировалось Китос; 12.10.2011 в 21:54.
Китос вне форума Ответить с цитированием
Старый 13.10.2011, 15:10   #2
Form_13
Форумчанин
 
Регистрация: 25.04.2011
Сообщений: 107
По умолчанию

Что-то у тебя тут вообще драля какие-то(
Form_13 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Типизированные Файлы. Паскаль. Chaara Помощь студентам 2 09.04.2011 00:58
типизированные файлы (паскаль) Rfn.if Помощь студентам 1 16.03.2011 10:46
типизированные файлы, паскаль! D1em Паскаль, Turbo Pascal, PascalABC.NET 4 12.02.2011 17:11
Паскаль. Типизированные файлы. Razorishe Помощь студентам 19 31.03.2009 20:24
Типизированные файлы.Паскаль.help! ромка) Паскаль, Turbo Pascal, PascalABC.NET 1 17.05.2008 07:59