Неверно отображается кирилица - Turbo Pascal - Ответ 3099907

uses crt;
const max=23;
      Smax=25;
      Xmax=48;
   type
   str25=string[25];
   str48=string[48];
 
var Delimoe, Delitel, MinusDelitel:real;
    Mas1,Mas2,MinusMas2:STR25;
    PrMas1, PrMas2: STR25;
    MasR:STRING[64];
    R: str48;
    DT: string[32];
    ES: string[8];
    klav:  char;
    i,j,k,norm,E:integer;
    otvet,TOtvet: real;
    ZN1,ZN2,ZN3,ZNR:0..1;         {znak chisel}
    Por1,Por2,Por3,PorR:integer;     {poryadok chisel}
    DMasR:STRING[MAX+2];
    RDMas1,RDMas2,MinusRDMas2:str25;  {rez dopoln coda}
    Otv,s1,s2: string;
    M: boolean;
    F1:text;
 
procedure PerevodChisel(var chis1, chis2,minusChis2: real);
var Cel1,Cel2,Cel3:longint;
    Drob1,Drob2,Drob3:Real;
    Cif:BYTE;
begin
 if (chis1<0)then
   begin
    zn1:=1;
    chis1:=ABS(chis1)
   end
 else zn1:=0;
 if (chis2<0)then
   begin
    zn2:=1;
    chis2:=ABS(chis2)
   end
 else zn2:=0;
 if (minuschis2<0)then
   begin
    zn3:=1;
    minuschis2:=ABS(minuschis2)
   end
 else zn3:=0;
 
 if (chis1>=1) or (chis1<=-1) then begin
 Cel1:=Trunc(chis1);
  while Cel1<>1 do
   begin
    Cif:=Cel1 mod 2;  {rezyltat do zapatoi}
    Cel1:=Cel1 div 2;
      Mas1:=CHR(Cif+48) + Mas1;
   end;
   IF Cel1=1 THEN Mas1:=CHR(49) + Mas1;
   Por1:=por1+Length(Mas1);
 end
 else Por1:=0;
  {drob}
  Drob1:=Frac(Chis1);
  REPEAT
    Cif:=Trunc(Drob1*2);
    Drob1:=Frac(Drob1*2);
    Mas1:=Mas1+CHR(Cif+48);
  UNTIL Length(Mas1)=23;
  Writeln(' A  ',Mas1,'*2^',Por1);
  Writeln(f1,' A  ',Mas1,'*2^',Por1 );
 
  {perevod 2-ogo chisla}
  if (chis2>=1) or (chis2<=-1) then begin
  Cel2:=Trunc(chis2);
  while Cel2<>1 do
   begin
    Cif:=Cel2 mod 2;  {rezyltat do zapatoi}
    Cel2:=Cel2 div 2;
    Mas2:=CHR(Cif+48) + Mas2;
   end;
   IF Cel2=1 THEN Mas2:=CHR(49) + Mas2;
   Por2:=Length(Mas2);
   end
   else Por2:=0;
  {drob}
   Drob2:=Frac(Chis2);
   REPEAT
    Cif:=Trunc(Drob2*2);
    Drob2:=Frac(Drob2*2);
    Mas2:=Mas2+CHR(Cif+48);
   UNTIL Length(Mas2)=23;
Writeln(' B  ',Mas2,'*2^',Por2);
Writeln(f1,' B  ',Mas2,'*2^',Por2);
 if (minusChis2>=1) or (minusChis2<=-1) then begin
 Cel3:=Trunc(minuschis2);
  while Cel3<>1 do
   begin
    Cif:=Cel3 mod 2;  {rezyltat do zapatoi}
    Cel3:=Cel3 div 2;
    MinusMas2:=CHR(Cif+48) + MinusMas2;
   end;
   IF Cel3=1 THEN MinusMas2:=CHR(49) + MinusMas2;
   Por3:=Length(MinusMas2);
   end
   else Por3:=0;
  {drob}
   Drob3:=Frac(minusChis2);
   REPEAT
    Cif:=Trunc(Drob3*2);
    Drob3:=Frac(Drob3*2);
    MinusMas2:=MinusMas2+CHR(Cif+48);
   UNTIL Length(MinusMas2)=23;
   Writeln('-B ',MinusMas2,'*2^',Por3);
   Writeln(f1,'-B ',MinusMas2,'*2^',Por3);
 end;
 
procedure SmeshPor(var ESM: integer);
var Cel1:longint;
    Drob1:Real;
    Cif:BYTE;
begin
 ESM:=ABS(ESM);
 Cel1:=Trunc(ESM);
  while Cel1<>1 do
   begin
    Cif:=Cel1 mod 2;
    Cel1:=Cel1 div 2;
      ES:=CHR(Cif+48) + ES;
   end;
   IF Cel1=1 THEN ES:=CHR(49) + ES;
end;
 
procedure PVDK;
var DMas1,DMas2,MinusDMas2:STRING[max+2]; {promezhytoch perem}
begin
     DMas1:=Mas1;
     DMas2:=Mas2;
     MinusDMas2:=MinusMas2;
     RDMas1:=mas1;
     RDMas2:=mas2;
     MinusRDMas2:=Minusmas2;
    if ZN1=1 then
     begin
       for i:=1 to max do
         begin
           if DMas1[i]='1' then DMas1[i]:='0'
             else DMas1[i]:='1';
         end;
       for i:=max downto 1 do
         if DMas1[i]='1' then
            begin
                      RDMas1[i-1]:='1';
                      RDMas1[i]:='0';
            end
          else
           begin
            RDMas1[i]:='1';
            for j:=i-1 downto 1 do
             RDMas1[j]:=DMas1[j];
            i:=1;
           end;
     end
      else begin
       DMas1:=Mas1;
       RDMas1:=Mas1;
       end;
 
    if ZN2=1 then
     begin
       for i:=1 to max do
         begin
           if DMas2[i]='1' then DMas2[i]:='0'
             else DMas2[i]:='1';
         end;
       for i:=max downto 1 do
         if DMas2[i]='1' then
            begin
              RDMas2[i-1]:='1';
              RDMas2[i]:='0';
            end
          else
           begin
            RDMas2[i]:='1';
            for j:=i-1 downto 1 do
             RDMas2[j]:=DMas2[j];
            i:=1;
           end;
       end
       else begin
       DMas2:=Mas2;
       RDMas2:=Mas2;
       end;
 
        {Perevodim otricatelnoe 2 v dop kod}
     if zn3=1 then
     begin
        for i:=1 to max do
         begin
           if MinusDMas2[i]='1' then MinusDMas2[i]:='0'
             else MinusDMas2[i]:='1';
         end;
       for i:=max downto 1 do
         if MinusDMas2[i]='1' then
            begin
              MinusRDMas2[i-1]:='1';
              MinusRDMas2[i]:='0';
            end
          else
           begin
            MinusRDMas2[i]:='1';
            for j:=i-1 downto 1 do
             MinusRDMas2[j]:=MinusDMas2[j];
            i:=1;
           end;
     end
      else begin
       MinusDMas2:=MinusMas2;
       MinusRDMas2:=MinusMas2;
       end;
     WRITELN('Obratnui kod mantucc');
    WRITELN('delumoe        :  ',DMas1);
    WRITELN('delitel        :  ',DMas2);
    write(  'minus delitelb :  ',MinusDmas2);
    WRITELN(f1,'Obratnui kod mantucc');
    WRITELN(f1,'delumoe        :  ',DMas1);
    WRITELN(f1,'delitel        :  ',DMas2);
    writeln(  f1,'minus delitelb :  ',MinusDmas2);
    readln;
    writeln; writeln(f1);
      WRITELN('Dopolnitelbhui kod mantucc');
      WRITELN('delimoe       :  ',RDMas1);
      WRITELN('delitel       :  ',RDMas2);
      WRITE(  'minus delitelb:  ',MINUSRDMas2);
       WRITELN(f1,'Dopolnitelbhui kod mantucc');
      WRITELN(f1,'delimoe       :  ',RDMas1);
      WRITELN(f1,'delitel       :  ',RDMas2);
      WRITEln(  f1,'minus delitelb:  ',MINUSRDMas2);
      readln;
end;
 
procedure SdvigPlus1;
 begin
    PrMas1:=Mas1;
    PrMas2:=Mas2;
  REPEAT
    Mas1:=Mas1+'  ';
    Mas2:=Mas2+'  ';
    MinusMas2:=MinusMas2+'  ';
    RDMas1:=RDMas1+'  ';
    RDMas2:=RDMas2+'  ';
    MinusRDMas2:=MinusRDMas2+'  ';
  UNTIL (Length(RDMas1)=25) or  (Length(RDMas2)=25 )
        or(Length(Mas1)=25) or(Length(Mas2)=25 )
        or (Length(Minusmas2)=25) or(Length(MinusRDMas2)=25 );
  for i:=max+2 downto 3 do
   begin
    RDMas1[i]:=RDmas1[i-2];
    RDMas2[i]:=RDmas2[i-2];
    MinusRDMas2[i]:=MinusRDMas2[i-2];
    Mas1[i]:=mas1[i-2];
    Mas2[i]:=mas2[i-2];
    MinusMas2[i]:=MinusMas2[i-2];
   end;
   for i:=1 to 2 do
    begin
       if ZN1=1 then RDMAS1[i]:='1'
       else RDMAS1[i]:='0';
 
       if ZN2=1 then RDMAS2[i]:='1'
       else RDMAS2[i]:='0';
       if ZN3=1 then MinusRDMAS2[i]:='1'
       else MinusRDMAS2[i]:='0';
    end;
    writeln(' A  ',RDMas1);
    writeln(' B  ',RDMas2);
    writeln  ('-B  ',MinusRDMas2);
    writeln(f1,' A  ',RDMas1);
    writeln(f1,' B  ',RDMas2);
    writeln  (f1,'-B  ',MinusRDMas2);
    readln;
end;
 
 
function SUMM(RezS,Mas:string):string;
var ost:char;
    Rez:string;                  {rez- promejytochn rezyltat}
begin
 Writeln(RezS);
   Writeln('+');
   Writeln(Mas);
   Writeln(f1,RezS);
   Writeln(f1,'+');
   Writeln(f1,Mas);
   Rez:=Rezs;
   ost:='0';
   for i:=Smax downto 1 do
      if (RezS[i]='0') and (Mas[i]='0') and (ost='0') then
        Rez[i]:='0'
      else
      begin
         if ((RezS[i]='1') or (Mas[i]='1')) and (ost='1') then
            Rez[i]:='0'
         else
         begin
            Rez[i]:='1';
            ost:='0';
         end;
         if  (RezS[i]='1') and (Mas[i]='1') then
         begin
            Rez[i]:=ost;
            ost:='1';
         end;
     end;
     RezS:=Rez;
      writeln('rezultat=');
    writeln(rez);
    writeln(f1,'rezultat=');
    writeln(f1,rez);
    readln;
    SUMM:=rez;
end;
 
procedure NORMALIZACIYA(var Q: str25);
    var i: integer;
        e: string;
    begin
       for i:=2 to Smax do
          e[i]:=q[i-1];
       e[1]:=q[1];
       por1:=por1+1;
       for i:=1 to Smax do
       q[i]:=e[i];
    end;
 
procedure Proverka(var A,B: str25);
var N: integer;
 
    procedure NORMALPR(var Q: str25);
    var i: integer;
        e: string;
    begin
       for i:=2 to 23 do
          e[i]:=q[i-1];
       e[1]:='0';
       for i:=1 to Smax do
       q[i]:=e[i];
    end;
 
begin
    Writeln('Proveryaem');
   Writeln(f1,'Proveryaem');
   M:=False;
   N:=1;
   while (M=False) and (N<24) do begin
      if (A[N]='0') and (B[N]='1') then
         M:=True;
      if (A[N]='1') and (B[N]='0') then begin
         Norm:=Norm+1;
         NORMALPR(A);
         Proverka(A,B);
      end;
      N:=N+1;
   end;
   readln;
end;
 
procedure NormDop(var A: str25; Norm: integer);
begin
   if Norm<>0 then
      for i:=1 to Norm do
         NORMALIZACIYA(A);
   write('Normalizaciya Vipolnena');
   write(f1,'Normalizaciya Vipolnena');
   readln;
end;
 
procedure DELENIE(var X,Y,MY: str25);
var
   B: Boolean;
   P: integer;
   F: str25;
 
   function SDVIG(var Mas:str48):str48;
   begin
      FOR I:=1 TO 47 DO
      Mas[I]:=Mas[I+1];
      Mas[Xmax]:='0';
      WRITELN('sdvigaem Ha 1 razryad');
      WRITELN(f1,'sdvigaem Ha 1 razryad');
      for i:=1 to 48 do
      WRITE(mas[i]);  writeln;
      WRITE(f1,mas[i]);
      writeln(f1);
      SDVIG:=mas;
   end;
 
begin
    Writeln('delenie:');
   Writeln(f1,'delenie:');
   for i:=1 to 25 do
      R[i]:=X[i];
   for i:=26 to Xmax do
      R[i]:='0';
   Writeln('R');
   Writeln(f1,'R');
   for i:=1 to 48 do
   Write(R[i]);  Write(f1,R[i]);
   writeln;  writeln(f1);
 
   if ((zn1=0) and (zn2=0))then begin
      B:=False;
      for P:=1 to 23 do begin
         writeln('Shag #',P);
         writeln(f1,'Shag #',P);
         R:=SDVIG(R);
         for i:=1 to Smax do
            F[i]:=R[i];
         if not B then F:=SUMM(F,MY)
         else F:=SUMM(F,Y);
         if F[1]='0' then begin
            R[XMax]:='1';
            B:=False;
         end
         else begin
            R[Xmax]:='0';
            B:=True;
         end;
         for i:=1 to Smax do
            R[i]:=F[i];
      end;
   end;
 
   if ((zn1=0) and (zn2=1))then begin
      B:=True;
      P:=1;
      for P:=1 to 23 do begin
         writeln('Shag #',P);
         writeln(f1,'Shag #',P);
         R:=SDVIG(R);
         for i:=1 to Smax do
            F[i]:=R[i];
         if not B then F:=SUMM(F,MY)
         else F:=SUMM(F,Y);
         if F[1]='0' then begin
            R[XMax]:='1';
            B:=True;
         end
         else begin
            R[Xmax]:='0';
            B:=False;
         end;
         for i:=1 to Smax do
            R[i]:=F[i];
      end;
   end;
 
   if ((zn1=1) and (zn2=0))then begin
      B:=True;
      for P:=1 to 23 do begin
         writeln('Shag #',P);
         writeln(f1,'Shag #',P);
         R:=SDVIG(R);
         for i:=1 to Smax do
            F[i]:=R[i];
         if not B then F:=SUMM(F,MY)
         else F:=SUMM(F,Y);
         if F[1]='0' then begin
            R[XMax]:='0';
            B:=False;
         end
         else begin
            R[Xmax]:='1';
            B:=True;
         end;
         for i:=1 to Smax do
            R[i]:=F[i];
      end;
   end;
 
   if ((zn1=1) and (zn2=1))then begin
      B:=False;
      for P:=1 to 23 do begin
         writeln('Shag #',P);
         writeln(f1,'Shag #',P);
         R:=SDVIG(R);
         for i:=1 to Smax do
            F[i]:=R[i];
         if not B then F:=SUMM(F,MY)
         else F:=SUMM(F,Y);
         if F[1]='0' then begin
            R[XMax]:='0';
            B:=True;
         end
         else begin
            R[Xmax]:='1';
            B:=False;
         end;
         for i:=1 to Smax do
            R[i]:=F[i];
      end;
   end;
 
   for i:=1 to 48 do
   write(R[i]);
   write(f1,R[i]);
   writeln;  WRITELN(f1);
   Write('Otvet:');
   Write(f1,'Otvet:');
   for i:=26 to 48 do
   write(R[i]);
   write(f1,R[i]);
   for i:=26 to 48 do
   Otv[i-25]:=R[i];
   writeln; writeln(f1);
end;
 
procedure PerevodVDes(var otv: string);
var A,W,k,step: integer;
    T,otcel,otvdrobn: real;
    Cel,Drob: string;
begin
 
   if porR>0 then begin
      for i:=1 to porR do
         cel[i]:=otv[i];
      W:=0;
      for i:=(porR+1) to max do begin
         drob[i-porR]:=otv[i];
         W:=W+1;
      end;
 
      otcel:=0;
      step:=0;
      for i:=porR downto 1 do begin
         if Cel[i]='1' then begin
            T:=1;
            if step=0 then otcel:=otcel
         else
         for A:=1 to step do
            T:=T*2;
         otcel:=otcel+T;
      end;
      step:=step+1;
   end;
   end;
 
   if porR<0 then begin
      k:=1;
      W:=23;
      otcel:=0;
      for i:=1 to abs(PorR) do
         drob[i]:='0';
      for  i:=(abs(PorR)+1) to max do begin
         drob[i]:=otv[k];
         k:=k+1;
      end;
   end;
 
   if porR=0 then begin
      W:=23;
      otcel:=0;
      for i:=1 to 23 do
         drob[i]:=otv[i];
   end;
 
   otvdrobn:=0;
   step:=1;
   for i:=1 to W do begin
      if Drob[i]='1' then begin
         T:=1;
         for A:=1 to step do
            T:=T*2;
         otvdrobn:=otvdrobn+1/T;
      end;
      step:=step+1;
   end;
 
   otvet:=otcel+otvdrobn;
   if ((ZN1=0) and (ZN2=1)) or ((ZN1=1) and (ZN2=0)) then
   otvet:=otvet*(-1);
end;
 
function Pogreshnost(var A,B: real): real;
begin
   Pogreshnost:=abs(A-B);
end;
 
function StrToReal(S:STR48):real;
var Ext:real;
    zn:integer;
    t,e:integer;
    i,n,por:integer;
    p:real;
begin
Ext:=0;zn:=1;t:=0;e:=0;p:=1;por:=0;
if S[1]='-' then begin
   delete(S,1,1);
   zn:=-1;
   end;
   n:=length(S);
   for i:=1 to n do begin
       if (S[i]=',') or (S[i]='.') then t:=i;
       if (S[i]='E') or (S[i]='e') then e:=i;
end;
    if t<>0 then begin
    for i:=1 to t-2 do p:=p*10;
    if e<>0 then begin
    for i:=1 to e-1 do begin
    if i<>t then begin
       Ext:=Ext+(ord(S[i])-48)*p;
    p:=p*0.1;
end;
end;
p:=1;
for i:=1 to n-e-2 do p:=p*10;
    for i:=e+2 to n do begin
        por:=por+trunc((ord(S[i])-48)*p);
        p:=p*0.1;
    end;
    if S[e+1]='+' then begin
    for i:=1 to por do Ext:=Ext*10;
    end
else begin
for i:=1 to por do Ext:=Ext*0.1;
end;
end
else begin
for i:=1 to n do begin
    if i<>t then begin
    Ext:=Ext+(ord(S[i])-48)*p;
    p:=p*0.1;
end;
end;
end;
end
else begin
for i:=1 to e-2 do p:=p*10;
if e<>0 then begin
for i:=1 to e-1 do begin
Ext:=Ext+(ord(S[i])-48)*p;
p:=p*0.1;
end;
por:=0;p:=1;
for i:=1 to n-e-2 do p:=p*10;
for i:=e+2 to n do begin
por:=por+trunc((ord(S[i])-48)*p);
p:=p*0.1;
end;
if S[e+1]='+' then begin
for i:=1 to por do Ext:=Ext*10;
end
else begin
for i:=1 to por do Ext:=Ext*0.1;
end;
end
else begin
for i:=1 to n do begin
Ext:=Ext+(ord(S[i])-48)*p;
p:=p*0.1;
end;
end;
end;
Ext:=Ext*zn;
StrToreal:=Ext;
end;
 
begin
   clrscr;
   assign(f1, 'resultat.txt');
   rewrite(f1);
 
   writeln('                           KypcoBay rabota po informatuke');
   writeln('          Delenue Chusel v Dopolnitelnom kode bez vocctanovlenuya ostatka');
   writeln('                                 Odunarnay tochnost');
   writeln;
   writeln('                    Vupolnul student gr IVT-42-11 Ivanov Sergey');
   readln;
   clrscr;
   Norm:=0;
 
   writeln('vvedite delimoe');
   writeln(f1,'vvedite delimoe');
   readln(s1);  writeln(f1,s1);  {chislo}
   writeln('vvedite delitel ');
   writeln(f1,'vvedite delitel');
   readln(s2); writeln(f1,s2);
   delimoe:=strtoreal(s1);
   delitel:=strtoreal(s2);
   if Delimoe=0 then
   writeln('delimoe ravno 0. rezultat=0');
   if Delitel=0 then
   writeln('Ha 0 delitb Helzya!!!я');
   readln;
   if (Delimoe<>0) and (Delitel<>0) then begin
      Totvet:=Delimoe/Delitel;
      MinusDelitel:=(-1)*Delitel;
      PerevodChisel(Delimoe, Delitel, MinusDelitel);
      writeln;
      PVDK; {Perevod v dopolnitel'nyi kod}
      writeln;
      SdvigPlus1; {Mesto dlya znaka}
      Proverka(PrMas1,PrMas2);
      NormDop(RDmas1,Norm);
      PorR:=Por1-Por2;
      Delenie(RDMas1,RDMas2,MinusRDMas2);
      PerevodVDes(Otv);
      if otvet<0 then DT[1]:='1'
      else DT[1]:='0';
      E:=porR+127;
      SmeshPor(E);
      for i:=1 to 8 do
         DT[i+1]:=ES[i];
      for i:=10 to 31 do
         DT[i]:=R[i+17];
      DT[32]:='0';
      write('rezultat v formate odinarnoi tochnostu:');
      write(f1,'rezultat v formate odinarnoi tochnostu:');
      writeln; writeln(f1);
      for i:=1 to 32 do
      write(DT[i]);
      write(f1,DT[i]);
      writeln; writeln(f1);
      readln;
       Writeln('Poryadok:',PorR);
      writeln('Otvet:',otvet:10:10);
      Writeln('Pogreshnost vichusleniya:');
      Writeln(f1,'Poryadok:',PorR);
      writeln(f1,'Otvet:',otvet:10:10);
      Writeln(f1,'Pogreshnost vichusleniya:');
      Write(Pogreshnost(Totvet, otvet):10:10);
      Write(f1,Pogreshnost(Totvet, otvet):10:10);
      close(f1);
   end;
end.