Advertisement
Guest User

Untitled

a guest
Dec 7th, 2016
68
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 2.53 KB | None | 0 0
  1. Uses
  2.   Crt;
  3. Const
  4.   Max=255;
  5. Type
  6.   Mas=Array[0..Max] Of Byte;
  7. Var
  8.   S:Boolean;
  9.   M1,M2:String;
  10.   A1,A2,Mm1,Mm2,P:Mas;
  11.   Cod:Integer;
  12.   f,k,l,i,j,z,C,q,sum:Integer;
  13.   M,N1,N2:Integer;
  14. Function Sravn(M:Integer;A1,Mm2:Mas):Boolean;
  15.   Var
  16.     k:Integer;
  17.   Begin
  18.     if M<>N2 then Sravn:=(M>N2)
  19.     else begin
  20.        Sravn:=true;
  21.        k:=1;
  22.        while (k<=M)and(A1[k]=Mm2[k])do inc(k);
  23.        if (k<=M)then Sravn:=(A1[k]>Mm2[k]);
  24.     end;
  25.   End;
  26. Begin
  27.   ClrScr;
  28.   WriteLn(' Vvedite delimoe');
  29.   ReadLn(M1);
  30.   N1:=LengTh(M1);
  31.   For i:=1 To N1 Do Val(M1[i],Mm1[i],Cod);
  32.   WriteLn(' Vvedite delitel');
  33.   ReadLn(M2);
  34.   N2:=LengTh(M2);
  35.   For i:=1 To N2 Do Val(M2[i],Mm2[i],Cod);
  36.   For i:=1 To N2-1 Do A1[i]:=Mm1[i];
  37.   M:=N2-1;
  38.   i:=M;
  39.   While(i<N1)Do
  40.     Begin
  41.       While ((Sravn(M,A1,Mm2)=False) And (i<N1)) Do
  42.         Begin
  43.           sum:=0;
  44.           for q:=1 to M do
  45.             begin
  46.               sum:=sum+A1[q];
  47.               if sum<>0 then break;
  48.             end;
  49.           if ((M>0)and(sum<>0))or(M=0) then M:=M+1;
  50.           i:=i+1;
  51.           A1[M]:=Mm1[i];
  52.         End;
  53.       j:=0;
  54.       While(Sravn(M,A1,Mm2)=True)Do
  55.         Begin
  56.           f:=N2+1;
  57.           For k:=M DownTo M-N2 Do
  58.             Begin
  59.               f:=f-1;
  60.               If A1[k]>=Mm2[f] Then A2[k]:=A1[k]-Mm2[f]
  61.               Else
  62.                 Begin
  63.                   A1[k]:=A1[k]+10;
  64.                   A1[k-1]:=A1[k-1]-1;
  65.                   For l:=k DownTo 1 Do
  66.                   If A1[l]<0 Then
  67.                      Begin
  68.                        A1[l-1]:=A1[l-1]-1;
  69.                        A1[l]:=A1[l]+10;
  70.                      End;
  71.                   A2[k]:=A1[k]-Mm2[f];
  72.                 End;
  73.             End;
  74.           For l:=M-N2-1 DownTo 1 Do
  75.           A2[l]:=A1[l];
  76.           j:=j+1;
  77.           P[i-N2+1]:=j;
  78.           While((A2[1]=0)And(M>0))Do
  79.             Begin
  80.               For z:=1 To M-1 Do
  81.               A2[z]:=A2[z+1];
  82.               M:=M-1;
  83.               A2[M+1]:=0;
  84.             End;
  85.           For z:=1 To M Do
  86.           A1[z]:=A2[z];
  87.         End;
  88.       While((A1[1]=0)And(M>0))Do
  89.         Begin
  90.           For z:=1 To M-1 Do
  91.           A1[z]:=A1[z+1];
  92.           M:=M-1;
  93.           A1[M+1]:=0;
  94.         End;
  95.     End;
  96.   WriteLn(' Chastnoe: ');
  97.   j:=1;
  98.   While ((P[j]=0)And(j>=N1-N2)) Do j:=j+1;
  99.   while P[j]=0 do inc(j);
  100.   For i:=j To N1-N2+1 Do Write(P[i]);
  101.   WriteLn;
  102.   If M=0 Then
  103.     Begin
  104.       M:=1;
  105.       A1[M]:=0;
  106.     End;
  107.   WriteLn(' Ostatok');
  108.   For i:=1 To M Do Write(A1[i]);
  109.   ReadLn;
  110. End.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement