multi(x,y).pas

任何两位任意长度实数相乘

{$N+}     {Change format to IEEE in order to use Double or Extended data type}
program muli(file5);
uses crt;
const
      width = 50; sour='*';   g=10;
var
   ch:Char;

   file5:text;
   n1,n2,n3,n4,code,t1,q1,i1,i2:integer;
   char1,char2,char3,char4,string1:string;
   ch1:string;
   i:integer;
   A1:array[1..130,1..130] of integer;
   A2:array[1..110,1..130] of integer;


procedure show_string_for_1(var name:string);
var
	i:integer;
begin
        write(' ':width+length(char2)-length(char1));
	for i:=1 to length(name)  do
	   begin write(name[i]);
        end;
        writeln;
end;


procedure show_string_for_2(var name:string);
var
	i:integer;
begin
        write(' ':width-(length(char1)-length(char2)));
	for i:=1 to length(name)  do
	   begin write(name[i]);
        end;
        writeln;
end;


procedure show_string(var name:string);
var
	i:integer;
begin
        write(' ':width);
	for i:=1 to length(name)  do
	   begin write(name[i]);
        end;
        writeln;
end;



procedure show_string_for_f1(var name:string);
var
	i:integer;
begin
        write(file5,' ':width+length(char2)-length(char1));
	for i:=1 to length(name)  do
	   begin write(file5,name[i]);
        end;
        writeln(file5);
end;

procedure show_string_for_f2(var name:string);
var
	i:integer;
begin
        write(file5,' ':width-(length(char1)-length(char2)));
	for i:=1 to length(name)  do
	   begin write(file5,name[i]);
        end;
        writeln(file5);
end;


procedure show_string_for_file(var name:string);
var
	i:integer;
begin
        write(file5,' ':width);
	for i:=1 to length(name)  do
	   begin write(file5,name[i]);
        end;
        writeln(file5);
end;



procedure clear_zero_A1(len1,len11:integer);
var
   i,j:integer;
begin
	for i:=1 to (len1) do
		begin
	 	for j:=1 to (len11+width) do
		A1[i,j]:=0;
	end;
end;

procedure clear_zero_A2(len1,len11:integer);
var
   i,j:integer;
begin
	for i:=1 to (len1) do
		begin
	 	for j:=1 to (len11+width) do
		A2[i,j]:=0;
	end;
end;


procedure show_last_row(i,len11:integer);
var
	j:integer;
begin
	for j:=1 to (len11+width) do
	write(A1[i,j]);
	writeln;
end;


procedure show_last_row2(i,len11:integer);
var
	j:integer;
begin
     for j:=1+(length(char1)-length(char2)-1) to (len11+width) do
     write(A2[i,j]);
     writeln;
end;


procedure show_last_row2_f(i,len11:integer);
var
	j:integer;
begin
     for j:=1+(length(char1)-length(char2)-1) to (len11+width) do
     write(file5,A2[i,j]);
     writeln(file5);
end;


procedure jisuan1(n2:integer);
var
        char3:string[1];
	i,j,m,n3,code,s1,s11,s111:integer;
begin

     i := 1; s1 := 0; s11 := 0;
     for j := length(char1) downto 1 do
     begin
	      char3 := char1[j];
		  val(char3,n3,code);
		  m := n3 * n2;
          if (m>=10)
		  then begin
               A1[i,j + width] := m mod 10; A1[i,j-1+width] := m div 10;
          end
		  else A1[i,j + width] := m;
		       i := i + 1;
          end;

          for j := length(char1) + width downto 1 do
              begin
              for i := 1 to length(char1) do
                  s1 := A1[i,j] + s1;
                  s111 := s1 + s11;
                  s11 := 0;
              if (s111 >= 10)
              then begin
                   A1[length(char1)+1,j] := s111 mod 10; s11 := s111 div 10;
              end
              else A1[length(char1)+1,j] := s111;
              s1:=0;
     end;
end;

{Name:  Input:  Output:  Comment:}
procedure jisuan2(i,i1:integer);
var
   j,m,n3,code,s1,s11,s111:integer;
begin

     for j := length(char1) + width downto 1 do
         A2[i,j-i1] := A1[length(char1) + 1,j];

end;
procedure jisuan3;
var
	j,m,n3,code,s1,s11,s111:integer;
begin
     i  :=  1;
     s1 :=  0;
     s11:=  0;
	for j := length(char1) + width downto 1 do
            begin
                 for i := 1 to length(char2) do
                 s1 := A2[i,j] + s1;
                 s111 := s1 + s11;
                 s11  := 0;
            if (s111 >= 10)
            then begin
                 A2[length(char2) + 1,j]:=s111 mod 10; s11 := s111 div 10;
            end
            else A2[length(char2) + 1,j]:=s111;
            s1:=0;
        end;
end;



{ Main Function }
begin
     ch := '0';

while ch <> 'n' do
begin

     assign(file5,'mu5.txt');
     rewrite(file5);

     write('x =');
     readln(char1);
     write('y =');
     readln(char2);
     insert(sour,char2,0);


     if (length(char1) <= length(char2))	then
     begin
	show_string_for_1(char1);
        show_string_for_f1(char1);
     end
     else
     begin
	show_string_for_2(char1);
        show_string_for_f2(char1);
     end;

     show_string(char2);
     show_string_for_file(char2);
     write(' ':width);
     write(file5,' ':width);

     { title for "----------"}
     for n1:=1 to length(char2) do
     begin
         write('-'); write(file5,'-');
     end;

    writeln(file5);
    delete(char2, 0, 1);
    writeln;
    t1 := 0;
    i2 := 1;
    i1 := 0;
    clear_zero_A2(length(char1) + 1,length(char1));


    { procedure to output to screen }
    for i:=length(char2) downto 1 do
    begin
	ch1 := char2[i];
	val(ch1, n2, code);
    clear_zero_A1(length(char1) + 1,length(char1) + 1);
	jisuan1( n2 );
    jisuan2(i2, i1);
	show_last_row2(i2,length(char1));
    show_last_row2_f(i2,length(char1));
    i2 := i2 + 1;
    i1 := i1 + 1;
    end;



    for n4:=1 to (width+length(char2)+1) do
    begin
	write('-');
    write(file5,'-');
    end;

    writeln;
    writeln(file5);
    jisuan3;
    show_last_row2(length(char2)+1,length(char1));
    show_last_row2_f(length(char2)+1,length(char1));
    close(file5);

    while (ch <> 'y') or (ch <> 'n') do
    begin
         writeln('Continue?(y/n)');
         readln(ch);
         if (ch = 'y') or (ch = 'n')  then  break;
    end;
end;
end.