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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 29.03.2010, 19:34   #1
pavel42
Пользователь
 
Регистрация: 06.04.2009
Сообщений: 95
По умолчанию из процедурного в модульное

есть прога в процедурном, нужно переделать в модульное и сделать без использование LABEL. только метку эту надо удалить во всех процедурах...
pavel42 вне форума Ответить с цитированием
Старый 29.03.2010, 19:36   #2
pavel42
Пользователь
 
Регистрация: 06.04.2009
Сообщений: 95
По умолчанию

Код:
PROGRAM kjkk;
   USES CRT;
   LABEL mm;
   TYPE zt=record
         nom:integer;
         famil:string[15];
         predmet:string[15];
         ocenka:integer;
    END;
    CONST str='-------------------------------------------------';
        str1='I N I ”*¬Ё«Ёп €.Ћ. I  ЏаҐ¤¬Ґв         I ЋжҐ*Є*   I';
    VAR a,b,i,j,n,p:integer;
        t:file of zt;
        RB:array[1..20] of zt;
        quit:boolean;

    PROCEDURE okno (x1,y1,x2,y2,Cvet_okna,Cvet_Bukv:integer);
    begin
     TextBackGround(0);
     CLRSCR;
     window(x1,y1,x2,y2);
     textBackGround(Cvet_okna);
     textColor(Cvet_Bukv);
     CLRSCR;
    end;

    PROCEDURE vvod;
    VAR  i:integer;
    begin
     write('‚ўҐ¤ЁвҐ Є®«ЁзҐбвў® бв㤥*в®ў n=');
     readln(n);
     writeln (str);
     writeln (str1);
     writeln (str);
     rewrite(t);
     for i:=1 to n do begin;
       write('I',i:2,' I');
       Rb[i].nom:=i;
       readln(RB[i].famil);
       a:=20; b:=i+4;gotoXy(a,b);write('I ');
       readln(RB[i].predmet);
       a:=39;b:=i+4;gotoxy(a,b);write('I ');
       readln(RB[i].ocenka);
       write(t,RB[i]);
     end;
     close(t);
     writeln;
     writeln('„«п Їа®¤®«¦Ґ*Ёп **¦¬ЁвҐ Enter');
     end;


     PROCEDURE wywod;
     VAR kol_zap,i:integer;
     begin
      writeln('‚Ґ¤®¬®бвм бв㤥*в®ў');
      writeln (str);
      writeln (str1);
      writeln (str);
     reset(t);
     kol_zap:=FileSize(t);
     if kol_zap=0 then writeln('”*©« Їгбв®©')
     else
      begin
      i:=0;
      while not eof(t) do begin
        i:=i+1;
        read(t,Rb[i]);
        writeln('I',Rb[i].nom:2,' I',Rb[i].Famil:12,'I':3,Rb[i].Predmet:15,'I':4,Rb[i].ocenka:5);
        end;
        writeln(str);
      end;
     close(t);
     writeln;
     writeln('„«п Їа®¤®«¦Ґ*Ёп **¦¬ЁвҐ Enter');
    end;

      PROCEDURE dobav;
      VAR kn,i,k:integer;
          Mas:array[1..20] of zt;
      begin
         reset(t);
         k:=FileSize(t);
         if k=0 then begin
           writeln('”*©« Їгбв®©.„®Ў*ў«пҐ¬ ў **з*«®');
           kn:=1;
           Rb[kn].nom:=1;
           write('‚ўҐ¤ЁвҐ д*¬Ё«Ёо:');
           readln(Rb[kn].famil);
           write('‚ўҐ¤ЁвҐ ЇаҐ¤¬Ґв:');
           readln(Rb[kn].predmet);
           write('®жҐ*Є*=');
           readln(Rb[kn].ocenka);
           write(t,Rb[kn]);
         end
         else
         begin
           write('‚ўҐ¤ЁвҐ *®¬Ґа §*ЇЁбЁ ¤«п ўбв*ўЄЁ kn=');
           readln(kn);
           if kn>k then begin
             writeln('‡*ЇЁбм ¤®Ў*ў«пҐвбп ў Є®*жҐ д*©«* Ї®¤ *®¬Ґа®¬:',k+1:4);
             for i:=1 to k do
               Mas[i]:=Rb[i];
             Mas[k+1].nom:=kn;
             write('‚ўҐ¤ЁвҐ д*¬Ё«Ёо:');
             readln(Mas[k+1].famil);
             write('ЇаҐ¤¬Ґв:');
             readln(Mas[k+1].predmet);
             write('®жҐ*Є*=');
             readln(Mas[k+1].ocenka);
           end
           else
             for i:=1 to k do begin
               if (kn>i) then  Mas[i]:=Rb[i];
               if kn=i then begin
                      Mas[i].nom:=kn;
                      write('‚ўҐ¤ЁвҐ д*¬Ё«Ёо:');
                      readln(Mas[i].famil);
                      write('ЇаҐ¤¬Ґв:');
                      readln(Mas[i].predmet);
                      write('®жҐ*Є*=');
                      readln(Mas[i].ocenka);
                end;
                if kn<=i then begin
                  Mas[i+1].nom:=i+1;
                  Mas[i+1].famil:=Rb[i].famil;
                  Mas[i+1].predmet:=Rb[i].predmet;
                  Mas[i+1].ocenka:=Rb[i].ocenka;
                end;
               end;
             close(t);
             rewrite(t);
             for i:=1 to k+1 do begin
                write(t,Mas[i]);
             end;
             writeln('‡*ЇЁбм ¤®Ў*ў«Ґ**  ');
         end;
       writeln;
       close(t);
       writeln('„«п Їа®¤®«¦Ґ*Ёп **¦¬ЁвҐ Enter');
     end;
pavel42 вне форума Ответить с цитированием
Старый 29.03.2010, 19:37   #3
pavel42
Пользователь
 
Регистрация: 06.04.2009
Сообщений: 95
По умолчанию

Код:
 PROCEDURE udalen;
      LABEL 16;
      VAR kn,i,k:integer;
          Ms:array[1..20] of zt;
          Fam:string[15];
      begin
         reset(t);
         k:=FileSize(t);
         if k=0 then writeln('”*©« Їгбв®©.‡*Ї®«*ЁвҐ б**з*«® ¤***лҐ')
         else
          begin
            write('‚ўҐ¤ЁвҐ д*¬Ё«Ёо бв㤥*в* ¤«п г¤*«Ґ*Ёп:');
            readln(Fam);
            kn:=0;
            for i:=1 to k do begin
               if Rb[i].famil=Fam then begin
                 kn:=i;
                 goto 16;
               end;
            end;
            16: if kn=0 then writeln('‘в㤥*в* б в*Є®© д*¬Ё«ЁҐ© *Ґв')
                else
                begin
                   for i:=1 to k-1 do begin
                     if i<kn then Ms[i]:=Rb[i]
                     else Ms[i]:=Rb[i+1];
                    end;
                    close(t);
                    rewrite(t);
                    for i:=1 to k-1 do
                       write(t,Ms[i]);
                    writeln;
                    writeln('‡*ЇЁбм г¤*«Ґ**');
                end;
         end;
         close(t);
       writeln('„«п Їа®¤®«¦Ґ*Ёп **¦¬ЁвҐ Enter');
    end;

   PROCEDURE menu;
   LABEL aaa;
   VAR k1:char;
       w:integer;
   begin
   aaa:CLRSCR;
        window(20,10,75,23);
        textcolor(yellow);
        textbackground(Green);
        CLRSCR;
        writeln('         Њ…Ќћ');
        writeln('1. ‚ў®¤ ¤***ле ў д*©«');
        writeln('2. ‚лў®¤ १г«мв*в®ў');
        writeln('3. ‚бв*ўЄ* §*ЇЁбЁ');
        writeln('4. “¤*«Ґ*ЁҐ §*ЇЁбЁ');
        writeln('5. ‚л室');
        writeln;
        write(' ‚ўҐ¤ЁвҐ *®¬Ґа *г¦*®Ј® Їг*Єв*--> ');
        k1:=readkey;
        if (k1=#49) OR( k1=#50) OR (k1=#51) OR (k1=#52) OR (k1=#53) then
        begin
           val(k1,p,w);
         end
         else
          begin
            writeln;
            textcolor(red);
            writeln('!!!ЋиЁЎЄ* ўў®¤*. Џ®ўв®аЁвҐ ўў®¤!!!');
            delay(500);
            readln;
            goto aaa;
          end;
          CLRSCR;
         window(1,1,80,25);
         textcolor(15);
       END;

   {Ћб*®ў**п Їа®Ја*¬¬*}
   BEGIN
   assign(t,'student.dat');
   rewrite(t);
   mm:menu;
         case p of
          1:begin
            okno(10,10,5,5,Blue,Yellow);
            vvod;
            readln;
            goto mm;
           end;
          2: begin
             okno(10,10,5,5,Blue,Yellow);
             wywod;
             readln;
             goto mm;
             end;
          3: begin
             okno(10,10,5,5,Blue,Yellow);
             dobav;
             readln;
             goto mm;
             end;
          4: begin
             okno(10,10,5,5,Blue,Yellow);
             udalen;
             readln;
             goto mm;
             end;
          5: begin
             window(1,1,80,25);
             textcolor(15);
             CLRSCR;
             writeln('Џа®Ја*¬¬* §*ўҐаиЁ«* бў®о а*Ў®вг');
             delay(2000);
             halt
             end;
          end;
         readln;
       end.


pavel42 вне форума Ответить с цитированием
Старый 29.03.2010, 19:54   #4
pavel42
Пользователь
 
Регистрация: 06.04.2009
Сообщений: 95
По умолчанию

в модульное переделал...все работает...а вот как убрать метки и что бы работало без них не знаю...помогите пл3

вот в модульном
КУРС - основная прога
орс - модуль
Вложения
Тип файла: rar mod.rar (2.2 Кб, 8 просмотров)
pavel42 вне форума Ответить с цитированием
Старый 29.03.2010, 21:26   #5
evg_m
Старожил
 
Регистрация: 20.04.2008
Сообщений: 5,526
По умолчанию

формальный (дословный без разбора алгоритма перевод)
1. label mmm;

mmm: => flagmmm:=true; while (flagmmm) do begin flagmmm:=false;
+ end; там где найдем последний goto (после оператора не внутри case)
goto mmm; => flagmmm:=true; continnue;

аналогично
label aaa; => flagaaa:=true; while (flagaaa) do begin flagaaa:=false;
end; в конце оператора содерэжащего последний goto
goto => flagaaa:=true; contunue;

для label 16; => break;
программа — запись алгоритма на языке понятном транслятору
evg_m вне форума Ответить с цитированием
Старый 30.03.2010, 11:11   #6
pavel42
Пользователь
 
Регистрация: 06.04.2009
Сообщений: 95
По умолчанию

все равно не понимаю...
pavel42 вне форума Ответить с цитированием
Старый 30.03.2010, 14:22   #7
evg_m
Старожил
 
Регистрация: 20.04.2008
Сообщений: 5,526
По умолчанию

ссылка вверх(назад) это организация цикла
mmm: //начало цикла
goto mmm; // повторить(начать новую итерацию )
необходимо заменить на цикл (while)
организовать аналогичную схему переходов (continue)
и выхода из цикла (flag)
конец цикла определяется так последний оператор в которрм мы нашли goto
в первом случае это case (=>конец цикла по окончании этого оператора)
во втором if .. then .. else (=>конец цикла будем после ветки else )

Код:
aaa: //заменяется на ТРИ следующие строчки
flagaaa:=true; // чтобы мы могли войти в цикл
while (flagaaa) do begin 
  flagaaa:=false; // чтобы мы вышли из цикла  если не будет явного указания о повторе
.....
  case 
.......
  goto aaa;//заменяеся на ДВЕ следующие стрчки
  flagaaa:=true; // указываем неоходимость повтора
  continue; // возврат к началу цикла
......
 end; //закрывающий Case
end;// добавляется ПОСЛЕ ОПЕРАТОРА case
ссылка вниз(вперед) это наоборот выход из уже имеющегося цикла в данном случае (for)
необходимо выполнить завершение цикла (break);
программа — запись алгоритма на языке понятном транслятору

Последний раз редактировалось evg_m; 30.03.2010 в 14:39.
evg_m вне форума Ответить с цитированием
Старый 30.03.2010, 20:27   #8
pavel42
Пользователь
 
Регистрация: 06.04.2009
Сообщений: 95
По умолчанию

pavel42 вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Модульное программирование. artemavd Общие вопросы Delphi 9 11.12.2009 13:14
Модульное программирование. BARNEY Общие вопросы Delphi 5 28.07.2009 09:12
Модульное программирование Marinka91 Помощь студентам 3 28.06.2009 20:16
подпрограммы с параметрами процедурного типа stargirl Помощь студентам 2 14.03.2009 14:52
модульное программирование, С++ Stiker Помощь студентам 1 09.12.2007 21:38