Деление многозначных чисел с остатком — Pascal(Паскаль)

Program Delenie;
Uses
  Crt;
Const
  Max=1000;
Type
  Mas=Array[1..Max] Of ShortInt;
Var
  S:Boolean;
  M1,M2:String;
  A1,A2,Mm1,Mm2,P:Mas;
  Cod:Integer;
  f,k,l,i,j,z,C,q,sum:Integer;
  M,N1,N2:Integer;
Function Sravn(M:Integer;A1,Mm2:Mas):Boolean;
  Var
    k:Integer;
  Begin
    if M<>N2 then Sravn:=(M>N2)
    else begin
       Sravn:=true;
       k:=1;
       while (k<=M)and(A1[k]=Mm2[k])do inc(k);
       if (k<=M)then Sravn:=(A1[k]>Mm2[k]);
    end;
  End;
Begin
  ClrScr;
  WriteLn(' Vvedite delimoe');
  ReadLn(M1);
  N1:=LengTh(M1);
  For i:=1 To N1 Do Val(M1[i],Mm1[i],Cod);
  WriteLn(' Vvedite delitel');
  ReadLn(M2);
  N2:=LengTh(M2);
  For i:=1 To N2 Do Val(M2[i],Mm2[i],Cod);
  For i:=1 To N2-1 Do A1[i]:=Mm1[i];
  M:=N2-1;
  i:=M;
  While(i<N1)Do
    Begin
      While ((Sravn(M,A1,Mm2)=False) And (i<N1)) Do
        Begin
          sum:=0;
          for q:=1 to M do
            begin
              sum:=sum+A1[q];
              if sum<>0 then break;
            end;
          if ((M>0)and(sum<>0))or(M=0) then M:=M+1;
          i:=i+1;
          A1[M]:=Mm1[i];
        End;
      j:=0;
      While(Sravn(M,A1,Mm2)=True)Do
        Begin
          f:=N2+1;
          For k:=M DownTo M-N2 Do
            Begin
              f:=f-1;
              If A1[k]>=Mm2[f] Then A2[k]:=A1[k]-Mm2[f]
              Else
                Begin
                  A1[k]:=A1[k]+10;
                  A1[k-1]:=A1[k-1]-1;
                  For l:=k DownTo 1 Do
                  If A1[l]<0 Then
                     Begin
                       A1[l-1]:=A1[l-1]-1;
                       A1[l]:=A1[l]+10;
                     End;
                  A2[k]:=A1[k]-Mm2[f];
                End;
            End;
          For l:=M-N2-1 DownTo 1 Do
          A2[l]:=A1[l];
          j:=j+1;
          P[i-N2+1]:=j;
          While((A2[1]=0)And(M>0))Do
            Begin
              For z:=1 To M-1 Do
              A2[z]:=A2[z+1];
              M:=M-1;
              A2[M+1]:=0;
            End;
          For z:=1 To M Do
          A1[z]:=A2[z];
        End;
      While((A1[1]=0)And(M>0))Do
        Begin
          For z:=1 To M-1 Do
          A1[z]:=A1[z+1];
          M:=M-1;
          A1[M+1]:=0;
        End;
    End;
  WriteLn(' Chastnoe: ');
  j:=1;
  While ((P[j]=0)And(j>=N1-N2)) Do j:=j+1;
  while P[j]=0 do inc(j);
  For i:=j To N1-N2+1 Do Write(P[i]);
  WriteLn;
  If M=0 Then
    Begin
      M:=1;
      A1[M]:=0;
    End;
  WriteLn(' Ostatok');
  For i:=1 To M Do Write(A1[i]);
  ReadLn;
End.

Leave a Comment

5 + 1 =