Программная реализация алгоритма

ПРОГРАММНАЯ РЕАЛИЗАЦИЯ АЛГОРИТМА

ОБЩИЕ СВЕДЕНИЯ

Данная программа написана на языке Pascal 7.0. Минимальные требования к конфигурации системы: процессор PentiumPro и выше. Для функционирования системы необходима установленная операционная система Windows 95/98/NT с поддержанием среды MS-DOS. Запускаемый файл носит название “``int.exe”.

ПРИЛОЖЕНИЕ

{281}

Program SyStoSyS;     {Hex Dec Oct Bin}

 Uses Crt;

 Type Tarr=array [1..1024] of integer;

  Procedure PfD(pq:integer; d:longint; Var pa:Tarr; Var ing,i:integer);

   Var

    exc:integer;

   Begin

    d:=Trunc(d);

    i:=0;

    Repeat

     Inc(i);{увеличение 'i' на '1'}

     ing:=d div pq;{целая часть}

     exc:=d mod pq;{остаток}

     pa[i]:=exc;

     d:=ing;

    Until ing<pq;

   End;

  Procedure PfB(ps:string; Var pd:longint);

   Var

    i,n,e,inl,p:integer;

   Begin

    n:=Length(ps);{длина строки}

    e:=n-1;

    For i:=1 to n Do

     Begin

      Val(ps[i],inl,p);{преобразование символьного числа в двоичную форму}

      pd:=pd+inl*Trunc(Exp(e*Ln(2)));

      Dec(e);

     End;

   End;

  Procedure POutPut(q,ing,i:integer; poa:Tarr);

   Var

    j:integer;

   Begin

    Write(' ');

    If (q=16)and(ing>=10)  Then

     Case ing of

      10 : write('A');

      11 : write('B');

      12 : write('C');

      13 : write('D');

      14 : write('E');

      15 : write('F');

     End

    Else

     If ing>0 Then Write(ing);

    For j:=i Downto 1 Do

     Begin

      If (q=16)and(poa[j]>=10) Then

       Case poa[j] of

        10 : write('A');

        11 : write('B');

        12 : write('C');

        13 : write('D');

        14 : write('E');

        15 : write('F');

       End

      Else

       Write(poa[j]);

     End;

    Writeln;

   End;

  Procedure POutPutBD(st:string); {begin output}

   Var

    i:integer;

    ic:string[4];

   Begin

    Write(' ');

    For i:=1 to Length(st) Do

     Begin

      Case st[i] of

       '0' : ic:='0000';

       '1' : ic:='0001';

       '2' : ic:='0010';

       '3' : ic:='0011';

       '4' : ic:='0100';

       '5' : ic:='0101';

       '6' : ic:='0110';

       '7' : ic:='0111';

       '8' : ic:='1000';

       '9' : ic:='1001';

      End;

      Write(ic);

     End;

    Writeln;

   End; {end output}

  Procedure PInPut(Var s:string; Var q:integer);

   Begin

    TextColor(9);

    writeln;

    writeln(' Введите целое число и основание системы в которую оно будет переводится:');

    Write(' ');

    Readln(s);

    Write(' ');

    Readln(q);

   End;

  Var

  a:Tarr;

  c,qs:char;

  d:longint;

  i,p,q,ing:integer;

  s:string;

  F:boolean;

 Begin{program}

  Repeat {begin repeat program}

   ClrScr;

   TextColor(10);

   Writeln;

   Writeln;

   Writeln('Программа первода целых чисел.':55);

   TextColor(9);

   Writeln('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~':58);

   Repeat

    TextColor(15);

    Writeln;

    Write(' Введите ''');

    TextColor(10);

    Write('Dec');

    TextColor(15);

    Writeln(''' для первода чисела из Dec в Bin, Oct, Hex и Bin-Dec.');

    Write(' Введите ''');

    TextColor(10);

    Write('Bin');

    TextColor(15);

    Writeln(''' для первода чисела из Bin в Oct, Hex и Bin-Dec.');

    Write(' Введите ''');

    TextColor(10);

    Write('Help');

    TextColor(15);

    Writeln(''' для получения помощи.');

    Write(' Введите ''');

    TextColor(10);

    Write('About');

    TextColor(15);

    Writeln(''' для получения информации о программе.');

    Write(' Введите ''');

    TextColor(10);

    Write('Exit');

    TextColor(15);

    Writeln(''' для выхода из программы.');

    TextColor(10);

    Writeln;

    Write(' ');

    Readln(c);

    c:=UpCase(c);

    If (c='D')or(c='B')or(c='H')or(c='A')or(c='E') Then

     Begin

      Case UpCase(c) of {begin of case}

      'D' : Begin {dec}

             PInPut(s,q);

             If q=21 Then POutPutBD(s)

             Else

              Begin

               Val(s,d,p);

               PfD(q,d,a,ing,i);

               POutPut(q,ing,i,a)

              End

            End; {dec}

'B' : Begin {bin}

             Repeat

              PInPut(s,q);

              F:=(q=8)or(q=16)or(q=21);

              If q=21 Then

               Begin

                PfB(s,d);

                Str(d,s);

                POutPutBD(s)

               End

              Else

               Begin

                If F=False Then

                 Begin

                  TextColor(12);

                  Write(' Error!!!');

                  TextColor(9);

                  Writeln(' Неверная система счисления!')

                 End

                Else

                 Begin

                  PfB(s,d);

                  PfD(q,d,a,ing,i);

                  POutPut(q,ing,i,a)

                 End

               End;

             Until F;

            End; {bin}

      'H' : Begin {help}

             ClrScr;

             Writeln;

             TextColor(10);

             Writeln('Помощь':43);

             Writeln;

             TextColor(9);

             Writeln(' Ввод данных производится следующим образом:');

             Writeln;

             TextColor(15);

             Write(' Введите целое число и нажмите ''');

             TextColor(10);

             Write('Enter');

             TextColor(15);

             Writeln(''', введите основание системы, в которую');

             Write('будет переводиться число и нажмите ''');

             TextColor(10);

             Write('Enter');

             TextColor(15);

             Writeln('''. Для оснований систем счисления в');

             Writeln('программе используются следующие эквивалентности: ');

             Writeln;

             TextColor(10);

             Writeln(' Bin ~ 2, Oct ~ 10, Dec ~ 10, Hex ~ 16 и Bin-Dec ~ 21.');

             Writeln;

             TextColor(4);

             Write(' Press any key to continue...');

             ReadKey;

             ClrScr;

            End; {help}

       'A' : Begin {about}

             ClrScr;

             Writeln;

             TextColor(10);

             Writeln('О программе:':46);

             Writeln;

             TextColor(12);

             Writeln('SyStoSyS Version 1.0 beta 1 25.04.2002':59);

             Writeln;

             TextColor(10);

             Writeln(' Авторы: Титов Д.,Кирьяков А. и Машков Д.В. группа 146');

             Writeln;

             TextColor(9);

             Writeln(' Эта программа является курсовой работой по дисциплине ''Информатика''. Она пред-');

             Writeln('назначена для перевода целых чисел из одной системы счисления в другую, а конк-');

             Writeln('ретно: из десятичной в двоичную, восьмеричную, шестнадцатеричную и двоично-');

             Writeln('десятичную; из двоичной в восьмеричную, шестнадцатеричную и двоично-десятичную.');

             Writeln;

             TextColor(3);

             Write(' P.S. ');

             TextColor(9);

             Writeln('Программа может содержать мелкие баги.');

             Writeln;

             TextColor(4);

             Write(' Press any key to continue...');

             ReadKey;

             ClrScr;

            End; {about}

      'E' : Exit;

      End; {end of case}

     End

    Else

     Begin

      TextColor(12);

      Write(' Error!!!');

      TextColor(9);

      Writeln(' Ошибка ввода!')

     End;

   Until (c='D')or(c='B');

   Writeln;

   Write(' Повторить перевод (Yes/No)? ');

   Readln(qs);

  Until UpCase(qs) <> 'Y'; {end repeat program}

  ReadKey;

 End.{program}