Показать сообщение отдельно
Старый 17.01.2016, 22:15   #3 (permalink)
Евгений
Member
 
Аватар для Евгений
 
Регистрация: 31.03.2010
Адрес: Тульская область
Сообщений: 1,309
Сказал(а) спасибо: 11
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 13090
По умолчанию

Владимир Игоревич, я попробовал(только сильно не пинайте):

Код:
function Summa(ast1,ast2:string):string;
var  b,b1,b2,b3,b4:byte;
begin
      b1:=Length(ast1);
      b2:=Length(ast2);
          b4:=0;
          While b2<>0 do
           begin
             b:=(Ord(ast1[b1])-Ord('0'))+(Ord(ast2[b2])-Ord('0'))+b4;
             b3:=b mod 10;
             ast1[b1]:=Char(b3+Ord('0'));
             b4:=b div 10;
             Dec(b1);
             Dec(b2);
           end;
          if b4<>0 then
           repeat
             if b1<>0
              then
               begin
                 b4:=(Ord(ast1[b1])-Ord('0'))+b4;
                 b:=b4 mod 10;
                 ast1[b1]:=Char(b+Ord('0'));
                 b4:=b4 div 10;
                 Dec(b1);
               end
              else
               begin
                 ast1:=' '+ast1;
                 ast1[1]:=Char(b4+Ord('0'));
                 b4:=0;
               end;
           until b4=0;
      Summa:=ast1;
end;
function Proizved(as1,as2:string):string;
var  n,n1,n2,n3,n4,n5,i,j:integer;
     st1,st2:string;
begin
      n1:=Length(as1);
      n2:=Length(as2);
      n4:=0; st1:='';
      for i:=1 to n2 do
       begin
         st1:=st1+'0';
         n:=Ord(as2[i])-Ord('0');
         st2:='';
         for j:=n1 downto 1 do
          begin
            n3:=((Ord(as1[j])-Ord('0'))*n)+n4;
            n5:=n3 mod 10;
            st2:=Char(n5+Ord('0'))+st2;
            n4:=n3 div 10;
          end;
         if n4<>0 then
          begin
            st2:=Char(n4+Ord('0'))+st2;
            n4:=0;
          end;
         if Length(st1)>=Length(st2)
          then st1:=Summa(st1,st2)
          else st1:=Summa(st2,st1);
       end;
      Proizved:=st1;
end;
var  a,x,x1,x2,y:byte;
     s1,s2,f:string;
begin
      Write('a = '); Readln(a);
       Writeln;
        f:='0';
        for y:=1 to a do
         begin
           s1:='1';
           for x:=1 to y do
            begin
              s2:='';
              x1:=x;
              While x1<>0 do
               begin
                 x2:=x1 mod 10;
                 s2:=Char(x2+Ord('0'))+s2;
                 x1:=x1 div 10;
               end;
              s1:=Proizved(s1,s2);
            end;
           if Length(s1)>Length(f)
            then f:=Summa(s1,f)
            else f:=Summa(f,s1);
         end;
      Writeln('Summa factorialov ot 1 do ',a,' = '+f);
     Readln;
end.
Евгений вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070