Программа


{ Перевод целых из системы в систему,
  проверка делимости }
Program Translator;
Uses Crt;                      { Подключение модуля Crt }
Const MaxNumberLength=66;      { Максимальная длина числа }
      MinPower=2;MaxPower=36;  { Max и Min системы счисления }
Var Exit:boolean;              { Флаг "Выход" }
    TextAttrBuf:Byte;          { Переменная для сохранения атрибутов текста }
Function Menu:byte;            { Функция вывода меню и получения ответа }
  const QuantityMenuPoint=9;   { Количество пунктов меню }
        ExitPoint=QuantityMenuPoint; { Пункт меню "Выход" }
        Point:byte=ExitPoint;        { Текущий пункт меню }
         LengthMenuPoint=68; { Длина пунктов меню }
        { Положение верхнего левого угла меню: }
        XStart=(80- LengthMenuPoint) div 2 -2;
        YStart=(24-QuantityMenuPoint) div 2 -1;
        MenuList:array[1..QuantityMenuPoint] of string[ LengthMenuPoint] =
      ('Перевод целого числа из 10-ичной системы счисления в  Q-ичную       ',
       'Перевод целого числа из  Q-ичной системы счисления в 10-ичную       ',
       'Перевод целого числа из  Q-ичной системы счисления в  P-ичную       ',
       'Определение делимости числа на 2, 3, 4, 5, 6                        ',
       'Перевод вещественного числа из 10-ичной системы счисления в  Q-ичную',
       'Перевод вещественного числа из  Q-ичной системы счисления в 10-ичную',
       'Перевод вещественного числа из  Q-ичной системы счисления в  P-ичную',
       'Вывод текстового файла                                              ',
       'ВЫХОД                                                               ');
  var ExitMenu:boolean;              { Флаг "Выход" }
      MenuMeter:integer;             { Счетчик }
  procedure PointON(Point:byte);     { Процедура подсветки пункта меню }
  begin
    TextAttr:=White;                 { Установка белого цвета }
    GoToXY(XStart+1,YStart+Point);   { Позиционирование курсора }
    Write(#16,MenuList[Point],#17);   { Вывод пункта меню с указателями }
    TextAttr:=LightGray;             { Установка серого цвета }
  end;
  procedure PointOFF(Point:byte);     { Процедура гашения пункта меню }
  begin
    TextAttr:=LightGray;             { Установка серого цвета }
    GoToXY(XStart+1,YStart+Point);   { Позиционирование курсора }
    Write(' ',MenuList[Point],' ')   { Вывод пункта меню }
  end;
  Begin
    ClrScr;             { Очистка экрана }
    ExitMenu:=FALSE;    { Сброс флага "Выход" }
    begin { Вывод статус строки: }
      GoToXY(8,25);       { Позиционирование курсора }
      TextAttr:=White;    { Установка белого цвета для выводимого текста }
      Write(#24,#25);
      TextAttr:=LightGray;{ Установка серого цвета для выводимого текста }
      Write(' Выбор пункта меню');
      TextAttr:=White;    { Установка белого цвета для выводимого текста }
      GoToXY(38,25);       { Позиционирование курсора }
      Write(#17,#196,#217);
      TextAttr:=LightGray;{ Установка серого цвета для выводимого текста }
      Write(' Активизация выбранного пункта');
    end;
    begin { Прорисовка меню: }
      GoToXY(XStart,YStart);       { Позиционирование курсора }
      Write('╔');
      for MenuMeter:=1 to  LengthMenuPoint+2 do Write('═');
      Write('╗');
      for MenuMeter:=1 to QuantityMenuPoint do
        begin
          GoToXY(XStart,YStart+MenuMeter);
          Write('║ ',MenuList[MenuMeter],' ║')
        end;
      GoToXY(XStart,YStart+QuantityMenuPoint+1);
      Write('╚');
      for MenuMeter:=1 to  LengthMenuPoint+2 do Write('═');
      Write('╝');
    end;
    PointON(Point);   { Подсветить пункт меню }
    repeat
      case ReadKey of
        #72:begin
              PointOFF(Point);   { Погасить пункт меню }
              { Переопределение пункта меню: }
              begin
                Point:=Point-1;
                if Point<1 then Point:=QuantityMenuPoint
              end;
              PointON(Point);   { Подсветить пункт меню }
            end;
        #80:begin
              PointOFF(Point);   { Погасить пункт меню }
              { Переопределение пункта меню: }
              begin
                Point:=Point+1;
                if Point>QuantityMenuPoint then Point:=1
              end;
              PointON(Point);   { Подсветить пункт меню }
            end;
        #13:begin
                ExitMenu:=TRUE;  { Подъем флага "Выход" }
                Menu:=Point
              end;
        #27:begin
                ExitMenu:=TRUE;  { Подъем флага "Выход" }
                Menu:=ExitPoint
              end
      end
    until ExitMenu
  End;
Procedure WindON(Number:byte);
  var MeterChar:byte;  { Счетчик символов }
  Begin
        TextAttr:=White;    { Установка белого цвета для выводимого текста }
        GoToXY((80-MaxNumberLength-2) div 2,4+(Number-1)*4);
        Write('╔');
        for MeterChar:=1 to MaxNumberLength do Write('═');
        Write('╗');
        GoToXY((80-MaxNumberLength-2) div 2,4+(Number-1)*4+1);
        Write('║');
        GoToXY(79-(80-MaxNumberLength-2) div 2,4+(Number-1)*4+1);
        Write('║');
        GoToXY((80-MaxNumberLength-2) div 2,4+(Number-1)*4+2);
        Write('╚');
        for MeterChar:=1 to MaxNumberLength do Write('═');
        Write('╝');
        TextAttr:=LightGray;{ Установка серого цвета для выводимого текста }
  End;
Procedure WindOFF(Number:byte);
  var MeterChar:byte;  { Счетчик символов }
  Begin
        TextAttr:=LightGray;{ Установка серого цвета для выводимого текста }
        GoToXY((80-MaxNumberLength-2) div 2,4+(Number-1)*4);
        Write('┌');
        for MeterChar:=1 to MaxNumberLength do Write('─');
        Write('┐');
        GoToXY((80-MaxNumberLength-2) div 2,4+(Number-1)*4+1);
        Write('│');
        GoToXY(79-(80-MaxNumberLength-2) div 2,4+(Number-1)*4+1);
        Write('│');
        GoToXY((80-MaxNumberLength-2) div 2,4+(Number-1)*4+2);
        Write('└');
        for MeterChar:=1 to MaxNumberLength do Write('─');
        Write('┘');
  End;
Procedure OutTranslatorWindows;  { Процедура вывода окон транслятора }
  const WindowsQuantity=4;   { Количество окон }
        TitleList:array[1..WindowsQuantity] of string =
        ('Исходное число:',
         'Система счисления исходного числа:',
         'Система счисления получаемого числа:',
         'Получаемое число:');
  var MeterWind:byte;  { Счетчик окон }
  Begin
    TextAttr:=LightGray;{ Установка серого цвета для выводимого текста }
    for MeterWind:=0 to 3 do { Цикл вывода четырех окон с заголовками }
      begin
        GoToXY((80-MaxNumberLength-2) div 2,3+MeterWind*4);
        Write(TitleList[MeterWind+1]);
        WindOFF(MeterWind+1)
      end
  End;
Function StringerInt(Int:longint):string;
                             { Функция преобразования целого числа в строку }
  var StrBuf:string;         { Буферная переменная }
  Begin
    Str(Int,StrBuf);         { Преобразование числа в строку }
    StringerInt:=StrBuf         { Определение значения функции }
  End;
Procedure OutStrInWind(WindNumber:byte;Str:string);  { Вывод строки в окно }
  Begin
    GoToXY((80-MaxNumberLength-2) div 2 +1,(WindNumber-1)*4+5);
                                                         { Установка курсора }
    Str:=Copy(Str,1,MaxNumberLength);
                                 { Усекание строки до максимальнодопустимой }
    while Length(Str)<MaxNumberLength do Str:=Str+' ';
                                 { Выравнивание строки до максимальной длины }
    Write(Str)                   { Вывод строки }
  End;
Function Charger(Int:byte):char;     { Получение символа по 10-ичному номеру }
  Begin
    case Int of
       0:Charger:='0';  1:Charger:='1';  2:Charger:='2';  3:Charger:='3';
       4:Charger:='4';  5:Charger:='5';  6:Charger:='6';  7:Charger:='7';
       8:Charger:='8';  9:Charger:='9'; 10:Charger:='A'; 11:Charger:='B';
      12:Charger:='C'; 13:Charger:='D'; 14:Charger:='E'; 15:Charger:='F';
      16:Charger:='G'; 17:Charger:='H'; 18:Charger:='I'; 19:Charger:='J';
      20:Charger:='K'; 21:Charger:='L'; 22:Charger:='M'; 23:Charger:='N';
      24:Charger:='O'; 25:Charger:='P'; 26:Charger:='Q'; 27:Charger:='R';
      28:Charger:='S'; 29:Charger:='T'; 30:Charger:='U'; 31:Charger:='V';
      32:Charger:='W'; 33:Charger:='X'; 34:Charger:='Y'; 35:Charger:='Z'
    end;
  End;
Function Modid(var Int:longint;Q:byte):char;
  { Функция взятия остатка от деления целого на разрядность новой системы
    счисления, с изменением делимого }
  Begin
    Modid:=Charger(Int mod Q);
    Int:=Int div Q
  End;
Function TranslatorFrom10toQ(Int:longint;Q:byte):string;
                            { Функция перевода из 10-ичной системы в Q-ичную }
  var Buf:string;{ Буферная переменная для набора числа в Q-ичной системе }
  Begin
    Buf:='';   { Сброс буфера }
    while Int>0 do Buf:=Modid(Int,Q)+Buf;
    if Buf='' then Buf:='0'; { Переопределение буфера при Int=0 }
    TranslatorFrom10toQ:=Buf { Определение значения функции }
  End;
Function NumberSymbol(Ch:char):byte;
                                   { Преобразование символа в 10-ичное число }
  Begin
    case Ch of
      '0':NumberSymbol:= 0; '1':NumberSymbol:= 1; '2':NumberSymbol:= 2;
      '3':NumberSymbol:= 3; '4':NumberSymbol:= 4; '5':NumberSymbol:= 5;
      '6':NumberSymbol:= 6; '7':NumberSymbol:= 7; '8':NumberSymbol:= 8;
      '9':NumberSymbol:= 9; 'A':NumberSymbol:=10; 'B':NumberSymbol:=11;
      'C':NumberSymbol:=12; 'D':NumberSymbol:=13; 'E':NumberSymbol:=14;
      'F':NumberSymbol:=15; 'G':NumberSymbol:=16; 'H':NumberSymbol:=17;
      'I':NumberSymbol:=18; 'J':NumberSymbol:=19; 'K':NumberSymbol:=20;
      'L':NumberSymbol:=21; 'M':NumberSymbol:=22; 'N':NumberSymbol:=23;
      'O':NumberSymbol:=24; 'P':NumberSymbol:=25; 'Q':NumberSymbol:=26;
      'R':NumberSymbol:=27; 'S':NumberSymbol:=28; 'T':NumberSymbol:=29;
      'U':NumberSymbol:=30; 'V':NumberSymbol:=31; 'W':NumberSymbol:=32;
      'X':NumberSymbol:=33; 'Y':NumberSymbol:=34; 'Z':NumberSymbol:=35
    end;
  End;
Function TranslatorFromQto10(Int:string;Q:byte;var Error:boolean):longint;
                            { Функция перевода из Q-ичной системы в 10-ичную }
  var Buf:Longint;{ Буферная переменная для набора числа в 10-ичной системе }
      BufReal:real;{ Буферная переменная для контроля переполнения }
      Meter:byte;
  Begin
    Buf:=0;   { Сброс буфера }
    BufReal:=0;   { Сброс буфера }
    Error:=FALSE; { Сброс переменной "Ошибка" }
    for Meter:=1 to Length(Int) do
      begin
        Buf:=Buf*Q+NumberSymbol(Int[Meter]);
        if not Error then BufReal:=BufReal*Q+NumberSymbol(Int[Meter]);
        Error:=Error or (BufReal-0.1>Buf)
      end;
    if Error then Buf:=0;    { Сброс буфера при ошибке }
    TranslatorFromQto10:=Buf { Определение значения функции }
  End;
Procedure OutStatus;  { Процедура вывода статус строки }
  begin
    GoToXY(4,25);       { Позиционирование курсора }
    TextAttr:=White;    { Установка белого цвета для выводимого текста }
    Write(#24,#25);
    TextAttr:=LightGray;{ Установка серого цвета для выводимого текста }
    Write(' Выбор окна     ');
    TextAttr:=White;    { Установка белого цвета для выводимого текста }
    Write(#17,#196,#217);
    TextAttr:=LightGray;{ Установка серого цвета для выводимого текста }
    Write(' Активизация выбранного окна     ');
    TextAttr:=White;    { Установка белого цвета для выводимого текста }
    Write('Esc');
    TextAttr:=LightGray;{ Установка серого цвета для выводимого текста }
    Write(' Возврат в меню');
  end;
Function InputStrInt(WindNumber:byte):string; { Функция ввода строки }
  var Buf:string;      { Буфер строки }
      Ch:Char;         { Буфер символа }
Begin
  Buf:=''; { Сброс буфера }
  OutStrInWind(WindNumber,'');   { Очистка окна }
  GoToXY((80-MaxNumberLength-2) div 2 +1,(WindNumber-1)*4+5);
                                                         { Установка курсора }
  repeat
    Ch:=UpCase(ReadKey);{ Чтение клавиатуры }
    case Ch of
      '0'..'9','A'..'Z':if Length(Buf)<MaxNumberLength then { Набор строки }
                                                         begin
                                                           Buf:=Buf+Ch;
                                                           Write(Ch)
                                                         end;
      #8:if Length(Buf)>0 then begin  { Стирание последнего символа строки }
                                 Buf:=Copy(Buf,1,Length(Buf)-1);
                                 Write(Ch,' ',Ch)
                               end
    end
  until Ch in [#27,#13];  { Выход при нажатии Esc или Enter }
  InputStrInt:=Buf        { Определение значения функции }
End;
Procedure IntFrom10toQ;
  const Int10:longint=0; { Исходное целое }
        Q:byte=2;         { Система счисления получаемого числа }
        Wind:byte=1;      { Текущее окно }
  var ExitInt:boolean; { Флаг выхода }
      Code:integer;  { Номер неправильного символа при преобразавании строки }
  Begin
    ClrScr;   { Очистка экрана }
    TextAttr:=White;                 { Установка белого цвета }
    WriteLn   { Вывод заголовка текущего состояния }
    ('     Перевод целого числа из 10-ичной системы счисления в  Q-ичную');
    TextAttr:=LightGray;{ Установка серого цвета для выводимого текста }
    ExitInt:=FALSE; { Сброс флага "Выход" }
    OutTranslatorWindows; { Вывод окон }
    OutStatus;            { Вывод строки подсказки }
    begin { Вывод информации в окна }
      OutStrInWind(1,StringerInt(Int10));
      OutStrInWind(2,StringerInt(10));
      OutStrInWind(3,StringerInt(Q));
      OutStrInWind(4,TranslatorFrom10toQ(Int10,Q))
    end;
    WindON(Wind);
    repeat
      case ReadKey of
        #72,#80:begin { Изменение окна ввода }
                  WindOFF(Wind); { Гашение окна }
                  if Wind=1 then Wind:=3  { Изменение окна }
                            else Wind:=1;
                  WindON(Wind) { Выделение окна }
                end;
        #13:begin  { Выполнение вычислений }
              if Wind=1 then Val(InputStrInt(Wind),Int10,Code)
                        else begin
                               Val(InputStrInt(Wind),Q,Code);
                               if (Q<MinPower)or(MaxPower<Q) then Code:=1
                             end;
              if Code=0 then OutStrInWind(4,TranslatorFrom10toQ(Int10,Q))
                        else OutStrInWind(Wind,'Параметр неверен')
            end;
        #27:ExitInt:=TRUE
      end
    until ExitInt
  End;
Procedure  ValSt(InputString:string;var IntQ:string;Q:byte;var Error:boolean);
  var Meter:byte; { Счетчик }
      Ch:char; { Вспомогательный буфер }
Begin
  Error:=FALSE;   { Сброс кода ошибки }
  Ch:=Charger(Q-1); { Перевод системы счисления в соответствуюший символ }
  if InputString='' then InputString:='0';
                                     { Переопределение пустой входной строки }
  for Meter:=1 to Length(InputString) do
    Error:=Error or (InputString[Meter]>Ch);
  IntQ:=InputString { Определение выходной строки }
End;
Procedure IntFromQto10;
  const IntQ:string='0'; { Исходное целое }
        Q:byte=2;        { Система счисления исходного числа }
        Wind:byte=1;      { Текущее окно }
  var ExitInt:boolean; { Флаг выхода }
      CodeQ:integer; { Номер неправильного символа при преобразавании строки }
      ErrorTranslat,ErrorInt:boolean; { Флаги ошибки }
  Begin
    ClrScr;   { Очистка экрана }
    TextAttr:=White;                 { Установка белого цвета }
    WriteLn
    ('     Перевод целого числа из  Q-ичной системы счисления в 10-ичную');
    TextAttr:=LightGray;{ Установка серого цвета для выводимого текста }
    ExitInt:=FALSE; { Сброс флага "Выход" }
    CodeQ:=0;  { Сброс номера неправильного символа }
    OutTranslatorWindows; { Вывод окон }
    OutStatus;            { Вывод строки подсказки }
    begin { Вывод информации в окна }
      OutStrInWind(1,IntQ);
      OutStrInWind(2,StringerInt(Q));
      OutStrInWind(3,StringerInt(10));
      OutStrInWind(4,StringerInt(TranslatorFromQto10(IntQ,Q,ErrorTranslat)))
    end;
    WindON(Wind);
    repeat
      case ReadKey of
        #72,#80:begin { Изменение окна ввода }
                  WindOFF(Wind); { Гашение окна }
                  if Wind=1 then Wind:=2  { Изменение окна }
                            else Wind:=1;
                  WindON(Wind) { Выделение окна }
                end;
        #13:begin  { Выполнение вычислений }
              if Wind=1 then ValSt(InputStrInt(Wind),IntQ,Q,ErrorInt)
                        else begin
                               Val(InputStrInt(Wind),Q,CodeQ);
                               if (Q<MinPower)or(MaxPower<Q) then CodeQ:=1;
                               if CodeQ<>0 then
                                 OutStrInWind(Wind,'Параметр неверен');
                               ValSt(IntQ,IntQ,Q,ErrorInt)
                             end;
              if (CodeQ=0)and not ErrorInt
                then
                  begin
                    OutStrInWind
                   (4,StringerInt(TranslatorFromQto10(IntQ,Q,ErrorTranslat)));
                    if ErrorTranslat then OutStrInWind(4,'Переполнение')
                  end
                else OutStrInWind(4,'Ошибка в параметрах');
            end;
        #27:ExitInt:=TRUE
      end
    until ExitInt
  End;
Function TranslatorFromQtoP(IntQ:string;Q,P:byte;var Error:boolean):string;
  Begin
    TranslatorFromQtoP:=
      TranslatorFrom10toQ(TranslatorFromQto10(IntQ,Q,Error),P);
  End;
Procedure IntFromQtoP;
  const IntQ:string='0'; { Исходное целое }
        Q:byte=2;        { Система счисления исходного числа }
        P:byte=2;        { Система счисления получаемого числа }
        Wind:byte=1;     { Текущее окно }
  var ExitInt:boolean; { Флаг выхода }
      BufQP:byte;        { Буфер для ввода систем счисления }
      CodeQP:integer;{ Номер неправильного символа при преобразавании строки }
      ErrorTranslat,ErrorInt:boolean; { Флаги ошибки }
  Begin
    ClrScr;   { Очистка экрана }
    TextAttr:=White;                 { Установка белого цвета }
    WriteLn
       ('     Перевод целого числа из  Q-ичной системы счисления в  P-ичную');
    TextAttr:=LightGray;{ Установка серого цвета для выводимого текста }
    ExitInt:=FALSE; { Сброс флага "Выход" }
    CodeQP:=0;  { Сброс номера неправильного символа }
    OutTranslatorWindows; { Вывод окон }
    OutStatus;            { Вывод строки подсказки }
    begin { Вывод информации в окна }
      OutStrInWind(1,IntQ);
      OutStrInWind(2,StringerInt(Q));
      OutStrInWind(3,StringerInt(P));
      OutStrInWind(4,TranslatorFromQtoP(IntQ,Q,P,ErrorTranslat))
    end;
    WindON(Wind);
    repeat
      case ReadKey of
        #72:begin { Изменение окна ввода }
              WindOFF(Wind); { Гашение окна }
              Wind:=Wind-1;  { Изменение окна }
              if Wind=0 then Wind:=3;
              WindON(Wind) { Выделение окна }
            end;
        #80:begin { Изменение окна ввода }
              WindOFF(Wind); { Гашение окна }
              Wind:=Wind+1;  { Изменение окна }
              if Wind=4 then Wind:=1;
              WindON(Wind) { Выделение окна }
            end;
        #13:begin    { Выполнение вычислений }
              if Wind=1 then ValSt(InputStrInt(Wind),IntQ,Q,ErrorInt)
                        else begin
                               Val(InputStrInt(Wind),BufQP,CodeQP);
                               if (BufQP<MinPower)or(MaxPower<BufQP)
                                 then CodeQP:=1;
                               if CodeQP<>0 then
                                 OutStrInWind(Wind,'Параметр неверен');
                               if Wind=2 then Q:=BufQP
                                         else P:=BufQP;
                               ValSt(IntQ,IntQ,Q,ErrorInt)
                             end;
              if (CodeQP=0) and not ErrorInt
                then
                  begin
                    OutStrInWind
                               (4,TranslatorFromQtoP(IntQ,Q,P,ErrorTranslat));
                    if ErrorTranslat then OutStrInWind(4,'Переполнение')
                  end
                else OutStrInWind(4,'Ошибка в параметрах');
            end;
        #27:ExitInt:=TRUE
      end
    until ExitInt
  End;
Procedure OutResultDiv(Int:string;Error:boolean);
  var Div2,Div3,Div4,Div5,Div6:boolean;
      IntBuf:string;
      Sum:integer;
      Meter,MeterString:byte;  { Счетчики }
  Begin
    if Int='' then Int:='0';
    if not Error
      then
        begin
          GoToXY((80-MaxNumberLength-2) div 2 +1,13); { Установка курсора }
          for Meter:=1 to MaxNumberLength do Write(' ');
          GoToXY((80-MaxNumberLength-2) div 2 +1,13); { Установка курсора }
          Write('Данное число соответствует ',Int,'(10)');
          begin { Определение делимости на 2: }
            Div2:= not Odd(NumberSymbol(Int[Length(Int)]));
            GoToXY((80-MaxNumberLength-2) div 2 +1,WhereY+1);
                                                         { Установка курсора }
            if Div2 then Write('Данное число делится на 2   ')
                    else Write('Данное число не делится на 2')
          end;
          begin { Определение делимости на 3: }
            IntBuf:=Int;
            while Length(IntBuf)>1 do
              begin
                Sum:=0;
                for Meter:=1 to Length(IntBuf) do
                Sum:=Sum+NumberSymbol(IntBuf[Meter]);
                IntBuf:=StringerInt(Sum)
              end;
              Div3:=(IntBuf[1] in ['3','6','9']) or (Int='0');
              GoToXY((80-MaxNumberLength-2) div 2 +1,WhereY+1);
                                                         { Установка курсора }
              if Div3 then Write('Данное число делится на 3   ')
              else Write('Данное число не делится на 3')
          end;
          begin { Определение делимости на 4: }
            IntBuf:=Int;
            if Length(IntBuf)=1 then IntBuf:='0'+IntBuf
                                else IntBuf:=Copy(IntBuf,Length(IntBuf)-1,2);
            Div4:=(Odd(NumberSymbol(IntBuf[1]))and(IntBuf[2]in['2','6']))
                   or
              (not Odd(NumberSymbol(IntBuf[1]))and(IntBuf[2]in['4','8','0']));
            GoToXY((80-MaxNumberLength-2) div 2 +1,WhereY+1);
                                                         { Установка курсора }
            if Div4 then Write('Данное число делится на 4   ')
                    else Write('Данное число не делится на 4')
          end;
          begin { Определение делимости на 5: }
            Div5:=(Int[Length(Int)] in ['5','0']);
            GoToXY((80-MaxNumberLength-2) div 2 +1,WhereY+1);
                                                         { Установка курсора }
            if Div5 then Write('Данное число делится на 5   ')
                    else Write('Данное число не делится на 5')
          end;
          begin { Определение делимости на 6: }
            Div6:=Div2 and Div3;
            GoToXY((80-MaxNumberLength-2) div 2 +1,WhereY+1);
                                                         { Установка курсора }
            if Div6 then Write('Данное число делится на 6   ')
                    else Write('Данное число не делится на 6')
          end;
        end
      else
        begin
          GoToXY((80-MaxNumberLength-2) div 2 +1,13); { Установка курсора }
          for Meter:=1 to MaxNumberLength do Write(' ');
          GoToXY((80-MaxNumberLength-2) div 2 +1,13); { Установка курсора }
          Write('Ошибка в параметрах         ');
          for MeterString:=1 to 5 do
            begin
              GoToXY((80-MaxNumberLength-2) div 2 +1,WhereY+1);
                                                         { Установка курсора }
              for Meter:=1 to MaxNumberLength do Write(' ');
            end
        end
  End;
Procedure DivisibilityVerify23456;
  const Wind:byte=1;     { Текущее окно }
        Q:byte=2;        { Система счисления исходного числа }
        IntQ:string='0'; { Исходное целое }
  var Error,ErrorInt,TranslatError:boolean; { Флаги ошибки }
      MeterY,MeterChar:byte;   { Счетчики строк и символов }
      CodeQ:integer;
      Exit:boolean;   { Флаг выхода }
  Begin
    ClrScr;   { Очистка экрана }
    TextAttr:=White;                 { Установка белого цвета }
    WriteLn('     Определение делимости числа на 2, 3, 4, 5, 6');
    TextAttr:=LightGray;{ Установка серого цвета для выводимого текста }
    GoToXY((80-MaxNumberLength-2) div 2,3);
    Write('Делимое:');
    WindOFF(1);
    OutStrInWind(1,IntQ);
    GoToXY((80-MaxNumberLength-2) div 2,7);
    Write('Система счисления делимого:');
    WindOFF(2);
    OutStrInWind(2,StringerInt(Q));
    Error:=FALSE;          { Сброс флага ошибки }
    ErrorInt:=FALSE;       { Сброс флага ошибки }
    TranslatError:=FALSE;  { Сброс флага ошибки }
    CodeQ:=0;
    begin
        TextAttr:=LightGray;{ Установка серого цвета для выводимого текста }
        GoToXY((80-MaxNumberLength-2) div 2,12);
        Write('┌');
        for MeterChar:=1 to MaxNumberLength do Write('─');
        Write('┐');
        for MeterY:=1 to 6 do
          begin
            GoToXY((80-MaxNumberLength-2) div 2,12+MeterY);
            Write('│');
            GoToXY(79-(80-MaxNumberLength-2) div 2,12+MeterY);
            Write('│')
          end;
        GoToXY((80-MaxNumberLength-2) div 2,13+MeterY);
        Write('└');
        for MeterChar:=1 to MaxNumberLength do Write('─');
        Write('┘');
    end;
    OutStatus;            { Вывод строки подсказки }
    WindON(Wind);
    OutResultDiv(StringerInt(TranslatorFromQto10(IntQ,Q,Error)),Error);
    Exit:=FALSE;   { Сброс флага выход }
    repeat
      case ReadKey of
        #72,#80:begin { Изменение окна ввода }
                  WindOFF(Wind); { Гашение окна }
                  if Wind=1 then Wind:=2  { Изменение окна }
                            else Wind:=1;
                  WindON(Wind) { Выделение окна }
                end;
        #13:begin       { Выполнение вычислений }
              if Wind=1 then ValSt(InputStrInt(Wind),IntQ,Q,ErrorInt)
                        else begin
                               Val(InputStrInt(Wind),Q,CodeQ);
                               if (Q<MinPower)or(MaxPower<Q) then CodeQ:=1;
                               if CodeQ<>0 then
                                 OutStrInWind(Wind,'Параметр неверен');
                               ValSt(IntQ,IntQ,Q,ErrorInt)
                             end;
              OutResultDiv
                      (StringerInt(TranslatorFromQto10(IntQ,Q,TranslatError)),
                       TranslatError or ErrorInt or (CodeQ<>0))
            end;
        #27:Exit:=TRUE
      end
    until Exit
  End;
Procedure RelFrom10toQ;
  Begin
    ClrScr;   { Очистка экрана }
    TextAttr:=White;                 { Установка белого цвета }
    WriteLn
('     Перевод вещественного числа из 10-ичной системы счисления в  Q-ичную');
    TextAttr:=LightGray;{ Установка серого цвета для выводимого текста }
    ReadKey
  End;
Procedure RelFromQto10;
  Begin
    ClrScr;   { Очистка экрана }
    TextAttr:=White;                 { Установка белого цвета }
    WriteLn
('     Перевод вещественного числа из  Q-ичной системы счисления в 10-ичную');
    TextAttr:=LightGray;{ Установка серого цвета для выводимого текста }
    ReadKey
  End;
Procedure RelFromQtoP;
  Begin
    ClrScr;   { Очистка экрана }
    TextAttr:=White;                 { Установка белого цвета }
    WriteLn
('     Перевод вещественного числа из  Q-ичной системы счисления в  P-ичную');
    TextAttr:=LightGray;{ Установка серого цвета для выводимого текста }
    ReadKey
  End;
Procedure OutTxtFile;
  var F:text;
      Buf:string[80];
  Begin
    ClrScr;   { Очистка экрана }
    {$I-}
    Assign(F,'F');
    Reset(F);
    while not EOF(F) do begin
                          ReadLn(F,Buf);
                          WriteLn(Buf)
                        end;
    Close(F);
    ReadKey
    {$I+}
  End;
BEGIN
  TextAttrBuf:=TextAttr;  { Сохранение начальных атрибутов текста }
  Exit:=FALSE;    { Сброс флага "Выход" }
  repeat
    case Menu of       { Выбор действия по ответу на меню }
      1:IntFrom10toQ;
      2:IntFromQto10;
      3:IntFromQtoP;
      4:DivisibilityVerify23456;
      5:RelFrom10toQ;
      6:RelFromQto10;
      7:RelFromQtoP;
      8:OutTxtFile;
      9:Exit:=TRUE  { Подъем флага "Выход" }
    end
  until Exit;
  TextAttr:=TextAttrBuf;  { Востановление начальных атрибутов текста }
  ClrScr;             { Очистка экрана }
END.

Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию