素因数分解のソースコード

unit soinsuu2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Printers, Math;

type
  Tfrm_soinsuu2 = class(TForm)
    Edit1: TEdit;
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Memo2: TMemo;
    Memo3: TMemo;
    Memo4: TMemo;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  frm_soinsuu2: Tfrm_soinsuu2;
  BLN:boolean;

implementation

{$R *.dfm}

procedure HEIHOUKON(AA:array of byte; var D:array of byte);
//平方根の整数部分を返すサブプロシージャ   AA の平方根は D
var A,B,C:array of byte;
var BB,CC,DD,L,Q,Z:byte;
var J,K,M,S:integer;

begin
   S:=high(AA);
   setlength(A,S+2);
   setlength(B,floor((S+1)/2+2));
   setlength(C,floor((S+1)/2+2));

   if S mod 2=0 then
      for J:=1 to S do A[J]:=AA[J];
   
   if S mod 2=1 then
   begin
      A[1]:=0;
      for J:=2 to S+1 do A[J]:=AA[J-1];
   end;

   for J:=1 to floor((S+1)/2) do
   begin
      Z:=0;
      for L:=1 to 9 do
      begin
         CC:=L*L;
         C[J+1]:=CC mod 10;
         Q:=CC div 10;
         for K:=J downto 1 do
         begin
            CC:=B[K]*L+Q;
            C[K]:=CC mod 10;
            Q:=CC div 10;
         end;

         C[0]:=Q;

         for K:=J-1 to 2*J do
         begin
            if C[K-J+1]>A[K] then
            begin
               Z:=1;
               break;
            end;

            if C[K-J+1]<A[K] then
            begin
               Z:=2;
               break;
            end;
         end;

         if Z=1 then
         begin
            D[J]:=L-1;
            B[J+1]:=L-1;
            break;
         end
         else if (Z=2) and (L=9) then
         begin
            D[J]:=L;
            B[J+1]:=L;
            break;
         end
         else if Z=0 then
         begin
            D[J]:=L;
            B[J+1]:=L;
            for M:=J-1 to 2*J do A[M]:=0;
            break;
         end;
      end;

      if (Z=1) or (Z=2) then
      begin
         Q:=0;
         for K:=J+1 downto 1 do
         begin
            CC:=B[K]*B[J+1]+Q;
            C[K]:=CC mod 10;
            Q:=CC div 10;
         end;

         C[0]:=Q;
         Q:=1;
         for K:=2*J downto J-1 do
         begin
            DD:=10+A[K]-1+Q-C[K-J+1];
            A[K]:=DD mod 10;
            Q:=DD div 10;
         end;

         BB:=B[J+1]+B[J+1];
         B[J+1]:=BB mod 10;
         Q:=BB div 10;
         B[J]:=B[J]+Q;
      end
      else if Z=0 then
      begin
         BB:=B[J+1]+B[J+1];
         B[J+1]:=BB mod 10;
         Q:=BB div 10;
         B[J]:=B[J]+Q;
      end;
   end;

end;

procedure SYOU_AMARI(A,B:array of byte; var X,Y:array of byte);
//割り算（整数÷整数）の整商と余りを求めるサブプロシージャ   A÷B＝X　余り Y
//BB>AA のときは，このサブプロシージャでは処理できない
var E:array[0..100] of byte;
var AA,BB,D,P,Q,V,Z:byte;
var J,N,S:integer;

begin
   AA:=high(A);
   BB:=high(B);
   E[0]:=0;

   for N:=1 to BB do X[N]:=0;
   for N:=1 to BB do E[N]:=A[N];
   S:=0;

   repeat
      P:= 0;
      repeat
         Z:= 0;
         if E[0]<>0 then
         begin
            Q:= 1;
            for N:=BB downto 0 do
            begin
               D:= 10+E[N]-1+Q-B[N];
               E[N]:= D mod 10;
               Q:= D div 10;
            end;

            P:= P+1;
         end
         else
         begin
            V:= 0;
            for N:=1 to BB do
            begin
               if B[N]<E[N] then
               begin
                  V:= 1;
                  Q:= 1;
                  for J:=BB downto 1 do
                  begin
                     D:= 10+E[J]-1+Q-B[J];
                     E[J]:= D mod 10;
                     Q:= D div 10;
                  end;

                  P:= P+1;
                  break;
               end
               else if B[N]>E[N] then
               begin
                  V:= 1;
                  S:= S+1;
                  X[BB-1+S]:= P;
                  if BB-1+S= AA then
                  begin
                     for J:=1 to BB do Y[J]:=E[J];
                     Z:= 2;
                     break;
                  end;

                  for J:=0 to BB-1 do E[J]:= E[J+1];
                  E[BB]:= A[BB+S];
                  Z:= 1;
                  break;
               end;
            end;

            if V=0 then
            begin
               P:= P+1;
               for N:=1 to BB do E[N]:= 0;
            end;
         end;
         if (Z=1) or (Z=2) then break;
      until S=-1;
      if Z=2 then break;
   until S=-1;

end;

procedure TASU(A,B:array of byte; var X:array of byte; ketasuu:integer);
//足し算のサブプロシージャ   A+B=X
var C,N,Q:integer;
begin
   for N:=0 to ketasuu do
      X[N]:=0;

   Q:=0;
   for N:=ketasuu downto 0 do
   begin
      C:=A[N]+B[N]+Q;
      X[N]:=C mod 10;
      Q:=C div 10;
   end;
end;

procedure Tfrm_soinsuu2.FormShow(Sender: TObject);
begin
   Memo1.Clear;
   Memo2.Visible:=false;
   Memo3.Visible:=false;
   Memo4.Visible:=false;
   Edit1.SetFocus;
   Edit1.Clear;

end;

procedure Tfrm_soinsuu2.Button1Click(Sender: TObject);
var BB,NN,QQ,RR,S,V,X:array of byte;
var B,Q,QQQ,R,RRR:int64;
var BBB:extended;
var N:cardinal;
var T,W:integer;
var A,D,J,U,UU,Y,Z,ZZ,ZZZ:byte;
var CC,SS,SSS,SSSS,XX:string;
var file1:textfile;
label jmp1;

begin
   if BLN=true then
      BLN:=false
   else
   begin
      BLN:=true;
      Memo1.Clear;
      application.ProcessMessages;

      if Edit1.text='' then
      begin
         beep;
         showmessage('半角数字で 2以上 50桁以内の自然数を入力してください。');
         Edit1.SetFocus;
         BLN:=false;
         exit;
      end;

      CC:= Edit1.text;
      for J:=1 to length(CC) do
         if (ansicomparestr(copy(CC,J,1),'0')<0) or (ansicomparestr(copy(CC,J,1),'9')>0) then
         begin
            beep;
            showmessage('半角数字で 2以上 50桁以内の自然数を入力してください。');
            Edit1.SetFocus;
            BLN:=false;
            exit;
         end;

      if length(CC)>50 then
      begin
         beep;
         showmessage('入力文字数を50以下にしてください。');
         Edit1.SetFocus;
         BLN:=false;
         exit;
      end;

      for J:=1 to length(CC) do
      begin
         if copy(CC,J,1)<>'0' then break;
         if J=length(CC) then
         begin
            beep;
            showmessage('半角数字で 2以上 50桁以内の自然数を入力してください。');
            Edit1.SetFocus;
            BLN:=false;
            exit;
         end;
      end;

      for J:= 1 to length(Edit1.text) do
         if copy(Edit1.text,J,1)<>'0' then
         begin
            CC:= copy(Edit1.text,J,length(Edit1.text)-J+1);
            break;
         end;

      if CC='1' then
      begin
         beep;
         showmessage('半角数字で 2以上 50桁以内の自然数を入力してください。');
         Edit1.SetFocus;
         BLN:=false;
         exit;
      end;

      Memo2.Visible:=true;
      Button1.Caption:='計算中止';
      Button2.Visible:=false;

      Memo1.text:=' ';
      XX:= ' ';

      Y:=0;
      if length(CC)>=20 then Y:=1;
      if length(CC)<=18 then Y:=0;
      if length(CC)=19 then
      begin
         SS:='9223372000000000000';
         Y:=0;
         for J:=1 to 19 do
         begin
            if strtoint(copy(CC,J,1))>strtoint(copy(SS,J,1)) then
            begin
               Y:=1;
               break;
            end;

            if strtoint(copy(CC,J,1))<strtoint(copy(SS,J,1)) then
            begin
               Y:=0;
               break;
            end;
         end;
      end;

      if Y=0 then
      begin
         B:=strtoint64(CC);
         BBB:=B;
         ZZZ:=0;

         if 2>sqrt(BBB) then
         begin
            XX:=' '+CC+' は素数です。';
            Memo1.Text:=XX;
            ZZZ:=1;
         end
         else
         begin
            Q:=B div 2;
            R:=B-2*Q;

            while R=0 do
            begin
               if Q=1 then
               begin
                  XX:=XX+inttostr(2);
                  Memo1.Text:=Memo1.Text+inttostr(2)+'    計算完了';
                  ZZZ:=1;
                  break;
               end;

               XX:=XX+inttostr(2)+'×';
               Memo1.Text:=Memo1.Text+inttostr(2)+'×';
               B:=Q;
               BBB:=B;
               Q:=B div 2;
               R:=B-2*Q;
            end;
         end;

         if ZZZ=1 then goto jmp1;

         N:=3;
         Memo3.Visible:=true;
         Memo3.Lines.Strings[0]:=inttostr(N);
         Memo4.Visible:=true;
         Memo4.Lines.Strings[0]:=inttostr(floor(sqrt(BBB)));

         while BLN=true do
         begin
            if (XX= ' ') and (N>sqrt(BBB)) then
            begin
               XX:=' '+CC+' は素数です。';
               Memo1.Text:=XX;
               break;
            end;

            if (XX<> ' ') and (N>sqrt(BBB)) then
            begin
               XX:=XX+inttostr(B);
               Memo1.Text:=Memo1.Text+inttostr(B)+'    計算完了';
               break;
            end;

            Q:=B div N;
            R:=B-N*Q;

            while R=0 do
            begin
               if Q=1 then
               begin
                  XX:=XX+inttostr(N);
                  Memo1.Text:=Memo1.Text+inttostr(N)+'    計算完了';
                  ZZZ:=1;
                  break;
               end;

               XX:=XX+inttostr(N)+'×';
               Memo1.Text:=Memo1.Text+inttostr(N)+'×';
               B:=Q;
               BBB:=B;
               Q:=B div N;
               R:=B-N*Q;
               Memo4.Lines.Strings[0]:=inttostr(floor(sqrt(BBB)));

               while (R<>0) and (BLN=true) do
               begin
                  N:=N+2;
                  QQQ:=N div 100000;
                  RRR:=N-100000*QQQ;
                  if RRR=1 then Memo3.Lines.Strings[0]:=inttostr(N);
                  if N>sqrt(BBB) then
                  begin
                     XX:=XX+inttostr(B);
                     Memo1.Text:=Memo1.Text+inttostr(B)+'    計算完了';
                     ZZZ:=1;
                     break;
                  end;

                  Q:=B div N;
                  R:=B-N*Q;
                  application.ProcessMessages;
               end;

               if ZZZ=1 then break;
            end;
            if ZZZ=1 then break;
            N:=N+2;
            QQQ:=N div 100000;
            RRR:=N-100000*QQQ;
            if RRR=1 then Memo3.Lines.Strings[0]:=inttostr(N);
            application.ProcessMessages;
         end;
      end;

      if Y=1 then
      begin
         setlength(BB,length(CC)+1);
         for J:=1 to length(CC) do BB[J]:=strtoint(copy(CC,J,1));
         W:=1;
         ZZZ:=0;
         setlength(NN,2);
         NN[1]:=2;

         setlength(QQ,high(BB)+1);
         setlength(RR,high(NN)+1);

         SYOU_AMARI(BB,NN,QQ,RR);

         Z:=0;
         A:=high(RR);
         for J:=1 to A do
         begin
            if RR[J]<>0 then
            begin
               Z:=1;
               break;
            end;
         end;

         while Z=0 do
         begin
            W:=high(NN);
            SS:='';
            for J:=1 to W do SS:=SS+inttostr(NN[J]);

            ZZ:=0;
            D:=high(QQ);
            for J:=1 to D-1 do
            begin
               if QQ[J]<>0 then
               begin
                  ZZ:=1;
                  break;
               end;
            end;

            if (ZZ=0) and (QQ[D]=1) then
            begin
               XX:= XX+SS;
               Memo1.text:= Memo1.text+SS+'    計算完了';
               ZZZ:=1;
               break;
            end;

            XX:= XX+SS+'×';
            Memo1.text:=Memo1.text+SS+'×';

            U:=0;
            D:=high(QQ);
            for J:=1 to D do
            begin
               if QQ[J]<>0 then
               begin
                  U:=J;
                  break;
               end;
            end;

            setlength(BB,D-U+2);
            for J:=1 to D-U+1 do BB[J]:=QQ[U+J-1];

            setlength(QQ,high(BB)+1);
            setlength(RR,high(NN)+1);

            SYOU_AMARI(BB,NN,QQ,RR);

            Z:=0;
            A:=high(RR);

            for J:=1 to A do
            begin
               if RR[J]<>0 then
               begin
                  Z:=1;
                  break;
               end;
            end;
         end;

         if ZZZ=1 then goto jmp1;

         NN[1]:=3;

         Memo3.Visible:=true;
         Memo3.Lines.Strings[0]:=inttostr(3);

         T:=floor((length(CC)+1)/2);
         setlength(X,T+1);
         HEIHOUKON(BB,X);

         SSSS:='';
         for J:=1 to high(X) do SSSS:=SSSS+inttostr(X[J]);
         Memo4.Visible:=true;
         Memo4.Lines.Strings[0]:=SSSS;

         while BLN=true do
         begin
            if (XX= ' ') and (W>T) then
            begin
               XX:= ' '+CC+' は素数です。';
               Memo1.text:= XX;
               break;
            end;

            if (XX= ' ') and (W=T) then
            begin
               ZZ:=0;
               for J:=1 to W do
               begin
                  if NN[J]>X[J] then
                  begin
                     ZZ:=1;
                     break;
                  end;

                  if NN[J]<X[J] then
                  begin
                     ZZ:=0;
                     break;
                  end;
               end;

               if ZZ=1 then
               begin
                  XX:= ' '+CC+' は素数です。';
                  Memo1.text:= XX;
                  break;
               end;
            end;

            if (XX<> ' ') and (W>T) then
            begin
               SS:='';
               for J:=1 to high(BB) do SS:=SS+inttostr(BB[J]);
               XX:= XX+SS;
               Memo1.text:= Memo1.text+SS+'    計算完了';
               break;
            end;

            if (XX<> ' ') and (W=T) then
            begin
               ZZ:=0;
               for J:=1 to W do
               begin
                  if NN[J]>X[J] then
                  begin
                     ZZ:=1;
                     break;
                  end;

                  if NN[J]<X[J] then
                  begin
                     ZZ:=0;
                     break;
                  end;
               end;

               if ZZ=1 then
               begin
                  SS:='';
                  for J:=1 to high(BB) do SS:=SS+inttostr(BB[J]);
                  XX:= XX+SS;
                  Memo1.text:= Memo1.text+SS+'    計算完了';
                  break;
               end;
            end;

            setlength(QQ,high(BB)+1);
            setlength(RR,high(NN)+1);

            SYOU_AMARI(BB,NN,QQ,RR);

            Z:=0;
            A:=high(RR);
            for J:=1 to A do
            begin
               if RR[J]<>0 then
               begin
                  Z:=1;
                  break;
               end;
            end;

            while (Z=0) and (BLN=true) do
            begin
               W:=high(NN);
               SS:='';
               for J:=1 to W do SS:=SS+inttostr(NN[J]);

               ZZ:=0;
               D:=high(QQ);
               for J:=1 to D-1 do
               begin
                  if QQ[J]<>0 then
                  begin
                     ZZ:=1;
                     break;
                  end;
               end;

               if (ZZ=0) and (QQ[D]=1) then
               begin
                  XX:= XX+SS;
                  Memo1.text:= Memo1.text+SS+'    計算完了';
                  ZZZ:=1;
                  break;
               end;

               XX:= XX+SS+'×';
               Memo1.text:=Memo1.text+SS+'×';

               U:=0;
               D:=high(QQ);
               for J:=1 to D do
               begin
                  if QQ[J]<>0 then
                  begin
                     U:=J;
                     break;
                  end;
               end;

               setlength(BB,D-U+2);
               for J:=1 to D-U+1 do BB[J]:=QQ[U+J-1];

               T:=floor((high(BB)+1)/2);
               setlength(X,T+1);
               HEIHOUKON(BB,X);

               SSSS:='';
               for J:=1 to high(X) do SSSS:=SSSS+inttostr(X[J]);
               Memo4.Lines.Strings[0]:=SSSS;

               setlength(QQ,high(BB)+1);
               setlength(RR,high(NN)+1);

               SYOU_AMARI(BB,NN,QQ,RR);

               Z:=0;
               A:=high(RR);
               for J:=1 to A do
               begin
                  if RR[J]<>0 then
                  begin
                     Z:=1;
                     break;
                  end;
               end;

               while (Z=1) and (BLN=true) do
               begin
                  W:=high(NN);
                  setlength(V,W+1);
                  setlength(S,W+1);
                  for J:=1 to W-1 do V[J]:=0;
                  V[W]:=2;

                  TASU(NN,V,S,W);

                  if S[0]<>0 then
                  begin
                     setlength(NN,W+2);
                     for J:=1 to W+1 do NN[J]:=S[J-1];
                  end
                  else
                  begin
                     for J:=1 to W do NN[J]:=S[J];
                  end;

                  W:=high(NN);
                  if W>4 then
                  begin
                     ZZ:=0;
                     for J:=W-3 to W do
                     begin
                        if NN[J]<>9 then
                        begin
                           ZZ:=1;
                           break;
                        end;
                     end;

                     if ZZ=0 then
                     begin
                        SSS:='';
                        for J:=1 to W do SSS:=SSS+inttostr(NN[J]);
                        Memo3.Lines.Strings[0]:=SSS;
                     end;
                  end;

                  if W>T then
                  begin
                     SS:='';
                     for J:=1 to high(BB) do SS:=SS+inttostr(BB[J]);
                     XX:= XX+SS;
                     Memo1.text:= Memo1.text+SS+'    計算完了';
                     ZZZ:=1;
                     break;
                  end;

                  if W=T then
                  begin
                     ZZ:=0;

                     for J:=1 to W do
                     begin
                        if NN[J]>X[J] then
                        begin
                           ZZ:=1;
                           break;
                        end;

                        if NN[J]<X[J] then
                        begin
                           ZZ:=0;
                           break;
                        end;
                     end;

                     if ZZ=1 then
                     begin
                        SS:='';
                        for J:=1 to high(BB) do SS:=SS+inttostr(BB[J]);
                        XX:= XX+SS;
                        Memo1.text:= Memo1.text+SS+'    計算完了';
                        ZZZ:=1;
                        break;
                     end;
                  end;

                  setlength(QQ,high(BB)+1);
                  setlength(RR,high(NN)+1);

                  SYOU_AMARI(BB,NN,QQ,RR);

                  Z:=0;
                  A:=high(RR);
                  for J:=1 to A do
                  begin
                     if RR[J]<>0 then
                     begin
                        Z:=1;
                        break;
                     end;
                  end;

                  application.ProcessMessages;
               end;

               if ZZZ=1 then break;
               application.ProcessMessages;
            end;

            if ZZZ=1 then break;
            W:=high(NN);
            setlength(V,W+1);
            setlength(S,W+1);
            for J:=1 to W-1 do V[J]:=0;
            V[W]:=2;

            TASU(NN,V,S,W);

            if S[0]<>0 then
            begin
               setlength(NN,W+2);
               for J:=1 to W+1 do NN[J]:=S[J-1];
            end
            else
            begin
               for J:=1 to W do NN[J]:=S[J];
            end;

            W:=high(NN);
            if W>4 then
            begin
               ZZ:=0;
               for J:=W-3 to W do
               begin
                  if NN[J]<>9 then
                  begin
                     ZZ:=1;
                     break;
                  end;
               end;

               if ZZ=0 then
               begin
                  SSS:='';
                  for J:=1 to W do SSS:=SSS+inttostr(NN[J]);
                  Memo3.Lines.Strings[0]:=SSS;
               end;
            end;

            application.ProcessMessages;
         end;
      end;
jmp1:

      if BLN=false then
      begin
         Button1.Caption:='計算開始';
         Button2.Visible:=true;
         Memo2.Visible:=false;
         exit;
      end;

      Button1.Caption:='計算開始';
      Button2.Visible:=true;
      Memo2.Visible:=false;
      BLN:=false;

      beep;
      if MessageDlg('計算完了。　計算結果を保存または印刷しますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
      begin
         try
            if DirectoryExists('C:\Temp')=False then MkDir('C:\Temp');
            AssignFile(file1,'C:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,' '+Edit1.text+' の素因数分解結果');
            WriteLn(file1,XX);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が C:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('C:\windows\notepad.exe C:\Temp\Temp.txt',SW_SHOW);
            end;
         except
            if DirectoryExists('A:\Temp')=False then MkDir('A:\Temp');
            AssignFile(file1,'A:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,' '+Edit1.text+' の素因数分解結果');
            WriteLn(file1,XX);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が A:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('A:\windows\notepad.exe A:\Temp\Temp.txt',SW_SHOW);
            end;
         end;
      end;
      Edit1.SetFocus;
   end;
end;

procedure Tfrm_soinsuu2.Button2Click(Sender: TObject);
begin
   frm_soinsuu2.Close;

end;

procedure Tfrm_soinsuu2.Edit1Change(Sender: TObject);
begin
   Memo1.Clear;
   Memo3.Visible:=false;
   Memo4.Visible:=false;

end;

procedure Tfrm_soinsuu2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   if BLN=true then BLN:=false;

end;

end.

*****************************************************************************************

円周率を求めるソースコード

unit ensyuuritu;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Printers;

type
  Tfrm_ensyuuritu = class(TForm)
    Edit1: TEdit;
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    Memo2: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  frm_ensyuuritu: Tfrm_ensyuuritu;
  BLN:boolean;

implementation

{$R *.dfm}

procedure TASU(A,B:array of byte; var X:array of byte; ketasuu:integer);
//足し算のサブプロシージャ   A+B=X
var C,N,Q:integer;
begin
   for N:=0 to ketasuu do
      X[N]:=0;

   Q:=0;
   for N:=ketasuu downto 0 do
   begin
      C:=A[N]+B[N]+Q;
      X[N]:=C mod 10;
      Q:=C div 10;
   end;
end;

procedure HIKU(A,B:array of byte; var X:array of byte; ketasuu:integer);
//引き算のサブプロシージャ   A-B=X
var C,N,Q:integer;
begin
   for N:=0 to ketasuu do
      X[N]:=0;

   Q:=1;
   for N:=ketasuu downto 1 do
   begin
      C:=10+A[N]-1+Q-B[N];
      X[N]:=C mod 10;
      Q:=C div 10;
   end;
end;

procedure WARU(A:array of byte; B:integer; var X:array of byte; ketasuu:integer);
//割り算のサブプロシージャ   A/B=X
var D,K,N,RR:integer;
var C:string;

begin
   K:=length(inttostr(B));
   C:='';
   for N:=1 to K do
      C:=C+inttostr(A[N]);

   D:=strtoint(C);

   for N:=0 to ketasuu do
      X[N]:=0;
      
   for N:=0 to ketasuu-1-k do
   begin
      X[K+N]:=D div B;
      RR:=D-B*X[K+N];
      D:=RR*10+A[K+1+N];
   end;
end;


procedure Tfrm_ensyuuritu.FormShow(Sender: TObject);
begin
   Memo1.Clear;
   Memo2.Visible:=false;
   Edit1.SetFocus;
   Edit1.Clear;

end;

procedure Tfrm_ensyuuritu.Button1Click(Sender: TObject);
var C,D,E,G,H,P,Q,S,V,X,Y:array of byte;
var ketakazu,F,N,M,R:integer;
var U:byte;
var CC,XX:string;
var file1:textfile;

begin
   if BLN=true then
      BLN:=false
   else
   begin
      BLN:=true;
      Memo1.Clear;
      application.ProcessMessages;

      if Edit1.text='' then
      begin
         beep;
         showmessage('半角数字で 2以上 60000以下の自然数を入力してください。');
         Edit1.SetFocus;
         BLN:=false;
         exit;
      end;

      CC:= Edit1.text;
      for N:=1 to length(CC) do
         if (ansicomparestr(copy(CC,N,1),'0')<0) or (ansicomparestr(copy(CC,N,1),'9')>0) then
         begin
            beep;
            showmessage('半角数字で 2以上 60000以下の自然数を入力してください。');
            Edit1.SetFocus;
            BLN:=false;
            exit;
         end;

      if length(CC)>5 then
      begin
         beep;
         showmessage('入力文字数を5以下にしてください。');
         Edit1.SetFocus;
         BLN:=false;
         exit;
      end;

      if (strtoint(CC)>60000) or (strtoint(CC)<2) then
      begin
         beep;
         showmessage('半角数字で 2以上 60000以下の自然数を入力してください。');
         Edit1.SetFocus;
         BLN:=false;
         exit;
      end;

      Memo1.text:='';
      Memo2.Visible:=true;
      Button1.Caption:='計算中止';
      Button2.Visible:=false;

      ketakazu:= strtoint(Edit1.text);
      setlength(C,ketakazu+6);
      setlength(D,ketakazu+6);
      setlength(E,ketakazu+6);
      setlength(G,ketakazu+6);
      setlength(H,ketakazu+6);
      setlength(P,ketakazu+6);
      setlength(Q,ketakazu+6);
      setlength(S,ketakazu+6);
      setlength(V,ketakazu+6);
      setlength(X,ketakazu+6);
      setlength(Y,ketakazu+6);

      for N:=1 to ketakazu+5 do
      begin
         C[N]:=0; D[N]:=0; E[N]:=0; G[N]:=0; H[N]:=0; P[N]:=0; Q[N]:=0; S[N]:=0; V[N]:=0; X[N]:=0; Y[N]:=0;
      end;

      G[1]:=3; G[2]:=2;
      P[1]:=3; P[2]:=2;
      E[1]:=4;
      F:=239;
      WARU(E,F,V,ketakazu+5);

      for N:=1 to ketakazu+5 do
      begin
         H[N]:=V[N];
         Q[N]:=V[N];
      end;

      HIKU(G,H,Y,ketakazu+5);
      for N:=1 to ketakazu+5 do
         S[N]:=Y[N];

      M:=2;

      while BLN=true do
      begin
         Memo2.Lines.Strings[0]:=inttostr(M);
         for N:=1 to ketakazu+5 do
            E[N]:=P[N];

         F:=25;
         WARU(E,F,V,ketakazu+5);
         U:=0;
         for N:=1 to ketakazu+5 do
            if V[N]<>0 then
            begin
               U:=1;
               break;
            end;

         if U=0 then break;
         for N:=1 to ketakazu+5 do
         begin
            G[N]:=V[N];
            P[N]:=V[N];
         end;

         for N:=1 to ketakazu+5 do
            E[N]:=Q[N];

         F:=57121;
         WARU(E,F,V,ketakazu+5);
         for N:=1 to ketakazu+5 do
         begin
            H[N]:=V[N];
            Q[N]:=V[N];
         end;

         HIKU(G,H,Y,ketakazu+5);
         for N:=1 to ketakazu+5 do
            E[N]:=Y[N];


         F:=2*M-1;
         WARU(E,F,V,ketakazu+5);
         R:=M mod 2;
         if R=0 then
         begin
            for N:=1 to ketakazu+5 do
               G[N]:=S[N];

            for N:=1 to ketakazu+5 do
               H[N]:=V[N];

            HIKU(G,H,Y,ketakazu+5);
            for N:=1 to ketakazu+5 do
               S[N]:=Y[N];
         end
         else
         begin
            for N:=1 to ketakazu+5 do
               C[N]:=S[N];

            for N:=1 to ketakazu+5 do
               D[N]:=V[N];

            TASU(C,D,X,ketakazu+5);
            for N:=1 to ketakazu+5 do
               S[N]:=X[N];
         end;
         M:=M+1;
         application.ProcessMessages;
      end;

      if BLN=false then
      begin
         Button1.Caption:='計算開始';
         Button2.Visible:=true;
         exit;
      end;

      XX:='';
      for N:=1 to ketakazu do
         XX:=XX+inttostr(S[N]);

      Memo1.text:=XX;

      Button1.Caption:='計算開始';
      Button2.Visible:=true;
      BLN:=false;

      beep;
      if MessageDlg('計算完了。　計算結果を保存または印刷しますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
      begin
         try
            if DirectoryExists('C:\Temp')=False then MkDir('C:\Temp');
            AssignFile(file1,'C:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,'円周率'+Edit1.text+'桁');
            WriteLn(file1,XX);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が C:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('C:\windows\notepad.exe C:\Temp\Temp.txt',SW_SHOW);
            end;
         except
            if DirectoryExists('A:\Temp')=False then MkDir('A:\Temp');
            AssignFile(file1,'A:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,'円周率'+Edit1.text+'桁');
            WriteLn(file1,XX);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が A:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('A:\windows\notepad.exe A:\Temp\Temp.txt',SW_SHOW);
            end;
         end;
      end;
      Edit1.SetFocus;
   end;
end;

procedure Tfrm_ensyuuritu.Button2Click(Sender: TObject);
begin
   frm_ensyuuritu.Close;

end;

procedure Tfrm_ensyuuritu.Edit1Change(Sender: TObject);
begin
   Memo1.Clear;
   Memo2.Visible:=false;

end;

procedure Tfrm_ensyuuritu.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   if BLN=true then BLN:=false;

end;

end.

*****************************************************************************************

自然対数の底を求めるソースコード

unit sizentaisuunotei;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Printers;

type
  Tfrm_sizentaisuunotei = class(TForm)
    Edit1: TEdit;
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    Memo2: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  frm_sizentaisuunotei: Tfrm_sizentaisuunotei;
  BLN:boolean;

implementation

{$R *.dfm}

procedure TASU(A,B:array of byte; var X:array of byte; ketasuu:integer);
//足し算のサブプロシージャ   A+B=X
var C,N,Q:integer;
begin
   for N:=0 to ketasuu do
      X[N]:=0;

   Q:=0;
   for N:=ketasuu downto 0 do
   begin
      C:=A[N]+B[N]+Q;
      X[N]:=C mod 10;
      Q:=C div 10;
   end;
end;

procedure HIKU(A,B:array of byte; var X:array of byte; ketasuu:integer);
//引き算のサブプロシージャ   A-B=X
var C,N,Q:integer;
begin
   for N:=0 to ketasuu do
      X[N]:=0;

   Q:=1;
   for N:=ketasuu downto 1 do
   begin
      C:=10+A[N]-1+Q-B[N];
      X[N]:=C mod 10;
      Q:=C div 10;
   end;
end;

procedure WARU(A:array of byte; B:integer; var X:array of byte; ketasuu:integer);
//割り算のサブプロシージャ   A/B=X
var D,K,N,RR:integer;
var C:string;

begin
   K:=length(inttostr(B));
   C:='';
   for N:=1 to K do
      C:=C+inttostr(A[N]);

   D:=strtoint(C);

   for N:=0 to ketasuu do
      X[N]:=0;
      
   for N:=0 to ketasuu-1-k do
   begin
      X[K+N]:=D div B;
      RR:=D-B*X[K+N];
      D:=RR*10+A[K+1+N];
   end;
end;


procedure Tfrm_sizentaisuunotei.FormShow(Sender: TObject);
begin
   Memo1.Clear;
   Memo2.Visible:=false;
   Edit1.SetFocus;
   Edit1.Clear;

end;

procedure Tfrm_sizentaisuunotei.Button1Click(Sender: TObject);
var C,D,E,S,V,X:array of byte;
var ketakazu,N,M:integer;
var U:byte;
var CC,XX:string;
var file1:textfile;

begin
   if BLN=true then
      BLN:=false
   else
   begin
      BLN:=true;
      Memo1.Clear;
      application.ProcessMessages;

      if Edit1.text='' then
      begin
         beep;
         showmessage('半角数字で 2以上 60000以下の自然数を入力してください。');
         Edit1.SetFocus;
         BLN:=false;
         exit;
      end;

      CC:= Edit1.text;
      for N:=1 to length(CC) do
         if (ansicomparestr(copy(CC,N,1),'0')<0) or (ansicomparestr(copy(CC,N,1),'9')>0) then
         begin
            beep;
            showmessage('半角数字で 2以上 60000以下の自然数を入力してください。');
            Edit1.SetFocus;
            BLN:=false;
            exit;
         end;

      if length(CC)>5 then
      begin
         beep;
         showmessage('入力文字数を5以下にしてください。');
         Edit1.SetFocus;
         BLN:=false;
         exit;
      end;

      if (strtoint(CC)>60000) or (strtoint(CC)<2) then
      begin
         beep;
         showmessage('半角数字で 2以上 60000以下の自然数を入力してください。');
         Edit1.SetFocus;
         BLN:=false;
         exit;
      end;

      Memo1.text:='';
      Memo2.Visible:=true;
      Button1.Caption:='計算中止';
      Button2.Visible:=false;

      ketakazu:= strtoint(Edit1.text);
      setlength(C,ketakazu+9);
      setlength(D,ketakazu+9);
      setlength(E,ketakazu+9);
      setlength(S,ketakazu+9);
      setlength(V,ketakazu+9);
      setlength(X,ketakazu+9);

      for N:=1 to ketakazu+8 do
      begin
         C[N]:=0; D[N]:=0; E[N]:=0; S[N]:=0; V[N]:=0; X[N]:=0;
      end;

      S[1]:=2; S[2]:=5;
      E[1]:=0; E[2]:=5;

      M:=3;

      while BLN=true do
      begin
         Memo2.Lines.Strings[0]:= inttostr(M);

         WARU(E,M,V,ketakazu+8);
         U:=0;
         for N:=1 to ketakazu+8 do
            if V[N]<>0 then
            begin
               U:=1;
               break;
            end;

         if U=0 then break;
         for N:=1 to ketakazu+8 do
         begin
            C[N]:=S[N];
            D[N]:=V[N];
            E[N]:=V[N];
         end;

         TASU(C,D,X,ketakazu+8);
         for N:=1 to ketakazu+8 do S[N]:=X[N];
         M:= M+1;
         application.ProcessMessages;
      end;

      if BLN=false then
      begin
         Button1.Caption:='計算開始';
         Button2.Visible:=true;
         exit;
      end;

      XX:='';
      for N:=1 to ketakazu do
         XX:=XX+inttostr(S[N]);

      Memo1.text:=XX;

      Button1.Caption:='計算開始';
      Button2.Visible:=true;
      BLN:=false;

      beep;
      if MessageDlg('計算完了。　計算結果を保存または印刷しますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
      begin
         try
            if DirectoryExists('C:\Temp')=False then MkDir('C:\Temp');
            AssignFile(file1,'C:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,'自然対数の底'+Edit1.text+'桁');
            WriteLn(file1,XX);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が C:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('C:\windows\notepad.exe C:\Temp\Temp.txt',SW_SHOW);
            end;
         except
            if DirectoryExists('A:\Temp')=False then MkDir('A:\Temp');
            AssignFile(file1,'A:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,'自然対数の底'+Edit1.text+'桁');
            WriteLn(file1,XX);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が A:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('A:\windows\notepad.exe A:\Temp\Temp.txt',SW_SHOW);
            end;
         end;
      end;
      Edit1.SetFocus;
   end;
end;

procedure Tfrm_sizentaisuunotei.Button2Click(Sender: TObject);
begin
   frm_sizentaisuunotei.Close;
   
end;

procedure Tfrm_sizentaisuunotei.Edit1Change(Sender: TObject);
begin
   Memo1.Clear;
   Memo2.Visible:=false;

end;

procedure Tfrm_sizentaisuunotei.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   if BLN=true then BLN:=false;

end;

end.

*****************************************************************************************

平方根を10000桁まで求めるソースコード

unit heihoukon2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Math, StrUtils;

type
  Tfrm_heihoukon2 = class(TForm)
    Button1: TButton;
    Memo2: TMemo;
    Label1: TLabel;
    Button3: TButton;
    Label2: TLabel;
    Label3: TLabel;
    Memo1: TMemo;
    Memo3: TMemo;
    Memo4: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Memo3Change(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  frm_heihoukon2: Tfrm_heihoukon2;

implementation

{$R *.dfm}

procedure Tfrm_heihoukon2.Button1Click(Sender: TObject);
var A,B,C,D:array of byte;
var BB,CC,DD,H,KK,L,MM,N,P,Q,R,U,V,W,Z:byte;
var J,K,ketasuu,M,S:integer;
var AA,X:string;
var file1:textfile;

begin
   Memo2.Clear;
   application.ProcessMessages;
   ketasuu:=10000;

   if rightstr(Memo3.Text,2)=#$D#$A then
   begin
      beep;
      showmessage('BackSpaceキーを押して、改行コードを取り除いてください。');
      Memo3.SetFocus;
      exit;
   end;


   H:= length(Memo3.text);
   KK:= ansipos('.',Memo3.text);

   if (H>200) and (KK=0) then
   begin
      beep;
      showmessage('入力文字数を200以下にしてください。');
      Memo3.SetFocus;
      exit;
   end;

   if (H>201) and (KK<>0) then
   begin
      beep;
      showmessage('小数点を含めた入力文字数を201以下にしてください。');
      Memo3.SetFocus;
      exit;
   end;

   if KK=0 then
      AA:= Memo3.text
   else
      AA:= copy(Memo3.text,1,KK-1)+copy(Memo3.text,KK+1,H-KK);

   for N:=1 to length(AA) do
      if (ansicomparestr(copy(AA,N,1),'0')<0) or (ansicomparestr(copy(AA,N,1),'9')>0) then
      begin
         beep;
         showmessage('半角数字で200桁以内の正の数を入力してください。');
         Memo3.SetFocus;
         exit;
      end;

   U:= 0;
   for N:=1 to length(AA) do
      if copy(AA,N,1)<>'0' then
      begin
         U:= 1;
         break;
      end;

   if U= 0 then
   begin
      beep;
      showmessage('半角数字で200桁以内の正の数を入力してください。');
      Memo3.SetFocus;
      exit;
   end;

   Memo4.Visible:=true;
   application.ProcessMessages;
   
   W:=0;
   if KK<>0 then W:=H-KK;
   if W mod 2=1 then AA:=AA+'0';
   N:=length(AA);
   setlength(A,ketasuu*2+2);
   setlength(B,ketasuu+2);
   setlength(C,ketasuu+2);
   setlength(D,ketasuu+1);
   A[0]:=0;

   if N mod 2=0 then
      for J:=1 to N do A[J]:=strtoint(copy(AA,J,1));

   if N mod 2=1 then
   begin
      A[1]:=0;
      for J:=2 to N+1 do A[J]:=strtoint(copy(AA,J-1,1));
   end;

   R:=1;
   S:=floor((N+1)/2);
   V:=0;

   repeat
      for J:=R to S do
      begin
         Z:=0;
         if J=ketasuu then V:=1;
         for L:=1 to 9 do
         begin
            CC:=L*L;
            C[J+1]:=CC mod 10;
            Q:=CC div 10;
            for K:=J downto 1 do
            begin
               CC:=B[K]*L+Q;
               C[K]:=CC mod 10;
               Q:=CC div 10;
            end;

            C[0]:=Q;
            for K:=J-1 to 2*J do
            begin
               if C[K-J+1]>A[K] then
               begin
                  Z:=1;
                  break;
               end;

               if C[K-J+1]<A[K] then
               begin
                  Z:=2;
                  break;
               end;
            end;

            if Z=1 then
            begin
               D[J]:=L-1;
               B[J+1]:=L-1;
               break;
            end
            else if (Z=2) and (L=9) then
            begin
               D[J]:=L;
               B[J+1]:=L;
               break;
            end
            else if Z=0 then
            begin
               D[J]:=L;
               B[J+1]:=L;
               for M:=J-1 to 2*J do A[M]:=0;
               break;
            end;
         end;

         if (Z=1) or (Z=2) then
         begin
            Q:=0;
            for K:=J+1 downto 1 do
            begin
               CC:=B[K]*B[J+1]+Q;
               C[K]:=CC mod 10;
               Q:=CC div 10;
            end;

            C[0]:=Q;
            Q:=1;
            for K:=2*J downto J-1 do
            begin
               DD:=10+A[K]-1+Q-C[K-J+1];
               A[K]:=DD mod 10;
               Q:=DD div 10;
            end;

            BB:=B[J+1]+B[J+1];
            B[J+1]:=BB mod 10;
            Q:=BB div 10;
            B[J]:=B[J]+Q;
         end
         else if Z=0 then
         begin
            BB:=B[J+1]+B[J+1];
            B[J+1]:=BB mod 10;
            Q:=BB div 10;
            B[J]:=B[J]+Q;
         end;
      end;

      if V=1 then
      begin
         if KK=0 then
            P:=floor(N/2+0.5)
         else
         begin
            MM:=length(copy(Memo3.text,1,KK-1));
            P:=floor(MM/2+0.5);
         end;

         for J:=1 to P do X:=X+inttostr(D[J]);
         X:=X+'.';
         for J:=P+1 to ketasuu do X:=X+inttostr(D[J]);
         break;
      end
      else
      begin
         U:=0;
         for K:=2*S downto S-1 do
            if A[K]<>0 then
            begin
               U:=1;
               break;
            end;

         if U=0 then
         begin
            if KK=0 then
               for J:=1 to S do X:=X+inttostr(D[J])
            else
            begin
               MM:=length(copy(Memo3.text,1,KK-1));
               P:=floor(MM/2+0.5);
               for J:=1 to P do X:=X+inttostr(D[J]);
               X:=X+'.';
               for J:=P+1 to S do X:=X+inttostr(D[J]);
            end;

            break;
         end
         else
         begin
            R:=S+1;
            S:=ketasuu;
         end;
      end;
   until S=-1;


   Memo4.Visible:=false;
   Memo2.Text:=X;

   beep;
   if MessageDlg('計算完了。　計算結果を保存または印刷しますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
   begin
         try
            if DirectoryExists('C:\Temp')=False then MkDir('C:\Temp');
            AssignFile(file1,'C:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,Memo3.text+'の平方根（10000桁）');
            WriteLn(file1,X);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が C:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('C:\windows\notepad.exe C:\Temp\Temp.txt',SW_SHOW);
            end;
         except
            if DirectoryExists('A:\Temp')=False then MkDir('A:\Temp');
            AssignFile(file1,'A:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,Memo3.text+'の平方根（10000桁）');
            WriteLn(file1,X);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が A:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('A:\windows\notepad.exe A:\Temp\Temp.txt',SW_SHOW);
            end;
         end;
   end;
   Memo3.SetFocus;
end;

procedure Tfrm_heihoukon2.FormShow(Sender: TObject);
begin
   Memo2.Clear;
   Memo3.SetFocus;
   Memo3.Clear;
   Memo1.Visible:=false;
   Memo4.Visible:=false;

end;

procedure Tfrm_heihoukon2.Button3Click(Sender: TObject);
begin
   frm_heihoukon2.Close;

end;

procedure Tfrm_heihoukon2.Memo3Change(Sender: TObject);
begin
   Memo2.Clear;
   Memo1.Visible:=true;
   Memo1.Text:='入力文字数＝'+inttostr(length(Memo3.Text));

   if rightstr(Memo3.Text,2)=#$D#$A then
   begin
      beep;
      showmessage('BackSpaceキーを押して、改行コードを取り除いてください。');
      exit;
   end;

end;

end.

*****************************************************************************************

平方根の整数部分を求めるソースコード

unit heihoukon1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Math, StrUtils;

type
  Tfrm_heihoukon1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    Label1: TLabel;
    Button2: TButton;
    Button3: TButton;
    Label2: TLabel;
    Label3: TLabel;
    Memo3: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Memo1Change(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  frm_heihoukon1: Tfrm_heihoukon1;

implementation

{$R *.dfm}

procedure HEIHOUKON(AA:array of byte; var D:array of byte);
//平方根の整数部分を返すサブプロシージャ   AA の平方根は D
var A,B,C:array of byte;
var BB,CC,DD,L,Q,Z:byte;
var J,K,M,S:integer;

begin
   S:=high(AA);
   setlength(A,S+2);
   setlength(B,floor((S+1)/2+2));
   setlength(C,floor((S+1)/2+2));

   if S mod 2=0 then
      for J:=1 to S do A[J]:=AA[J];
   
   if S mod 2=1 then
   begin
      A[1]:=0;
      for J:=2 to S+1 do A[J]:=AA[J-1];
   end;

   for J:=1 to floor((S+1)/2) do
   begin
      Z:=0;
      for L:=1 to 9 do
      begin
         CC:=L*L;
         C[J+1]:=CC mod 10;
         Q:=CC div 10;
         for K:=J downto 1 do
         begin
            CC:=B[K]*L+Q;
            C[K]:=CC mod 10;
            Q:=CC div 10;
         end;

         C[0]:=Q;

         for K:=J-1 to 2*J do
         begin
            if C[K-J+1]>A[K] then
            begin
               Z:=1;
               break;
            end;

            if C[K-J+1]<A[K] then
            begin
               Z:=2;
               break;
            end;
         end;

         if Z=1 then
         begin
            D[J]:=L-1;
            B[J+1]:=L-1;
            break;
         end
         else if (Z=2) and (L=9) then
         begin
            D[J]:=L;
            B[J+1]:=L;
            break;
         end
         else if Z=0 then
         begin
            D[J]:=L;
            B[J+1]:=L;
            for M:=J-1 to 2*J do A[M]:=0;
            break;
         end;
      end;

      if (Z=1) or (Z=2) then
      begin
         Q:=0;
         for K:=J+1 downto 1 do
         begin
            CC:=B[K]*B[J+1]+Q;
            C[K]:=CC mod 10;
            Q:=CC div 10;
         end;

         C[0]:=Q;
         Q:=1;
         for K:=2*J downto J-1 do
         begin
            DD:=10+A[K]-1+Q-C[K-J+1];
            A[K]:=DD mod 10;
            Q:=DD div 10;
         end;

         BB:=B[J+1]+B[J+1];
         B[J+1]:=BB mod 10;
         Q:=BB div 10;
         B[J]:=B[J]+Q;
      end
      else if Z=0 then
      begin
         BB:=B[J+1]+B[J+1];
         B[J+1]:=BB mod 10;
         Q:=BB div 10;
         B[J]:=B[J]+Q;
      end;
   end;

end;

procedure Tfrm_heihoukon1.Button1Click(Sender: TObject);
var A,D:array of byte;
var J,N,S:integer;
var B,X:string;
var file1:textfile;

begin
   Memo2.Clear;
   application.ProcessMessages;

   if Memo1.Text='' then
   begin
      beep;
      showmessage('半角数字で 10000桁以内の自然数を入力してください。');
      Memo1.SetFocus;
      exit;
   end;

   if rightstr(Memo1.Text,2)=#$D#$A then
   begin
      beep;
      showmessage('BackSpaceキーを押して、改行コードを取り除いてください。');
      Memo1.SetFocus;
      exit;
   end;

   if length(Memo1.Text)>10000 then
   begin
      beep;
      showmessage('入力文字数を10000以下にしてください。');
      Memo1.SetFocus;
      exit;
   end;

   for N:=1 to length(Memo1.Text) do
      if (ansicomparestr(copy(Memo1.Text,N,1),'0')<0) or (ansicomparestr(copy(Memo1.Text,N,1),'9')>0) then
      begin
         beep;
         showmessage('半角数字で 10000桁以内の自然数を入力してください。');
         Memo1.SetFocus;
         exit;
      end;

   for J:=1 to length(Memo1.Text) do
   begin
      if copy(Memo1.Text,J,1)<>'0' then break;
      if J=length(Memo1.Text) then
      begin
         beep;
         showmessage('半角数字で 10000桁以内の自然数を入力してください。');
         Memo1.SetFocus;
         exit;
      end;
   end;

   for N:=1 to length(Memo1.Text) do
      if copy(Memo1.Text,N,1)<>'0' then
      begin
         B:= copy(Memo1.Text,N,length(Memo1.Text)-N+1);
         break;
      end;

   S:=length(B);
   setlength(A,S+1);
   setlength(D,floor((S+3)/2));
   for J:=1 to S do A[J]:=strtoint(copy(B,J,1));
   HEIHOUKON(A,D);
   X:='';
   for J:=1 to floor((S+1)/2) do X:=X+inttostr(D[J]);
   Memo2.Text:=X;

   beep;
   if MessageDlg('計算完了。　計算結果を保存または印刷しますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
   begin
         try
            if DirectoryExists('C:\Temp')=False then MkDir('C:\Temp');
            AssignFile(file1,'C:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,Memo1.Text+'の平方根の整数部分');
            WriteLn(file1,X);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が C:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('C:\windows\notepad.exe C:\Temp\Temp.txt',SW_SHOW);
            end;
         except
            if DirectoryExists('A:\Temp')=False then MkDir('A:\Temp');
            AssignFile(file1,'A:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,Memo1.Text+'の平方根の整数部分');
            WriteLn(file1,X);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が A:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('A:\windows\notepad.exe A:\Temp\Temp.txt',SW_SHOW);
            end;
         end;
   end;
   Memo1.SetFocus;
end;

procedure Tfrm_heihoukon1.FormShow(Sender: TObject);
begin
   Memo1.Clear;
   Memo2.Clear;
   Memo3.Visible:=false;
   Memo1.SetFocus;

end;

procedure Tfrm_heihoukon1.Button2Click(Sender: TObject);
begin
   Memo1.Clear;
   Memo2.Clear;
   Memo3.Visible:=false;
   Memo1.SetFocus;

end;

procedure Tfrm_heihoukon1.Button3Click(Sender: TObject);
begin
   frm_heihoukon1.Close;

end;

procedure Tfrm_heihoukon1.Memo1Change(Sender: TObject);
begin
   Memo2.Clear;
   Memo3.Visible:=true;
   Memo3.Text:='入力文字数＝'+inttostr(length(Memo1.Text));

   if rightstr(Memo1.Text,2)=#$D#$A then
   begin
      beep;
      showmessage('BackSpaceキーを押して、改行コードを取り除いてください。');
      exit;
   end;
   
   if Memo1.Text='' then exit;
   if (ansicomparestr(rightstr(Memo1.Text,1),'0')<0) or (ansicomparestr(rightstr(Memo1.Text,1),'9')>0) then
   begin
      beep;
      showmessage('半角数字を入力してください。');
      exit;
   end;
   
end;

end.

*****************************************************************************************

Ｎ乗根（2≦Ｎ≦300）を求めるソースコード

unit Njoukon;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  Tfrm_Njoukon = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    Label3: TLabel;
    Label4: TLabel;
    Edit2: TEdit;
    Button3: TButton;
    Button4: TButton;
    Label5: TLabel;
    Edit3: TEdit;
    Memo1: TMemo;
    Memo2: TMemo;
    Memo3: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  frm_Njoukon: Tfrm_Njoukon;
  BLN:boolean;

implementation

{$R *.dfm}

procedure KAKERU(A,B:array of byte; var X:array of byte; var AA:integer; BB:integer);
//かけ算のサブプロシージャ   A×B＝X
var XX:array of array of byte;
var C,J,N:integer;
var Q:byte;

begin
   setlength(XX,BB+1,AA+BB+1);
   for J:= 1 to BB do
   begin
      Q:=0;
      for N:= 1 to AA do
      begin
         C:= A[N]*B[J]+Q;
         XX[J,N+J-1]:= C mod 10;
         Q:= C div 10;
      end;
      XX[J,AA+J]:= Q;
   end;

   Q:= 0;
   for N:= 1 to AA+BB do
   begin
      C:= 0;
      for J:= 1 to BB do C:= C+XX[J,N];
      C:= C+Q;
      X[N]:= C mod 10;
      Q:= C div 10;
   end;

   if X[AA+BB]=0 then AA:= AA+BB-1 else AA:= AA+BB;
end;

procedure TASU(A,B:array of byte; var X:array of byte; ketasuu:integer);
//足し算のサブプロシージャ   A+B=X
var C,N,Q:integer;
begin
   for N:=0 to ketasuu do
      X[N]:=0;

   Q:=0;
   for N:=ketasuu downto 0 do
   begin
      C:=A[N]+B[N]+Q;
      X[N]:=C mod 10;
      Q:=C div 10;
   end;
end;

procedure HIKU(A,B:array of byte; var X:array of byte; ketasuu:integer);
//引き算のサブプロシージャ   A-B=X
var C,N,Q:integer;
begin
   for N:=0 to ketasuu do
      X[N]:=0;

   Q:=1;
   for N:=ketasuu downto 1 do
   begin
      C:=10+A[N]-1+Q-B[N];
      X[N]:=C mod 10;
      Q:=C div 10;
   end;
end;

procedure Tfrm_Njoukon.Button1Click(Sender: TObject);
var CC:string;
var N:integer;

begin
   if Edit1.text='' then
   begin
      beep;
      showmessage('半角数字で 2以上 300以下の自然数を入力してください。');
      Edit1.SetFocus;
      exit;
   end;

   CC:= Edit1.text;
   for N:=1 to length(CC) do
      if (ansicomparestr(copy(CC,N,1),'0')<0) or (ansicomparestr(copy(CC,N,1),'9')>0) then
      begin
         beep;
         showmessage('半角数字で 2以上 300以下の自然数を入力してください。');
         Edit1.SetFocus;
         exit;
      end;

   if length(CC)>3 then
   begin
      beep;
      showmessage('入力文字数を3以下にしてください。');
      Edit1.SetFocus;
      exit;
   end;

   if (strtoint(CC)>300) or (strtoint(CC)<2) then
   begin
      beep;
      showmessage('半角数字で 2以上 300以下の自然数を入力してください。');
      Edit1.SetFocus;
      exit;
   end;

   Label3.Visible:=True;
   Label3.Caption:='20桁以内の正の数(整数または小数)を入力してください。その数の '+Edit1.text+'乗根を100桁まで求めます。';
   Button1.Visible:=False;
   Button2.Visible:=False;
   Label4.Visible:=True;
   Edit2.Visible:=True;
   Button3.Visible:=True;
   Button4.Visible:=True;
   Edit2.SetFocus;
   Edit2.Clear;

end;

procedure Tfrm_Njoukon.Button3Click(Sender: TObject);
var AAA,BBB,XXX,PPP,ZZZ:array of byte;
var AA,BB,M,N,R,S:integer;
var T:extended;
var H,I,K,L,U,G:byte;
var A,B,C,X,XX,CC,TT,P,PP,Z,ZZ:string;
var file1:textfile;

begin
   if BLN=true then
      BLN:=false
   else
   begin
      BLN:=true;
      Label5.Visible:=False;
      Edit3.Visible:=False;

      if Edit2.text='' then
      begin
         beep;
         showmessage('半角数字で20桁以内の正の数を入力してください。');
         Edit2.SetFocus;
         BLN:=false;
         exit;
      end;

      H:= length(Edit2.text);
      I:= ansipos('.',Edit2.text);

      if I=0 then
      begin
         if H>20 then
         begin
            beep;
            showmessage('半角数字で20桁以内の正の数を入力してください。');
            Edit2.SetFocus;
            BLN:=false;
            exit;
         end;
      end
      else
      begin
         if I=1 then
         begin
            if H>20 then
            begin
               beep;
               showmessage('位取り表示のための 0 も含めて半角数字で20桁以内の正の数を入力してください。');
               Edit2.SetFocus;
               BLN:=false;
               exit;
            end;
         end
         else
         begin
            if H>21 then
            begin
               beep;
               showmessage('位取り表示のための 0 も含めて半角数字で20桁以内の正の数を入力してください。');
               Edit2.SetFocus;
               BLN:=false;
               exit;
            end;
         end;
      end;

      if I=0 then
         CC:= Edit2.text
      else
         CC:= copy(Edit2.text,1,I-1)+copy(Edit2.text,I+1,H-I);

      for N:=1 to length(CC) do
         if (ansicomparestr(copy(CC,N,1),'0')<0) or (ansicomparestr(copy(CC,N,1),'9')>0) then
         begin
            beep;
            showmessage('半角数字で20桁以内の正の数を入力してください。');
            Edit2.SetFocus;
            BLN:=false;
            exit;
         end;

      S:= StrToInt(Edit1.text);
      T:= StrToFloat(Edit2.text);
      TT:= Edit2.text;
      L:= ansipos('.',Edit2.text);

      if T<=0 then
      begin
         beep;
         showmessage('半角数字で20桁以内の正の数を入力してください。');
         Edit2.SetFocus;
         BLN:=false;
         exit;
      end;

      if T=1 then
      begin
         beep;
         Label5.Visible:=True;
         Label5.Caption:='求める '+Edit1.text+'乗根';
         Edit3.Visible:=True;
         Edit3.Text:='1';
         BLN:=false;
         exit;
      end;

      Memo1.Visible:=true;
      Memo2.Visible:=true;
      Memo3.Visible:=true;
      Memo2.Clear;
      Memo3.Clear;
      application.ProcessMessages;
      Button3.Caption:='計算中止';
      Button4.Visible:=false;

      if T>1 then
      begin
         Z:= '2';

         while (BLN=true) and (length(Z)<102) do
         begin
            Memo2.Lines.Strings[0]:= inttostr(length(Z));
            K:= ansipos('.',Z);
            if K= 0 then
               A:= Z
            else
               A:= copy(Z,1,K-1)+copy(Z,K+1,length(Z)-K);

            B:=A;
            AA:=length(A);
            BB:=length(B);
            setlength(AAA,AA+1);
            setlength(BBB,BB+1);

            for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
            for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

            M:=1;
            while M<=S-1 do
            begin
               setlength(XXX,AA+BB+1);
               KAKERU(AAA,BBB,XXX,AA,BB);
               setlength(AAA,AA+1);
               for N:= 1 to AA do AAA[N]:= XXX[N];
               M:= M+1;
               Memo3.Lines.Strings[0]:= inttostr(M);
            end;

            X:='';
            for N:=AA downto 1 do X:=X+inttostr(XXX[N]);
            if K<>0 then X:=copy(X,1,length(X)-(length(Z)-K)*S)+'.'+copy(X,length(X)-(length(Z)-K)*S+1,(length(Z)-K)*S);

            if ansipos('.',X)=0 then
            begin
               if L=0 then XX:=StringOfChar('0',H-length(X))+X+'.'+StringOfChar('0',H);
               if L<>0 then XX:=StringOfChar('0',L-1-length(X))+X+'.'+StringOfChar('0',H);
            end;

            if ansipos('.',X)<>0 then
            begin
               XX:=X+StringOfChar('0',H);
            end;

            if L=0 then TT:=Edit2.text+'.'+StringOfChar('0',H+AA);
            if L<>0 then TT:=Edit2.text+StringOfChar('0',H+AA);

            XX:=StringOfChar('0',ansipos('.',TT)-ansipos('.',XX))+XX;
            TT:=StringOfChar('0',ansipos('.',XX)-ansipos('.',TT))+TT;

            if ansipos('.',XX)<>ansipos('.',TT) then
            begin
               showmessage('あってはならないことが起こってしまいました。');
               BLN:=false;
               exit;
            end;

            if length(XX)<length(TT) then
            begin
               R:=length(XX);
            end
            else
            begin
               R:=length(TT);
            end;

            U:=1;

            for N:=1 to R do
            begin
               if (copy(TT,N,1)<>'.') and (copy(XX,N,1)<>'.') then
               begin
                  if strtoint(copy(TT,N,1))>strtoint(copy(XX,N,1)) then
                  begin
                     U:=2;
                     break;
                  end;

                  if strtoint(copy(TT,N,1))<strtoint(copy(XX,N,1)) then
                  begin
                     U:=3;
                     break;
                  end;
               end;
            end;

            if U=1 then
            begin
               break;
            end;

            if U=2 then
            begin
               G:= ansipos('.',Z);

               if G=0 then
               begin
                  for N:=length(Z) downto 1 do
                  begin
                     if copy(Z,N,1)<>'0' then break;
                  end;

                  if (N=1) or (copy(Z,N,1)<>'9') then
                  begin
                     Z:= IntToStr(StrToInt(Z)+StrToInt('1'+StringOfChar('0',length(Z)-N)));
                  end
                  else
                  begin
                     if N<>length(Z) then
                     begin
                        Z:= IntToStr(StrToInt(Z)+StrToInt('1'+StringOfChar('0',length(Z)-N-1)));
                     end
                     else
                     begin
                        Z:= FloatToStr(StrToInt(Z)+0.1);
                     end;
                  end;
               end;

               if G<>0 then
               begin
                  ZZ:= copy(Z,1,G-1)+copy(Z,G+1,length(Z)-G);
                  setlength(ZZZ,length(ZZ)+1);
                  setlength(PPP,length(ZZ)+1);
                  setlength(XXX,length(ZZ)+1);
                  for N:=1 to length(ZZ) do ZZZ[N]:=StrToInt(copy(ZZ,N,1));
                  for N:=1 to length(ZZ)-1 do PPP[N]:=0;
                  PPP[length(ZZ)]:=1;
                  TASU(ZZZ,PPP,XXX,length(ZZ));
                  X:='';
                  for N:=0 to length(ZZ) do X:=X+IntToStr(XXX[N]);

                  if XXX[0]=1 then
                  begin
                     Z:= copy(X,1,G)+'.'+copy(X,G+1,length(X)-G);
                  end
                  else
                  begin
                     Z:= copy(X,2,G-1)+'.'+copy(X,G+1,length(X)-G);
                  end;
               end;
            end;

            if U=3 then
            begin
               G:= ansipos('.',Z);

               if G=0 then
               begin
                  for N:=length(Z) downto 1 do
                  begin
                     if copy(Z,N,1)<>'0' then break;
                  end;

                  if Z='10' then
                  begin
                     Z:= '9.1'
                  end
                  else
                  begin
                     if N=length(Z) then
                     begin
                        Z:= FloatToStr(StrToInt(Z)-0.9);
                     end
                     else
                     begin
                        if (N=1) and (copy(Z,1,1)='1') then
                        begin
                           Z:= IntToStr(StrToInt(Z)-StrToInt('9'+StringOfChar('0',length(Z)-N-2)));
                        end
                        else
                        begin
                           Z:= IntToStr(StrToInt(Z)-StrToInt('9'+StringOfChar('0',length(Z)-N-1)));
                        end;
                     end;
                  end;
               end;

               if G<>0 then
               begin
                  ZZ:= copy(Z,1,G-1)+copy(Z,G+1,length(Z)-G);
                  setlength(ZZZ,length(ZZ)+1);
                  setlength(PPP,length(ZZ)+1);
                  setlength(XXX,length(ZZ)+1);
                  for N:=1 to length(ZZ) do ZZZ[N]:=StrToInt(copy(ZZ,N,1));
                  for N:=1 to length(ZZ)-1 do PPP[N]:=0;
                  PPP[length(ZZ)]:=1;
                  HIKU(ZZZ,PPP,XXX,length(ZZ));
                  X:='';
                  for N:=1 to length(ZZ) do X:=X+IntToStr(XXX[N]);

                  if XXX[1]=0 then
                  begin
                     Z:= copy(X,2,G-2)+'.'+copy(X,G,length(X)-G+1);
                  end
                  else
                  begin
                     Z:= copy(X,1,G-1)+'.'+copy(X,G,length(X)-G+1);
                  end;

                  Z:= Z+'1';
               end;
            end;
            application.ProcessMessages;
         end;
      end;


      if T<1 then
      begin
         Z:= '0.9';

         while (BLN=true) and (length(Z)<102) do
         begin
            Memo2.Lines.Strings[0]:= inttostr(length(Z));
            K:= ansipos('.',Z);
            A:= copy(Z,1,K-1)+copy(Z,K+1,length(Z)-K);

            B:=A;
            AA:=length(A);
            BB:=length(B);
            setlength(AAA,AA+1);
            setlength(BBB,BB+1);

            for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
            for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

            M:=1;
            while M<=S-1 do
            begin
               setlength(XXX,AA+BB+1);
               KAKERU(AAA,BBB,XXX,AA,BB);
               setlength(AAA,AA+1);
               for N:= 1 to AA do AAA[N]:= XXX[N];
               M:= M+1;
               Memo3.Lines.Strings[0]:= inttostr(M);
            end;

            X:='';
            for N:=AA downto 1 do X:=X+inttostr(XXX[N]);
            X:=copy(X,1,length(X)-(length(Z)-K)*S)+'.'+copy(X,length(X)-(length(Z)-K)*S+1,(length(Z)-K)*S);
            XX:=X+StringOfChar('0',H);
            TT:=Edit2.text+StringOfChar('0',H+AA);

            XX:=StringOfChar('0',ansipos('.',TT)-ansipos('.',XX))+XX;
            TT:=StringOfChar('0',ansipos('.',XX)-ansipos('.',TT))+TT;

            if ansipos('.',XX)<>ansipos('.',TT) then
            begin
               showmessage('あってはならないことが起こってしまいました。');
               BLN:=false;
               exit;
            end;

            if length(XX)<length(TT) then
            begin
               R:=length(XX);
            end
            else
            begin
               R:=length(TT);
            end;

            U:=1;

            for N:=1 to R do
            begin
               if (copy(TT,N,1)<>'.') and (copy(XX,N,1)<>'.') then
               begin
                  if strtoint(copy(TT,N,1))>strtoint(copy(XX,N,1)) then
                  begin
                     U:=2;
                     break;
                  end;

                  if strtoint(copy(TT,N,1))<strtoint(copy(XX,N,1)) then
                  begin
                     U:=3;
                     break;
                  end;
               end;
            end;

            if U=1 then
            begin
               break;
            end;

            if U=3 then
            begin
               G:= ansipos('.',Z);
               ZZ:= copy(Z,1,G-1)+copy(Z,G+1,length(Z)-G);
               setlength(ZZZ,length(ZZ)+1);
               setlength(PPP,length(ZZ)+1);
               setlength(XXX,length(ZZ)+1);
               for N:=1 to length(ZZ) do ZZZ[N]:=StrToInt(copy(ZZ,N,1));
               for N:=1 to length(ZZ)-1 do PPP[N]:=0;
               PPP[length(ZZ)]:=1;
               HIKU(ZZZ,PPP,XXX,length(ZZ));
               X:='';
               for N:=1 to length(ZZ) do X:=X+IntToStr(XXX[N]);

               if StrToFloat(X)<>0 then
               begin
                  Z:= copy(X,1,G-1)+'.'+copy(X,G,length(X)-G+1);
               end
               else
               begin
                  Z:= IntToStr(0)+'.'+StringOfChar('0',length(ZZ)-1)+IntToStr(9);
               end;
            end;

            if U=2 then Z:= Z+'9';
            application.ProcessMessages;
         end;
      end;

      if BLN=false then
      begin
         Memo1.Visible:=false;
         Memo2.Visible:=false;
         Memo3.Visible:=false;
         Button3.Caption:='計算開始';
         Button4.Visible:=true;
         exit;
      end;

      if length(Z)=102 then Z:=copy(Z,1,101);

      Memo1.Visible:=false;
      Label5.Visible:=True;
      Label5.Caption:='求める '+Edit1.text+'乗根';
      Edit3.Visible:=True;
      Edit3.Text:=Z;

      Button3.Caption:='計算開始';
      Button4.Visible:=true;
      BLN:=false;

      beep;
      if MessageDlg('計算完了。　計算結果を保存または印刷しますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
      begin
         try
            if DirectoryExists('C:\Temp')=False then MkDir('C:\Temp');
            AssignFile(file1,'C:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,Edit2.text+' の'+Edit1.text+'乗根');
            WriteLn(file1,Z);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が C:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('C:\windows\notepad.exe C:\Temp\Temp.txt',SW_SHOW);
            end;
         except
            if DirectoryExists('A:\Temp')=False then MkDir('A:\Temp');
            AssignFile(file1,'A:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,Edit2.text+' の'+Edit1.text+'乗根');
            WriteLn(file1,Z);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が A:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('A:\windows\notepad.exe A:\Temp\Temp.txt',SW_SHOW);
            end;
         end;
      end;
      Edit2.SetFocus;
   end;

end;

procedure Tfrm_Njoukon.Button2Click(Sender: TObject);
begin
   frm_Njoukon.Close;

end;

procedure Tfrm_Njoukon.Button4Click(Sender: TObject);
begin
   Label1.Visible:=True;
   Label2.Visible:=True;
   Edit1.Visible:=True;
   Button1.Visible:=True;
   Button2.Visible:=True;
   Label3.Visible:=False;
   Label4.Visible:=False;
   Label5.Visible:=False;
   Edit2.Visible:=False;
   Edit3.Visible:=False;
   Button3.Visible:=False;
   Button4.Visible:=False;
   frm_Njoukon.Close;

end;

procedure Tfrm_Njoukon.Edit1Change(Sender: TObject);
begin
   Label5.Visible:=False;
   Edit3.Visible:=False;
   Memo2.Visible:=false;
   Memo3.Visible:=false;

end;

procedure Tfrm_Njoukon.Edit2Change(Sender: TObject);
begin
   Label5.Visible:=False;
   Edit3.Visible:=False;
   Memo2.Visible:=false;
   Memo3.Visible:=false;

end;

procedure Tfrm_Njoukon.FormShow(Sender: TObject);
begin
   Memo1.Visible:=false;
   Memo2.Visible:=false;
   Memo3.Visible:=false;
   Edit1.SetFocus;
   Edit1.Clear;
   Button4.Visible:=False;

end;

procedure Tfrm_Njoukon.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   Label1.Visible:=True;
   Label2.Visible:=True;
   Edit1.Visible:=True;
   Button1.Visible:=True;
   Button2.Visible:=True;
   Label3.Visible:=False;
   Label4.Visible:=False;
   Label5.Visible:=False;
   Edit2.Visible:=False;
   Edit3.Visible:=False;
   Button3.Visible:=False;
   if BLN=true then BLN:=false;

end;

end.

*****************************************************************************************

累乗（自然数べき）を求めるソースコード

unit ruijou;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Menus;

type
  Tfrm_ruijou = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Label2: TLabel;
    Label1: TLabel;
    Label3: TLabel;
    Button2: TButton;
    RichEdit1: TRichEdit;
    Memo1: TMemo;
    PopupMenu1: TPopupMenu;
    Copy1: TMenuItem;
    Paste1: TMenuItem;
    Memo2: TMemo;
    Label4: TLabel;
    Memo3: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Copy1Click(Sender: TObject);
    procedure Paste1Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  frm_ruijou: Tfrm_ruijou;
  BLN:boolean;

implementation

{$R *.dfm}

procedure KAKERU(A,B:array of byte; var X:array of byte; var AA:integer; BB:integer);
//かけ算のサブプロシージャ   A×B＝X
var XX:array of array of byte;
var C,J,N:integer;
var Q:byte;

begin
   setlength(XX,BB+1,AA+BB+1);
   for J:= 1 to BB do
   begin
      Q:=0;
      for N:= 1 to AA do
      begin
         C:= A[N]*B[J]+Q;
         XX[J,N+J-1]:= C mod 10;
         Q:= C div 10;
      end;
      XX[J,AA+J]:= Q;
   end;

   Q:= 0;
   for N:= 1 to AA+BB do
   begin
      C:= 0;
      for J:= 1 to BB do C:= C+XX[J,N];
      C:= C+Q;
      X[N]:= C mod 10;
      Q:= C div 10;
   end;

   if X[AA+BB]=0 then AA:= AA+BB-1 else AA:= AA+BB;
end;

procedure Tfrm_ruijou.Button1Click(Sender: TObject);
var AAA,BBB,XXX:array of byte;
var AA,BB,C,J,LL,N,M,ketakazu:integer;
var D,E,H,K,L,U:byte;
var A,B,CC,PP,PPP,PPPP,SS,SSS,SSSS,SSSSS,XX:string;
var file1:textfile;

begin
   if BLN=true then
      BLN:=false
   else
   begin
      BLN:=true;
      RichEdit1.Clear;
      Memo1.Visible:=true;
      Memo1.Clear;
      Memo2.Clear;
      application.ProcessMessages;

      H:= length(Edit1.text);
      K:= ansipos('.',Edit1.text);

      if (H>100) and (K=0) then
      begin
         beep;
         showmessage('入力文字数を100以下にしてください。');
         Edit1.SetFocus;
         BLN:=false;
         exit;
      end;

      if (H>101) and (K<>0) then
      begin
         beep;
         showmessage('小数点を含めた入力文字数を101以下にしてください。');
         Edit1.SetFocus;
         BLN:=false;
         exit;
      end;

      if K=0 then
         CC:= Edit1.text
      else
         CC:= copy(Edit1.text,1,K-1)+copy(Edit1.text,K+1,H-K);

      for N:=1 to length(CC) do
         if (ansicomparestr(copy(CC,N,1),'0')<0) or (ansicomparestr(copy(CC,N,1),'9')>0) then
         begin
            beep;
            showmessage('半角数字で100桁以内の正の数を入力してください。');
            Edit1.SetFocus;
            BLN:=false;
            exit;
         end;

      U:= 0;
      for N:=1 to length(CC) do
         if copy(CC,N,1)<>'0' then
         begin
            U:= 1;
            break;
         end;

      if U= 0 then
      begin
         beep;
         showmessage('半角数字で100桁以内の正の数を入力してください。');
         Edit1.SetFocus;
         BLN:=false;
         exit;
      end;

      if Edit2.text='' then
      begin
         beep;
         showmessage('半角数字で 10000以下の自然数を入力してください。');
         Edit2.SetFocus;
         BLN:=false;
         exit;
      end;

      CC:= Edit2.text;
      for N:=1 to length(CC) do
         if (ansicomparestr(copy(CC,N,1),'0')<0) or (ansicomparestr(copy(CC,N,1),'9')>0) then
         begin
            beep;
            showmessage('半角数字で 10000以下の自然数を入力してください。');
            Edit2.SetFocus;
            BLN:=false;
            exit;
         end;

      if length(CC)>5 then
      begin
         beep;
         showmessage('入力文字数を5以下にしてください。');
         Edit2.SetFocus;
         BLN:=false;
         exit;
      end;

      if (strtoint(CC)>10000) or (strtoint(CC)<1) then
      begin
         beep;
         showmessage('半角数字で 10000以下の自然数を入力してください。');
         Edit2.SetFocus;
         BLN:=false;
         exit;
      end;

      Button1.Caption:='計算中止';
      Button2.Visible:=false;

      for N:=1 to length(Edit1.text) do
      begin
          if copy(Edit1.text,N,1)<>'0' then break;
      end;

      if copy(Edit1.text,N,1)='.' then
      begin
         if N=1 then
         begin
            SS:= '0'+Edit1.text;
         end
         else
         begin
            SS:= copy(Edit1.text,N-1,length(Edit1.text)-N+2);
         end;
      end
      else
      begin
         SS:= copy(Edit1.text,N,length(Edit1.text)-N+1);
      end;

      for N:=length(SS) downto 1 do
      begin
         if copy(SS,N,1)<>'0' then break;
      end;

      L:= ansipos('.',SS);

      if L<>0 then
      begin
         if copy(SS,N,1)='.' then
         begin
            SS:= copy(SS,1,N-1);
         end
         else
         begin
            SS:= copy(SS,1,N);
         end;
      end;

      L:= ansipos('.',SS);

      if L= 0 then
      begin
         SSS:= SS;
      end
      else
      begin
         SSS:= copy(SS,1,L-1)+copy(SS,L+1,length(SS)-L);
      end;

      for N:=length(SSS) downto 1 do
      begin
         if copy(SSS,N,1)<>'0' then break;
      end;

      D:= length(SSS)-N;
      SSSS:= copy(SSS,1,N);

      if copy(SSSS,1,1)='0' then
      begin
         E:= length(SSSS)-1;
      end
      else
      begin
         E:= 0;
      end;

      for N:=1 to length(SSSS) do
      begin
         if copy(SSSS,N,1)<>'0' then break;
      end;

      SSSSS:= copy(SSSS,N,length(SSSS)-N+1);

      A:= '1';
      B:= SSSSS;

      AA:=length(A);
      BB:=length(B);
      setlength(AAA,AA+1);
      setlength(BBB,BB+1);
      setlength(XXX,AA+BB+1);

      for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
      for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

      J:= strtoint(Edit2.text);

      M:=1;

      while (M<=J) and (BLN=true) do
      begin
         Memo1.Lines.Strings[0]:= inttostr(M);
         setlength(XXX,AA+BB+1);
         KAKERU(AAA,BBB,XXX,AA,BB);
         setlength(AAA,AA+1);
         for N:= 1 to AA do AAA[N]:= XXX[N];
         M:= M+1;
         application.ProcessMessages;
      end;

      if BLN=false then
      begin
         Button1.Caption:='計算開始';
         Button2.Visible:=true;
         exit;
      end;

      PP:='';
      for N:= AA downto 1 do PP:=PP+inttostr(XXX[N]);

      if D<>0 then
      begin
         PPP:= PP+StringOfChar('0',D*J);
      end;

      if E<>0 then
      begin
         PPP:= '0.'+StringOfChar('0',E*J-AA)+PP;
      end;

      if (D=0) and (E=0) then
      begin
         if L=0 then
         begin
            PPP:= PP;
         end
         else
         begin
            PPP:= copy(PP,1,AA-(length(SS)-L)*J)+'.'+copy(PP,AA-(length(SS)-L)*J+1,(length(SS)-L)*J);
         end
      end;

      LL:= ansipos('.',PPP);

      if LL=0 then
      begin
         C:= length(PPP);
      end
      else
      begin
         C:= length(PPP)-1;
      end;

      PPPP:= PPP+'    (桁数＝'+inttostr(C)+')';

      ketakazu:= 200;

      if StrToFloat(SS)>=1 then
      begin
         if L=0 then
         begin
            XX:= copy(PPP,1,1)+'.'+copy(PPP,2,ketakazu-1)+'E'+IntToStr(C-1);
         end
         else
         begin
            XX:= copy(PP,1,1)+'.'+copy(PP,2,ketakazu-1)+'E'+IntToStr(AA-(length(SS)-L)*J-1);
         end;
      end
      else
      begin
         XX:= copy(PP,1,1)+'.'+copy(PP,2,ketakazu-1)+'E-'+IntToStr(E*J-AA+1);
      end;

      
      Memo2.Visible:=true;
      Label4.Visible:=true;
      RichEdit1.text:=PPPP;
      Memo2.Text:=XX;

      Button1.Caption:='計算開始';
      Button2.Visible:=true;
      BLN:=false;

      beep;
      if MessageDlg('計算完了。　計算結果を保存または印刷しますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
      begin
         try
            if DirectoryExists('C:\Temp')=False then MkDir('C:\Temp');
            AssignFile(file1,'C:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,Edit1.text+'の'+Edit2.text+'乗');
            WriteLn(file1,PPPP);
            WriteLn(file1,Chr(13));
            WriteLn(file1,XX);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が C:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('C:\windows\notepad.exe C:\Temp\Temp.txt',SW_SHOW);
            end;
         except
            if DirectoryExists('A:\Temp')=False then MkDir('A:\Temp');
            AssignFile(file1,'A:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,Edit1.text+'の'+Edit2.text+'乗');
            WriteLn(file1,PPPP);
            WriteLn(file1,Chr(13));
            WriteLn(file1,XX);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が A:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('A:\windows\notepad.exe A:\Temp\Temp.txt',SW_SHOW);
            end;
         end;
      end;
      Edit2.SetFocus;
   end;
end;

procedure Tfrm_ruijou.Button2Click(Sender: TObject);
begin
   frm_ruijou.Close;

end;

procedure Tfrm_ruijou.FormShow(Sender: TObject);
begin
   RichEdit1.Clear;
   Memo1.Visible:=false;
   Memo2.Visible:=false;
   Label4.Visible:=false;
   Edit1.SetFocus;
   Edit1.Clear;
   Edit2.Clear;
   Memo3.Visible:=false;

end;

procedure Tfrm_ruijou.Copy1Click(Sender: TObject);
begin
   RichEdit1.CopyToClipboard;

end;

procedure Tfrm_ruijou.Paste1Click(Sender: TObject);
begin
   RichEdit1.PasteFromClipboard;

end;

procedure Tfrm_ruijou.Edit1Change(Sender: TObject);
begin
   Memo1.Visible:=false;
   RichEdit1.Clear;
   Memo2.Clear;
   Memo3.Visible:=true;
   Memo3.Text:='入力文字数＝'+inttostr(length(Edit1.Text));

end;

procedure Tfrm_ruijou.Edit2Change(Sender: TObject);
begin
   Memo1.Visible:=false;
   RichEdit1.Clear;
   Memo2.Clear;

end;

procedure Tfrm_ruijou.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   if BLN=true then BLN:=false;

end;

end.

*****************************************************************************************

累乗（小数べき、12桁まで）を求めるソースコード（多倍長数値計算ではない）

unit yuurisuubeki;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Math;

type
  Tfrm_yuurisuubeki = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Button2: TButton;
    Label5: TLabel;
    Label6: TLabel;
    Memo1: TMemo;
    Memo2: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  frm_yuurisuubeki: Tfrm_yuurisuubeki;
  BLN:boolean;

implementation

{$R *.dfm}

procedure KAKERU(A,B:array of byte; var X:array of byte; var AA:integer; BB:integer);
//かけ算のサブプロシージャ   A×B＝X
var XX:array of array of byte;
var C,J,N:integer;
var Q:byte;

begin
   setlength(XX,BB+1,AA+BB+1);
   for J:= 1 to BB do
   begin
      Q:=0;
      for N:= 1 to AA do
      begin
         C:= A[N]*B[J]+Q;
         XX[J,N+J-1]:= C mod 10;
         Q:= C div 10;
      end;
      XX[J,AA+J]:= Q;
   end;

   Q:= 0;
   for N:= 1 to AA+BB do
   begin
      C:= 0;
      for J:= 1 to BB do C:= C+XX[J,N];
      C:= C+Q;
      X[N]:= C mod 10;
      Q:= C div 10;
   end;

   if X[AA+BB]=0 then AA:= AA+BB-1 else AA:= AA+BB;
end;

procedure Tfrm_yuurisuubeki.Button1Click(Sender: TObject);
var AAA,BBB,XXX:array of byte;
var AA,BB,N,M,Z:integer;
var TEI,P,C,D,E,X,Y:extended;
var H,K,L,T:byte;
var A,B,CC,S,SS,XX,XXXX:string;
var file1:textfile;
label jmp1;

begin
   if BLN=true then
      BLN:=false
   else
   begin
      BLN:=true;
      Memo2.Clear;
      application.ProcessMessages;

      if Edit1.text='' then
      begin
         beep;
         showmessage('底 A には半角数字で12桁以内の正の数を入力してください。');
         Edit1.SetFocus;
         BLN:=false;
         exit;
      end;

      H:= length(Edit1.text);
      K:= ansipos('.',Edit1.text);

      if (H>12) and (K=0) then
      begin
         beep;
         showmessage('底 A には半角数字で12桁以内の正の数を入力してください。');
         Edit1.SetFocus;
         BLN:=false;
         exit;
      end;

      if (H>13) and (K<>0) then
      begin
         beep;
         showmessage('底 A には位取り表示のための 0 も含めて半角数字で12桁以内の正の数を入力してください。');
         Edit1.SetFocus;
         BLN:=false;
         exit;
      end;

      if K=0 then
         CC:= Edit1.text
      else
         CC:= copy(Edit1.text,1,K-1)+copy(Edit1.text,K+1,H-K);

      for N:=1 to length(CC) do
         if (ansicomparestr(copy(CC,N,1),'0')<0) or (ansicomparestr(copy(CC,N,1),'9')>0) then
         begin
            beep;
            showmessage('底 A には位取り表示のための 0 も含めて半角数字で12桁以内の正の数を入力してください。');
            Edit1.SetFocus;
            BLN:=false;
            exit;
         end;

      if (strtofloat(Edit1.text)<0.001) or (strtofloat(Edit1.text)>1200) then
      begin
         beep;
         showmessage('底 A には半角数字で0.001以上 1200以下の数を入力してください。');
         Edit1.SetFocus;
         BLN:=false;
         exit;
      end;

      if (Edit2.text='') or (Edit2.text='-') or (Edit2.text='.') or (Edit2.text='-.') then
      begin
         beep;
         showmessage('指数 B には半角数字で12桁以内で -1600以上 1600以下の数を入力してください。');
         Edit2.SetFocus;
         BLN:=false;
         exit;
      end;

      H:= length(Edit2.text);
      if copy(Edit2.text,1,1)='-' then CC:= copy(Edit2.text,2,H-1) else CC:= Edit2.text;
      H:= length(CC);
      K:= ansipos('.',CC);

      if (H>12) and (K=0) then
      begin
         beep;
         showmessage('指数 B には半角数字で12桁以内で -1600以上 1600以下の数を入力してください。');
         Edit2.SetFocus;
         BLN:=false;
         exit;
      end;

      if (H>13) and (K<>0) then
      begin
         beep;
         showmessage('指数 B には位取り表示のための 0 も含めて半角数字で12桁以内で -1600以上 1600以下の数 を入力してください。');
         Edit2.SetFocus;
         BLN:=false;
         exit;
      end;

      if K<>0 then CC:= copy(CC,1,K-1)+copy(CC,K+1,H-K);

      for N:=1 to length(CC) do
         if (ansicomparestr(copy(CC,N,1),'0')<0) or (ansicomparestr(copy(CC,N,1),'9')>0) then
         begin
            beep;
            showmessage('指数 B には半角数字で -1600以上 1600以下の数を入力してください。');
            Edit2.SetFocus;
            BLN:=false;
            exit;
         end;

      if (strtofloat(Edit2.text)<-1600) or (strtofloat(Edit2.text)>1600) then
      begin
         beep;
         showmessage('指数 B には半角数字で -1600以上 1600以下の数を入力してください。');
         Edit2.SetFocus;
         BLN:=false;
         exit;
      end;

      TEI:= StrToFloat(Edit1.text);

      if TEI=1 then
      begin
         XXXX:= '1';
         goto jmp1;
      end;

      if StrToFloat(Edit2.text)=1 then
      begin
         XXXX:= Edit1.text;
         goto jmp1;
      end;

      if copy(Edit2.text,1,1)='-' then
      begin
         S:= copy(Edit2.text,2,length(Edit2.text)-1);
      end
      else
      begin
         S:= Edit2.text;
      end;

      if StrToFloat(S)=0 then
      begin
         XXXX:= '1';
         goto jmp1;
      end;

      if StrToFloat(S)-Int(StrToFloat(S))=0 then
      begin
         T:= 1;
      end
      else
      begin
         if Int(StrToFloat(S))=0 then
         begin
            T:= 2;
         end
         else
         begin
            T:= 3;
         end;
      end;

      P:= StrToFloat(S)-Int(StrToFloat(S));
      X:= 0;

      if T=1 then    // S（指数の絶対値）が自然数のとき
      begin
         Memo1.Visible:=true;
         Button1.Caption:='計算中止';
         Button2.Visible:=false;
         application.ProcessMessages;

         for N:=1 to length(Edit1.text) do
         begin
             if copy(Edit1.text,N,1)<>'0' then break;
         end;

         if copy(Edit1.text,N,1)='.' then
         begin
            if N=1 then
            begin
               SS:= '0'+Edit1.text;
            end
            else
            begin
               SS:= copy(Edit1.text,N-1,length(Edit1.text)-N+2);
            end;
         end
         else
         begin
            SS:= copy(Edit1.text,N,length(Edit1.text)-N+1);
         end;

         for N:=length(SS) downto 1 do
         begin
            if copy(SS,N,1)<>'0' then break;
         end;

         L:= ansipos('.',SS);

         if L<>0 then
         begin
            if copy(SS,N,1)='.' then
            begin
               SS:= copy(SS,1,N-1);
            end
            else
            begin
               SS:= copy(SS,1,N);
            end;
         end;

         A:= '1';

         L:= ansipos('.',SS);

         if L= 0 then
         begin
            B:= SS;
         end
         else
         begin
            B:= copy(SS,1,L-1)+copy(SS,L+1,length(SS)-L);
         end;

         AA:=length(A);
         BB:=length(B);
         setlength(AAA,AA+1);
         setlength(BBB,BB+1);
         setlength(XXX,AA+BB+1);

         for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
         for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

         K:= ansipos('.',S);

         if K=0 then
         begin
            Z:= strtoint(S);
         end
         else
         begin
            Z:= strtoint(copy(S,1,K-1));
         end;

         M:=1;
         while (M<=Z) and (BLN=true) do
         begin
            setlength(XXX,AA+BB+1);
            KAKERU(AAA,BBB,XXX,AA,BB);
            setlength(AAA,AA+1);
            for N:= 1 to AA do AAA[N]:= XXX[N];
            M:= M+1;
            application.ProcessMessages;
         end;

         if BLN=false then
         begin
            Memo1.Visible:=false;
            Button1.Caption:='計算開始';
            Button2.Visible:=true;
            exit;
         end;

         XX:='';
         for N:= AA downto 1 do XX:=XX+inttostr(XXX[N]);

         if L<>0 then
         begin
            XX:= copy(XX,1,length(XX)-(length(SS)-L)*Z)+'.'+copy(XX,length(XX)-(length(SS)-L)*Z+1,(length(SS)-L)*Z);
            XX:= copy(XX,1,4932);
         end;

         X:= strtofloat(XX);
      end;

      if T=2 then    // S（指数の絶対値）の整数部分が0で、小数部分が0でないとき、即ち、0<S<1 のとき
      begin
         C:= Ln(TEI);
         D:= P*C;
         X:= 1+D;
         E:= D;
         M:= 2;

         while M<100 do
         begin
            E:= E*D/M;
            X:= X+E;
            M:= M+1;
         end;
      end;

      if T=3 then    // S（指数の絶対値）の整数部分と小数部分とがともに0でないとき
      begin
         Memo1.Visible:=true;
         Button1.Caption:='計算中止';
         Button2.Visible:=false;
         application.ProcessMessages;

         for N:=1 to length(Edit1.text) do
         begin
            if copy(Edit1.text,N,1)<>'0' then break;
         end;

         if copy(Edit1.text,N,1)='.' then
         begin
            if N=1 then
            begin
               SS:= '0'+Edit1.text;
            end
            else
            begin
               SS:= copy(Edit1.text,N-1,length(Edit1.text)-N+2);
            end;
         end
         else
         begin
            SS:= copy(Edit1.text,N,length(Edit1.text)-N+1);
         end;

         for N:=length(SS) downto 1 do
         begin
            if copy(SS,N,1)<>'0' then break;
         end;

         L:= ansipos('.',SS);

         if L<>0 then
         begin
            if copy(SS,N,1)='.' then
            begin
               SS:= copy(SS,1,N-1);
            end
            else
            begin
               SS:= copy(SS,1,N);
            end;
         end;

         A:= '1';

         L:= ansipos('.',SS);

         if L= 0 then
         begin
            B:= SS;
         end
         else
         begin
            B:= copy(SS,1,L-1)+copy(SS,L+1,length(SS)-L);
         end;

         AA:=length(A);
         BB:=length(B);
         setlength(AAA,AA+1);
         setlength(BBB,BB+1);
         setlength(XXX,AA+BB+1);

         for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
         for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

         K:= ansipos('.',S);

         if K=0 then
         begin
            Z:= strtoint(S);
         end
         else
         begin
            Z:= strtoint(copy(S,1,K-1));
         end;

         M:=1;
         while (M<=Z) and (BLN=true) do
         begin
            setlength(XXX,AA+BB+1);
            KAKERU(AAA,BBB,XXX,AA,BB);
            setlength(AAA,AA+1);
            for N:= 1 to AA do AAA[N]:= XXX[N];
            M:= M+1;
            application.ProcessMessages;
         end;

         if BLN=false then
         begin
            Memo1.Visible:=false;
            Button1.Caption:='計算開始';
            Button2.Visible:=true;
            exit;
         end;

         XX:='';
         for N:= AA downto 1 do XX:=XX+inttostr(XXX[N]);

         if L<>0 then
         begin
            XX:= copy(XX,1,length(XX)-(length(SS)-L)*Z)+'.'+copy(XX,length(XX)-(length(SS)-L)*Z+1,(length(SS)-L)*Z);
            XX:= copy(XX,1,4932);
         end;

         X:= strtofloat(XX);
         Y:= X;

         C:= Ln(TEI);
         D:= P*C;
         X:= 1+D;
         E:= D;
         M:= 2;

         while M<100 do
         begin
            E:= E*D/M;
            X:= X+E;
            M:= M+1;
         end;

         X:= Y*X;
      end;

//////////////////////////////////////////////////////////////////////////////

      if copy(Edit2.text,1,1)='-' then
      begin
         if X<>0 then
         begin
            X:= 1/X;
         end
         else
         begin
            beep;
            showmessage('変数 X の値が0になっています。');
            BLN:=false;
            exit;
         end;
      end;

      XX:= floattostr(X);

      L:= ansipos('.',XX);

      if L=0 then
      begin
         CC:= XX;
      end
      else
      begin
         CC:= copy(XX,1,L-1)+copy(XX,L+1,length(XX)-L);
      end;

      K:= ansipos('E',XX);

      if K=0 then
      begin
         if length(CC)<=12 then
         begin
            XXXX:= XX;
         end
         else
         begin
            if L=0 then
            begin
               XXXX:= copy(XX,1,1)+'.'+copy(XX,2,11)+'E'+IntToStr(length(XX)-1);
            end
            else
            begin
               if copy(XX,1,1)='0' then
               begin
                  XXXX:= copy(XX,1,14);
               end
               else
               begin
                  XXXX:= copy(CC,1,1)+'.'+copy(CC,2,11)+'E'+IntToStr(L-2);
               end;
            end;
         end;
      end
      else
      begin
         if K<=14 then
         begin
            XXXX:= XX;
         end
         else
         begin
            XXXX:= copy(XX,1,13)+copy(XX,K,length(XX)-k+1);
         end;
      end;


      Memo1.Visible:=false;
      Label5.Visible:=true;
      Label6.Visible:=true;
jmp1:
      Memo2.Text:=XXXX;

      Button1.Caption:='計算開始';
      Button2.Visible:=true;
      BLN:=false;

      beep;
      if MessageDlg('計算完了。　計算結果を保存または印刷しますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
      begin
         try
            if DirectoryExists('C:\Temp')=False then MkDir('C:\Temp');
            AssignFile(file1,'C:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,Edit1.text+'の'+Edit2.text+'乗');
            WriteLn(file1,XXXX);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が C:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('C:\windows\notepad.exe C:\Temp\Temp.txt',SW_SHOW);
            end;
         except
            if DirectoryExists('A:\Temp')=False then MkDir('A:\Temp');
            AssignFile(file1,'A:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,Edit1.text+'の'+Edit2.text+'乗');
            WriteLn(file1,XXXX);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が A:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('A:\windows\notepad.exe A:\Temp\Temp.txt',SW_SHOW);
            end;
         end;
      end;
      Edit2.SetFocus;
   end;
end;

procedure Tfrm_yuurisuubeki.Button2Click(Sender: TObject);
begin
   frm_yuurisuubeki.Close;

end;

procedure Tfrm_yuurisuubeki.FormShow(Sender: TObject);
begin
   Edit1.SetFocus;
   Edit1.Clear;
   Edit2.Clear;
   Label5.Visible:=false;
   Label6.Visible:=false;
   Memo1.Visible:=false;

end;

procedure Tfrm_yuurisuubeki.Edit1Change(Sender: TObject);
begin
   Memo2.Clear;

end;

procedure Tfrm_yuurisuubeki.Edit2Change(Sender: TObject);
begin
   Memo2.Clear;

end;

procedure Tfrm_yuurisuubeki.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   if BLN=true then BLN:=false;

end;

end.

*****************************************************************************************

累乗（小数べき、50桁まで）を求めるソースコード

unit yuurisuubeki2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Math;

type
  Tfrm_yuurisuubeki2 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Button2: TButton;
    Label5: TLabel;
    Label6: TLabel;
    Memo1: TMemo;
    Label7: TLabel;
    Memo2: TMemo;
    Memo3: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  frm_yuurisuubeki2: Tfrm_yuurisuubeki2;
  BLN:boolean;

implementation

{$R *.dfm}

procedure KAKERU(A,B:array of byte; var X:array of byte; var AA:integer; BB:integer);
//かけ算のサブプロシージャ   A×B＝X
var XX:array of array of byte;
var C,J,N:integer;
var Q:byte;

begin
   setlength(XX,BB+1,AA+BB+1);
   for J:= 1 to BB do
   begin
      Q:=0;
      for N:= 1 to AA do
      begin
         C:= A[N]*B[J]+Q;
         XX[J,N+J-1]:= C mod 10;
         Q:= C div 10;
      end;
      XX[J,AA+J]:= Q;
   end;

   Q:= 0;
   for N:= 1 to AA+BB do
   begin
      C:= 0;
      for J:= 1 to BB do C:= C+XX[J,N];
      C:= C+Q;
      X[N]:= C mod 10;
      Q:= C div 10;
   end;

   if X[AA+BB]=0 then AA:= AA+BB-1 else AA:= AA+BB;
end;

procedure WARIZAN(AAAA:string; BBBB:string; var YY:string; ketasuu:integer);
//割り算のサブプロシージャ   AAAA÷BBBB=YY
var A,B:array[1..202] of byte; C:array[1..1202] of byte; X:array[1..1000] of byte;
var D,E,F,G,J,N,Q,S,T:integer;
var AA,BB,H,K,P,U,V,Z:byte;
var AAA,BBB,CC,XX:string;

begin
   for N:= 1 to length(AAAA) do
      if copy(AAAA,N,1)<>'0' then
      begin
         AAAA:= copy(AAAA,N,length(AAAA)-N+1);
         break;
      end;

   E:=0;
   K:= ansipos('.',AAAA);
   if K= 0 then
   begin
      AAA:= AAAA;
      E:= length(AAA);
   end;

   if K= 1 then
      for N:= 2 to length(AAAA) do
         if copy(AAAA,N,1)<>'0' then
         begin
            AAA:= copy(AAAA,N,length(AAAA)-N+1);
            E:= 2-N;
            break;
         end;

   if K>= 2 then
   begin
      AAA:= copy(AAAA,1,K-1)+copy(AAAA,K+1,length(AAAA)-K);
      E:= K-1;
   end;

   for N:= 1 to length(BBBB) do
      if copy(BBBB,N,1)<>'0' then
      begin
         BBBB:= copy(BBBB,N,length(BBBB)-N+1);
         break;
      end;

   F:=0;
   K:= ansipos('.',BBBB);
   if K= 0 then
   begin
      BBB:= BBBB;
      F:= length(BBB);
   end;

   if K= 1 then
      for N:= 2 to length(BBBB) do
         if copy(BBBB,N,1)<>'0' then
         begin
            BBB:= copy(BBBB,N,length(BBBB)-N+1);
            F:= 2-N;
            break;
         end;

   if K>= 2 then
   begin
      BBB:= copy(BBBB,1,K-1)+copy(BBBB,K+1,length(BBBB)-K);
      F:= K-1;
   end;

   G:= E-F+1;
   AA:= length(AAA);
   BB:= length(BBB);
   T:= AA-BB+1;

   for N:=1 to 202 do
   begin
      A[N]:= 0; B[N]:= 0;
   end;

   for N:=1 to 1202 do
   begin
      C[N]:= 0;
   end;

   for N:=1 to 1000 do
   begin
      X[N]:= 0;
   end;

   for N:=1 to AA do
      C[N]:= strtoint(copy(AAA,N,1));

   for N:=1 to BB do
      A[N]:= C[BB-N+1];

   for N:=1 to BB do
      B[N]:= strtoint(copy(BBB,BB-N+1,1));

   S:= 0;

   repeat
      P:= 0;
      repeat
         Z:= 0;
         if A[BB+1]<>0 then
         begin
            Q:= 1;
            for N:=1 to BB+1 do
            begin
               D:= 10+A[N]-1+Q-B[N];
               A[N]:= D mod 10;
               Q:= D div 10;
            end;

            P:= P+1;
         end
         else
         begin
            V:= 0;
            for N:=BB downto 1 do
            begin
               if B[N]<A[N] then
               begin
                  V:= 1;
                  Q:= 1;
                  for J:=1 to BB do
                  begin
                     D:= 10+A[J]-1+Q-B[J];
                     A[J]:= D mod 10;
                     Q:= D div 10;
                  end;

                  P:= P+1;
                  break;
               end
               else if B[N]>A[N] then
               begin
                  V:= 1;
                  S:= S+1;
                  X[S]:= P;
                  if S= ketasuu then
                  begin
                     Z:= 2;
                     break;
                  end;

                  if (T<=0) or ((T>0) and (S>=T)) then
                  begin
                     U:=0;
                     for J:=BB downto 1 do
                        if A[J]<>0 then
                        begin
                           U:=1;
                           break;
                        end;

                     if U=0 then
                     begin
                        Z:= 2;
                        break;
                     end;

                     for J:=BB downto 1 do
                        A[J+1]:= A[J];

                     A[1]:= C[BB+S];
                     Z:= 1;
                  end
                  else
                  begin
                     for J:=BB downto 1 do
                        A[J+1]:= A[J];

                     A[1]:= C[BB+S];
                     Z:= 1;
                  end;
                  break;
               end;
            end;

            if V=0 then
            begin
               P:= P+1;
               for N:=BB downto 1 do
                  A[N]:= 0;

            end;
         end;
         if (Z=1) or (Z=2) then break;
      until S=-1;
      if Z=2 then break;
   until S=-1;

   XX:='';
   for N:= 1 to S do
      XX:= XX+inttostr(X[N]);

   if (G>0) and (S=G) then
   begin
      YY:= XX;
      if copy(YY,1,1)='0' then YY:= copy(YY,2,S-1);
   end;

   if (G>0) and (S<G) then
   begin
      YY:= XX+stringofchar('0',G-S);
      if copy(YY,1,1)='0' then YY:= copy(YY,2,G-1);
   end;

   if (G>0) and (S>G) then
   begin
      YY:= copy(XX,1,G)+'.'+copy(XX,G+1,BB-1+S-G);
      if G<>1 then
         if copy(YY,1,1)='0' then YY:= copy(YY,2,BB-1+S);
   end;

   if G<=0 then
      YY:= '0.'+stringofchar('0',-G)+XX;
end;

procedure WARU(A:array of byte; B:integer; var X:array of byte; ketasuu:integer);
//割り算のサブプロシージャ   A/B=X
var D,K,N,RR:integer;
var C:string;

begin
   K:=length(inttostr(B));
   C:='';
   for N:=1 to K do
      C:=C+inttostr(A[N]);

   D:=strtoint(C);

   for N:=0 to ketasuu do
      X[N]:=0;
      
   for N:=0 to ketasuu-1-k do
   begin
      X[K+N]:=D div B;
      RR:=D-B*X[K+N];
      D:=RR*10+A[K+1+N];
   end;
end;

procedure TASU(A,B:array of byte; var X:array of byte; ketasuu:integer);
//足し算のサブプロシージャ   A+B=X
var C,N,Q:integer;
begin
   for N:=0 to ketasuu do
      X[N]:=0;

   Q:=0;
   for N:=ketasuu downto 0 do
   begin
      C:=A[N]+B[N]+Q;
      X[N]:=C mod 10;
      Q:=C div 10;
   end;
end;

procedure HIKU(A,B:array of byte; var X:array of byte; ketasuu:integer);
//引き算のサブプロシージャ   A-B=X
var C,N,Q:integer;
begin
   for N:=0 to ketasuu do
      X[N]:=0;

   Q:=1;
   for N:=ketasuu downto 1 do
   begin
      C:=10+A[N]-1+Q-B[N];
      X[N]:=C mod 10;
      Q:=C div 10;
   end;
end;

procedure Tfrm_yuurisuubeki2.Button1Click(Sender: TObject);
var AAA,BBB,E,V,WWW,XXX,ZZZ:array of byte;
var AA,BB,F,J,K,L,LL,M,N,NN,ketakazu:integer;
var TEI,C,D:extended;
var G,H,I,Q,T,U:byte;
var A,B,CC,II,P,PP,PPP,PPPP,R,RR,RRR,RRRR,S,SS,SSS,SSSS,SSSSS,TT,TTT,VV,W,WW,X,X1,X2,XX,XX1,XX2,XXXX,Y,YY,YYY,YYYY,Z,ZZ,ZZZZ:string;
var file1:textfile;
label jmp1;

begin
   if BLN=true then
      BLN:=false
   else
   begin
      BLN:=true;
      Memo3.Clear;
      application.ProcessMessages;

      if Edit1.text='' then
      begin
         beep;
         showmessage('底 A には半角数字で20桁以内の正の数を入力してください。');
         Edit1.SetFocus;
         BLN:=false;
         exit;
      end;

      H:= length(Edit1.text);
      K:= ansipos('.',Edit1.text);

      if K=0 then
      begin
         if H>20 then
         begin
            beep;
            showmessage('底 A には半角数字で20桁以内の正の数を入力してください。');
            Edit1.SetFocus;
            BLN:=false;
            exit;
         end;
      end
      else
      begin
         if K=1 then
         begin
            if H>20 then
            begin
               beep;
               showmessage('底 A には位取り表示のための 0 も含めて半角数字で20桁以内の正の数を入力してください。');
               Edit1.SetFocus;
               BLN:=false;
               exit;
            end;
         end
         else
         begin
            if H>21 then
            begin
               beep;
               showmessage('底 A には位取り表示のための 0 も含めて半角数字で20桁以内の正の数を入力してください。');
               Edit1.SetFocus;
               BLN:=false;
               exit;
            end;
         end;
      end;

      if K=0 then
         CC:= Edit1.text
      else
         CC:= copy(Edit1.text,1,K-1)+copy(Edit1.text,K+1,H-K);

      for N:=1 to length(CC) do
         if (ansicomparestr(copy(CC,N,1),'0')<0) or (ansicomparestr(copy(CC,N,1),'9')>0) then
         begin
            beep;
            showmessage('底 A には半角数字で20桁以内の正の数を入力してください。');
            Edit1.SetFocus;
            BLN:=false;
            exit;
         end;

      if StrToFloat(Edit1.text)<=0 then
      begin
         beep;
         showmessage('底 A には半角数字で20桁以内の正の数を入力してください。');
         Edit1.SetFocus;
         BLN:=false;
         exit;
      end;

      if (Edit2.text='') or (Edit2.text='-') or (Edit2.text='.') or (Edit2.text='-.') then
      begin
         beep;
         showmessage('指数 B には半角数字で20桁以内で -5000以上 5000以下の数を入力してください。');
         Edit2.SetFocus;
         BLN:=false;
         exit;
      end;

      H:= length(Edit2.text);
      if copy(Edit2.text,1,1)='-' then CC:= copy(Edit2.text,2,H-1) else CC:= Edit2.text;

      H:= length(CC);
      K:= ansipos('.',CC);

      if K=0 then
      begin
         if H>20 then
         begin
            beep;
            showmessage('指数 B には半角数字で20桁以内で -5000以上 5000以下の数を入力してください。');
            Edit2.SetFocus;
            BLN:=false;
            exit;
         end;
      end
      else
      begin
         if K=1 then
         begin
            if H>20 then
            begin
               beep;
               showmessage('指数 B には位取り表示のための 0 も含めて半角数字で20桁以内で -5000以上 5000以下の数 を入力してください。');
               Edit2.SetFocus;
               BLN:=false;
               exit;
            end;
         end
         else
         begin
            if H>21 then
            begin
               beep;
               showmessage('指数 B には位取り表示のための 0 も含めて半角数字で20桁以内で -5000以上 5000以下の数 を入力してください。');
               Edit2.SetFocus;
               BLN:=false;
               exit;
            end;
         end;
      end;

      if K<>0 then CC:= copy(CC,1,K-1)+copy(CC,K+1,H-K);

      for N:=1 to length(CC) do
         if (ansicomparestr(copy(CC,N,1),'0')<0) or (ansicomparestr(copy(CC,N,1),'9')>0) then
         begin
            beep;
            showmessage('指数 B には半角数字で -5000以上 5000以下の数を入力してください。');
            Edit2.SetFocus;
            BLN:=false;
            exit;
         end;

      if (strtofloat(Edit2.text)<-5000) or (strtofloat(Edit2.text)>5000) then
      begin
         beep;
         showmessage('指数 B には半角数字で -5000以上 5000以下の数を入力してください。');
         Edit2.SetFocus;
         BLN:=false;
         exit;
      end;

      TEI:= StrToFloat(Edit1.text);

      if TEI=1 then
      begin
         XXXX:= '1';
         goto jmp1;
      end;

      if StrToFloat(Edit2.text)=1 then
      begin
         XXXX:= Edit1.text;
         goto jmp1;
      end;

      if copy(Edit2.text,1,1)='-' then
      begin
         S:= copy(Edit2.text,2,length(Edit2.text)-1);
      end
      else
      begin
         S:= Edit2.text;
      end;

      if StrToFloat(S)=0 then
      begin
         XXXX:= '1';
         goto jmp1;
      end;

      K:= ansipos('.',S);

      if K=0 then
      begin
         RRRR:= '0';
      end
      else
      begin
         if K=1 then
         begin
            RRRR:= '0'+S;
         end
         else
         begin
            RRRR:= '0'+copy(S,K,length(S)-K+1);
         end;
      end;

      if K=0 then
      begin
         T:= 1;
      end
      else
      begin
         T:= 2;
         for N:=1 to K-1 do
         begin
            if copy(S,N,1)<>'0' then
            begin
               T:= 1;
               for J:=K+1 to length(S) do
               begin
                  if copy(S,J,1)<>'0' then
                  begin
                     T:= 3;
                     break;
                  end;
               end;
            end;

            if T<>2 then break;
         end;
      end;

      if T=1 then    // S(指数の絶対値)が自然数のとき
      begin
         Memo1.Visible:=true;
         Memo2.Visible:=true;
         Memo2.Clear;
         Button1.Caption:='計算中止';
         Button2.Visible:=false;
         application.ProcessMessages;

         for N:=1 to length(Edit1.text) do
         begin
            if copy(Edit1.text,N,1)<>'0' then break;
         end;

         if copy(Edit1.text,N,1)='.' then
         begin
            if N=1 then
            begin
               SS:= '0'+Edit1.text;
            end
            else
            begin
               SS:= copy(Edit1.text,N-1,length(Edit1.text)-N+2);
            end;
         end
         else
         begin
            SS:= copy(Edit1.text,N,length(Edit1.text)-N+1);
         end;

         for N:=length(SS) downto 1 do
         begin
            if copy(SS,N,1)<>'0' then break;
         end;

         L:= ansipos('.',SS);

         if L<>0 then
         begin
            if copy(SS,N,1)='.' then
            begin
               SS:= copy(SS,1,N-1);
            end
            else
            begin
               SS:= copy(SS,1,N);
            end;
         end;

         L:= ansipos('.',SS);

         if L= 0 then
         begin
            SSS:= SS;
         end
         else
         begin
            SSS:= copy(SS,1,L-1)+copy(SS,L+1,length(SS)-L);
         end;

         for N:=length(SSS) downto 1 do
         begin
            if copy(SSS,N,1)<>'0' then break;
         end;

         G:= length(SSS)-N;
         SSSS:= copy(SSS,1,N);

         if copy(SSSS,1,1)='0' then
         begin
            Q:= length(SSSS)-1;
         end
         else
         begin
            Q:= 0;
         end;

         for N:=1 to length(SSSS) do
         begin
            if copy(SSSS,N,1)<>'0' then break;
         end;

         SSSSS:= copy(SSSS,N,length(SSSS)-N+1);

         A:= '1';
         B:= SSSSS;

         AA:=length(A);
         BB:=length(B);
         setlength(AAA,AA+1);
         setlength(BBB,BB+1);
         setlength(XXX,AA+BB+1);

         for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
         for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

         K:= ansipos('.',S);

         if K=0 then
         begin
            J:= strtoint(S);
         end
         else
         begin
            J:= strtoint(copy(S,1,K-1));
         end;

         M:=1;

         while (M<=J) and (BLN=true) do
         begin
            Memo2.Lines.Strings[0]:= inttostr(M);
            setlength(XXX,AA+BB+1);
            KAKERU(AAA,BBB,XXX,AA,BB);
            setlength(AAA,AA+1);
            for N:= 1 to AA do AAA[N]:= XXX[N];
            M:= M+1;
            application.ProcessMessages;
         end;

         if BLN=false then
         begin
            Memo2.Clear;
            Memo1.Visible:=false;
            Memo2.Visible:=false;
            Button1.Caption:='計算開始';
            Button2.Visible:=true;
            exit;
         end;

         PP:='';
         for N:= AA downto 1 do PP:=PP+inttostr(XXX[N]);

         if G<>0 then
         begin
            PPP:= PP+StringOfChar('0',G*J);
         end;

         if Q<>0 then
         begin
            PPP:= '0.'+StringOfChar('0',Q*J-AA)+PP;
         end;

         if (G=0) and (Q=0) then
         begin
            if L=0 then
            begin
               PPP:= PP;
            end
            else
            begin
               PPP:= copy(PP,1,AA-(length(SS)-L)*J)+'.'+copy(PP,AA-(length(SS)-L)*J+1,(length(SS)-L)*J);
            end
         end;

         LL:= ansipos('.',PPP);

         if LL=0 then
         begin
            NN:= length(PPP);
         end
         else
         begin
            NN:= length(PPP)-1;
         end;

         ketakazu:= 150;

         if TEI>1 then
         begin
            if L=0 then
            begin
               XX:= copy(PPP,1,1)+'.'+copy(PPP,2,ketakazu-1)+'E'+IntToStr(NN-1);
            end
            else
            begin
               XX:= copy(PP,1,1)+'.'+copy(PP,2,ketakazu-1)+'E'+IntToStr(AA-(length(SS)-L)*J-1);
            end;
         end
         else
         begin
            XX:= copy(PP,1,1)+'.'+copy(PP,2,ketakazu-1)+'E-'+IntToStr(Q*J-AA+1);
         end;

      end;

      if T=2 then    // S(指数の絶対値)の整数部分が0で、小数部分RRRRが0でないとき、即ち、0<S<1 のとき
      begin
         ketakazu:= 100;

         for N:=1 to length(Edit1.text) do
         begin
            if copy(Edit1.text,N,1)<>'0' then break;
         end;

         if copy(Edit1.text,N,1)='.' then
         begin
            if N=1 then
            begin
               R:= '0'+Edit1.text;
            end
            else
            begin
               R:= copy(Edit1.text,N-1,length(Edit1.text)-N+2);
            end;
         end
         else
         begin
            R:= copy(Edit1.text,N,length(Edit1.text)-N+1);
         end;

         for N:=length(R) downto 1 do
         begin
            if copy(R,N,1)<>'0' then break;
         end;

         L:= ansipos('.',R);
         if L<>0 then
         begin
            if copy(R,N,1)='.' then
            begin
               R:= copy(R,1,N-1);
            end
            else
            begin
               R:= copy(R,1,N);
            end;
         end;

         L:= ansipos('.',R);

         if L=0 then
         begin
            RR:= copy(R,1,1)+'.'+copy(R,2,length(R)-1);
            RRR:= IntToStr(length(R)-1)+'.'+StringOfChar('0',ketakazu);
         end
         else
         begin
            if copy(R,1,1)='0' then
            begin
               for N:=1 to length(R) do
               begin
                  if (copy(R,N,1)<>'0') and (copy(R,N,1)<>'.') then break;
               end;

               RR:= copy(R,N,1)+'.'+copy(R,N+1,length(R)-N);
               RRR:= IntToStr(N-2)+'.'+StringOfChar('0',ketakazu);
            end
            else
            begin
               if L=2 then
               begin
                  RR:= R;
                  RRR:= IntToStr(0)+'.'+StringOfChar('0',ketakazu);
               end
               else
               begin
                  RR:= copy(R,1,1)+'.'+copy(R,2,L-2)+copy(R,L+1,length(R)-L);
                  RRR:= IntToStr(L-2)+'.'+StringOfChar('0',ketakazu);
               end;
            end;
         end;

         II:= '1.0000000000000000000000';

         K:= ansipos('.',RR);
         L:= ansipos('.',II);
         if K<L then RR:= StringOfChar('0',L-K)+RR;
         if K>L then II:= StringOfChar('0',K-L)+II;
         K:= ansipos('.',RR);
         ZZ:= copy(RR,1,K-1)+copy(RR,K+1,length(RR)-K);
         WW:= copy(II,1,K-1)+copy(II,K+1,length(II)-K);

         if length(ZZ)<length(WW) then
         begin
            U:= length(ZZ);
         end
         else
         begin
            U:= length(WW);
         end;

         setlength(ZZZ,U+1);
         setlength(WWW,U+1);
         setlength(XXX,U+1);
         for N:=1 to U do ZZZ[N]:= strtoint(copy(ZZ,N,1));
         for N:=1 to U do WWW[N]:= strtoint(copy(WW,N,1));
         HIKU(ZZZ,WWW,XXX,U);
         ZZZZ:= '';
         for N:=1 to U do ZZZZ:=ZZZZ+IntToStr(XXX[N]);
         WW:= copy(ZZZZ,1,K-1)+'.'+copy(ZZZZ,K,U-K+1);

         for N:=1 to length(WW) do
         begin
            if copy(WW,N,1)<>'0' then break;
         end;

         if copy(WW,N,1)='.' then
         begin
            SS:= copy(WW,N-1,length(WW)-N+2);
         end
         else
         begin
            SS:= copy(WW,N,length(WW)-N+1);
         end;

         K:= ansipos('.',RR);
         L:= ansipos('.',II);
         if K<L then RR:= StringOfChar('0',L-K)+RR;
         if K>L then II:= StringOfChar('0',K-L)+II;
         K:= ansipos('.',RR);
         ZZ:= copy(RR,1,K-1)+copy(RR,K+1,length(RR)-K);
         WW:= copy(II,1,K-1)+copy(II,K+1,length(II)-K);

         if length(ZZ)<length(WW) then
         begin
            U:= length(ZZ);
         end
         else
         begin
            U:= length(WW);
         end;

         setlength(ZZZ,U+1);
         setlength(WWW,U+1);
         setlength(XXX,U+1);
         for N:=1 to U do ZZZ[N]:= strtoint(copy(ZZ,N,1));
         for N:=1 to U do WWW[N]:= strtoint(copy(WW,N,1));

         TASU(ZZZ,WWW,XXX,U);
         ZZZZ:= '';
         for N:=0 to U do ZZZZ:=ZZZZ+IntToStr(XXX[N]);

         if XXX[0]=1 then
         begin
            TT:= copy(ZZZZ,1,K)+'.'+copy(ZZZZ,K+1,U-K+1);
         end
         else
         begin
            TT:= copy(ZZZZ,2,K-1)+'.'+copy(ZZZZ,K+1,U-K+1);
         end;

         WARIZAN(SS, TT, YY, ketakazu);
         P:= YY;

         K:= ansipos('.',P);
         if K= 0 then
            A:= P
         else
            A:= copy(P,1,K-1)+copy(P,K+1,length(P)-K);

         B:=A;
         AA:=length(A);
         BB:=length(B);
         setlength(AAA,AA+1);
         setlength(BBB,BB+1);

         for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
         for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

         setlength(XXX,AA+BB+1);
         KAKERU(AAA,BBB,XXX,AA,BB);
         PP:='';
         for N:=AA downto 1 do PP:=PP+inttostr(XXX[N]);
         setlength(E,ketakazu+3);
         setlength(V,ketakazu+3);

         if length(PP)<ketakazu+2 then
         begin
            for N:=1 to length(PP) do E[N]:= strtoint(copy(PP,N,1));
         end
         else
         begin
            for N:=1 to ketakazu+2 do E[N]:= strtoint(copy(PP,N,1));
         end;

         WARU(E,3,V,ketakazu+2);

         V[1]:= 1;
         setlength(ZZZ,ketakazu+1);
         for N:=1 to ketakazu do ZZZ[N]:= V[N];
         PPPP:= PP;

         M:= 5;
         while M>0 do
         begin
            A:=copy(PPPP,1,ketakazu);
            B:=copy(PP,1,ketakazu);
            AA:=length(A);
            BB:=length(B);
            setlength(AAA,AA+1);
            setlength(BBB,BB+1);

            for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
            for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

            setlength(XXX,AA+BB+1);
            KAKERU(AAA,BBB,XXX,AA,BB);
            PPPP:='';
            for N:=AA downto 1 do PPPP:=PPPP+inttostr(XXX[N]);
            setlength(E,ketakazu+3);
            setlength(V,ketakazu+3);

            if length(PPPP)<ketakazu+2 then
            begin
               for N:=1 to length(PPPP) do E[N]:= strtoint(copy(PPPP,N,1));
            end
            else
            begin
               for N:=1 to ketakazu+2 do E[N]:= strtoint(copy(PPPP,N,1));
            end;

            WARU(E,M,V,ketakazu+2);
            I:=0;
            for N:=1 to ketakazu do
            begin
               if V[N]<>0 then
               begin
                  I:=1;
                  break;
               end;
            end;

            if I=0 then break;

            setlength(XXX,ketakazu+1);
            TASU(ZZZ,V,XXX,ketakazu);
            for N:=1 to ketakazu do ZZZ[N]:= XXX[N];
            Z:= '';
            for N:=1 to ketakazu do Z:= Z+inttostr(ZZZ[N]);
            M:= M+2;
         end;

         K:= ansipos('.',P);
         if K= 0 then
            A:= P
         else
            A:= copy(P,1,K-1)+copy(P,K+1,length(P)-K);

         B:=Z;
         AA:=length(A);
         BB:=length(B);
         setlength(AAA,AA+1);
         setlength(BBB,BB+1);

         for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
         for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

         setlength(XXX,AA+BB+1);
         KAKERU(AAA,BBB,XXX,AA,BB);
         Y:='';
         for N:=AA downto 1 do Y:=Y+inttostr(XXX[N]);

         A:=Y;
         B:='2';
         AA:=length(A);
         BB:=length(B);
         setlength(AAA,AA+1);
         setlength(BBB,BB+1);

         for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
         for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

         setlength(XXX,AA+BB+1);
         KAKERU(AAA,BBB,XXX,AA,BB);
         Y:='';
         for N:=AA downto 1 do Y:=Y+inttostr(XXX[N]);
         YY:= copy(Y,1,1)+'.'+copy(Y,2,ketakazu);

         TTT:= '2.302585092994045684017991454684364207601101488628772976033327900967572609677352480235997205089598298';
         WARIZAN(YY, TTT, YYY, ketakazu);

         if StrToFloat(R)>1 then
         begin
            K:= ansipos('.',YYY);
            L:= ansipos('.',RRR);
            if K<L then YYY:= StringOfChar('0',L-K)+YYY;
            if K>L then RRR:= StringOfChar('0',K-L)+RRR;
            K:= ansipos('.',YYY);
            ZZ:= copy(YYY,1,K-1)+copy(YYY,K+1,length(YYY)-K);
            WW:= copy(RRR,1,K-1)+copy(RRR,K+1,length(RRR)-K);

            if length(ZZ)<length(WW) then
            begin
               U:= length(ZZ);
            end
            else
            begin
               U:= length(WW);
            end;

            setlength(ZZZ,U+1);
            setlength(WWW,U+1);
            setlength(XXX,U+1);
            for N:=1 to U do ZZZ[N]:= strtoint(copy(ZZ,N,1));
            for N:=1 to U do WWW[N]:= strtoint(copy(WW,N,1));

            TASU(ZZZ,WWW,XXX,U);
            ZZZZ:= '';
            for N:=0 to U do ZZZZ:=ZZZZ+IntToStr(XXX[N]);

            if XXX[0]=1 then
            begin
               Z:= copy(ZZZZ,1,K)+'.'+copy(ZZZZ,K+1,U-K+1);
            end
            else
            begin
               Z:= copy(ZZZZ,2,K-1)+'.'+copy(ZZZZ,K+1,U-K+1);
            end;
         end
         else
         begin
            K:= ansipos('.',RRR);
            L:= ansipos('.',YYY);
            if K<L then RRR:= StringOfChar('0',L-K)+RRR;
            if K>L then YYY:= StringOfChar('0',K-L)+YYY;
            K:= ansipos('.',RRR);
            ZZ:= copy(RRR,1,K-1)+copy(RRR,K+1,length(RRR)-K);
            WW:= copy(YYY,1,K-1)+copy(YYY,K+1,length(YYY)-K);

            if length(ZZ)<length(WW) then
            begin
               U:= length(ZZ);
            end
            else
            begin
               U:= length(WW);
            end;

            setlength(ZZZ,U+1);
            setlength(WWW,U+1);
            setlength(XXX,U+1);
            for N:=1 to U do ZZZ[N]:= strtoint(copy(ZZ,N,1));
            for N:=1 to U do WWW[N]:= strtoint(copy(WW,N,1));
            HIKU(ZZZ,WWW,XXX,U);
            ZZZZ:= '';
            for N:=1 to U do ZZZZ:=ZZZZ+IntToStr(XXX[N]);
            WW:= copy(ZZZZ,1,K-1)+'.'+copy(ZZZZ,K,U-K+1);

            for N:=1 to length(WW) do
            begin
               if copy(WW,N,1)<>'0' then break;
            end;

            if copy(WW,N,1)='.' then
            begin
               XX:= copy(WW,N-1,length(WW)-N+2);
            end
            else
            begin
               XX:= copy(WW,N,length(WW)-N+1);
            end;

            Z:= XX;
         end;

         // ここまでで底の常用対数の絶対値を求めた

         K:= ansipos('.',TTT);
         A:= copy(TTT,1,K-1)+copy(TTT,K+1,length(TTT)-K);

         L:= ansipos('.',Z);
         if L= 0 then
            B:= Z
         else
            B:= copy(Z,1,L-1)+copy(Z,L+1,length(Z)-L);

         AA:=length(A);
         BB:=length(B);
         setlength(AAA,AA+1);
         setlength(BBB,BB+1);

         for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
         for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

         setlength(XXX,AA+BB+1);
         KAKERU(AAA,BBB,XXX,AA,BB);
         PP:='';
         for N:=AA downto 1 do PP:=PP+inttostr(XXX[N]);

         if (K<>0) and (L<>0) then
         begin
            F:= AA-length(TTT)-length(Z)+K+L;
         end
         else
         begin
            if (K<>0) and (L=0)  then
            begin
               F:= AA-length(TTT)+K;
            end
            else
            begin
               if (K=0)  and (L<>0) then
               begin
                  F:= AA-length(Z)+L;
               end
               else
               begin
                  F:= AA;
               end;
            end;
         end;

         PPP:= copy(PP,1,F)+'.'+copy(PP,F+1,AA-F);
         K:= ansipos('.',PPP);
         YY:= copy(PPP,1,K)+copy(PPP,K+1,ketakazu);

         // ここまでで底の自然対数の絶対値を求めた

         K:= ansipos('.',RRRR);
         if K= 0 then
            A:= RRRR
         else
            A:= copy(RRRR,1,K-1)+copy(RRRR,K+1,length(RRRR)-K);

         L:= ansipos('.',YY);
         if L= 0 then
            B:= YY
         else
            B:= copy(YY,1,L-1)+copy(YY,L+1,length(YY)-L);

         AA:=length(A);
         BB:=length(B);
         setlength(AAA,AA+1);
         setlength(BBB,BB+1);

         for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
         for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

         setlength(XXX,AA+BB+1);
         KAKERU(AAA,BBB,XXX,AA,BB);
         Y:='';
         for N:=AA downto 1 do Y:=Y+inttostr(XXX[N]);

         if (K<>0) and (L<>0) then F:= AA-length(RRRR)-length(YY)+K+L;
         if (K<>0) and (L=0)  then F:= AA-length(RRRR)+K;
         if (K=0)  and (L<>0) then F:= AA-length(YY)+L;
         if (K=0)  and (L=0)  then F:= AA;

         YYY:= copy(Y,1,F)+'.'+copy(Y,F+1,AA-F);

         if TEI>1 then
         begin
            Z:='1.0'+StringOfChar('0',ketakazu);
            K:= ansipos('.',Z);
            L:= ansipos('.',YYY);
            if K<L then Z:= StringOfChar('0',L-K)+Z;
            if K>L then YYY:= StringOfChar('0',K-L)+YYY;
            K:= ansipos('.',Z);
            ZZ:= copy(Z,1,K-1)+copy(Z,K+1,length(Z)-K);
            WW:= copy(YYY,1,K-1)+copy(YYY,K+1,length(YYY)-K);

            if length(ZZ)<length(WW) then
            begin
               U:= length(ZZ);
            end
            else
            begin
               U:= length(WW);
            end;

            setlength(ZZZ,U+1);
            setlength(WWW,U+1);
            setlength(XXX,U+1);
            for N:=1 to U do ZZZ[N]:= strtoint(copy(ZZ,N,1));
            for N:=1 to U do WWW[N]:= strtoint(copy(WW,N,1));

            TASU(ZZZ,WWW,XXX,U);
            ZZZZ:= '';
            for N:=0 to U do ZZZZ:=ZZZZ+IntToStr(XXX[N]);

            if XXX[0]=1 then
            begin
               Z:= copy(ZZZZ,1,K)+'.'+copy(ZZZZ,K+1,U-K+1);
            end
            else
            begin
               Z:= copy(ZZZZ,2,K-1)+'.'+copy(ZZZZ,K+1,U-K+1);
            end;

            W:= YYY;

            M:= 2;
            while M>0 do
            begin
               K:= ansipos('.',W);
               if K= 0 then
                  A:= W
               else
                  A:= copy(W,1,K-1)+copy(W,K+1,length(W)-K);

               L:= ansipos('.',YYY);
               if L= 0 then
                  B:= YYY
               else
                  B:= copy(YYY,1,L-1)+copy(YYY,L+1,length(YYY)-L);

               AA:=length(A);
               BB:=length(B);
               setlength(AAA,AA+1);
               setlength(BBB,BB+1);

               for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
               for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

               setlength(XXX,AA+BB+1);
               KAKERU(AAA,BBB,XXX,AA,BB);
               PPPP:='';
               for N:=AA downto 1 do PPPP:=PPPP+inttostr(XXX[N]);
               F:= AA-length(W)-length(YYY)+K+L;
               setlength(E,ketakazu+3);
               setlength(V,ketakazu+3);

               if length(PPPP)<ketakazu+2 then
               begin
                  for N:=1 to length(PPPP) do E[N]:= strtoint(copy(PPPP,N,1));
               end
               else
               begin
                  for N:=1 to ketakazu+2 do E[N]:= strtoint(copy(PPPP,N,1));
               end;

               WARU(E,M,V,ketakazu+2);
               I:=0;
               for N:=1 to ketakazu do
               begin
                  if V[N]<>0 then
                  begin
                     I:=1;
                     break;
                  end;
               end;

               if I=0 then break;

               Y:= '';
               for N:=1 to ketakazu do Y:= Y+inttostr(V[N]);
               WW:= copy(Y,1,F)+'.'+copy(Y,F+1,ketakazu-F);
               for N:=1 to length(WW) do
               begin
                  if copy(WW,N,1)<>'0' then break;
               end;

               if copy(WW,N,1)='.' then
               begin
                  W:= copy(WW,N-1,length(WW)-N+2);
               end
               else
               begin
                  W:= copy(WW,N,length(WW)-N+1);
               end;

               K:= ansipos('.',Z);
               L:= ansipos('.',W);
               if K<L then Z:= StringOfChar('0',L-K)+Z;
               if K>L then W:= StringOfChar('0',K-L)+W;
               K:= ansipos('.',Z);
               ZZ:= copy(Z,1,K-1)+copy(Z,K+1,length(Z)-K);
               WW:= copy(W,1,K-1)+copy(W,K+1,length(W)-K);

               if length(ZZ)<length(WW) then
               begin
                  U:= length(ZZ);
               end
               else
               begin
                  U:= length(WW);
               end;

               setlength(ZZZ,U+1);
               setlength(WWW,U+1);
               setlength(XXX,U+1);
               for N:=1 to U do ZZZ[N]:= strtoint(copy(ZZ,N,1));
               for N:=1 to U do WWW[N]:= strtoint(copy(WW,N,1));

               TASU(ZZZ,WWW,XXX,U);
               ZZZZ:= '';
               for N:=0 to U do ZZZZ:=ZZZZ+IntToStr(XXX[N]);

               if XXX[0]=1 then
               begin
                  Z:= copy(ZZZZ,1,K)+'.'+copy(ZZZZ,K+1,U-K+1);
               end
               else
               begin
                  Z:= copy(ZZZZ,2,K-1)+'.'+copy(ZZZZ,K+1,U-K+1);
               end;

               M:= M+1;
            end;

            for N:=1 to length(Z) do
            begin
               if copy(Z,N,1)<>'0' then break;
            end;

            if copy(Z,N,1)='.' then
            begin
               XX:= copy(Z,N-1,length(Z)-N+2);
            end
            else
            begin
               XX:= copy(Z,N,length(Z)-N+1);
            end;
         end;

         if TEI<1 then
         begin
            L:= ansipos('.',YYY);
            if L= 0 then
               A:= YYY
            else
               A:= copy(YYY,1,L-1)+copy(YYY,L+1,length(YYY)-L);

            B:= A;
            AA:=length(A);
            BB:=length(B);
            setlength(AAA,AA+1);
            setlength(BBB,BB+1);

            for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
            for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

            setlength(XXX,AA+BB+1);
            KAKERU(AAA,BBB,XXX,AA,BB);
            PPPP:='';
            for N:=AA downto 1 do PPPP:=PPPP+inttostr(XXX[N]);
            F:= AA-length(YYY)-length(YYY)+L+L;
            YYYY:= copy(PPPP,1,F)+'.'+copy(PPPP,F+1,ketakazu-F);
            setlength(E,ketakazu+3);
            setlength(V,ketakazu+3);

            if length(PPPP)<ketakazu+2 then
            begin
               for N:=1 to length(PPPP) do E[N]:= strtoint(copy(PPPP,N,1));
            end
            else
            begin
               for N:=1 to ketakazu+2 do E[N]:= strtoint(copy(PPPP,N,1));
            end;

            WARU(E,2,V,ketakazu+2);
            Y:= '';
            for N:=1 to ketakazu do Y:= Y+inttostr(V[N]);
            WW:= copy(Y,1,F)+'.'+copy(Y,F+1,ketakazu-F);
            for N:=1 to length(WW) do
            begin
               if copy(WW,N,1)<>'0' then break;
            end;

            if copy(WW,N,1)='.' then
            begin
               W:= copy(WW,N-1,length(WW)-N+2);
            end
            else
            begin
               W:= copy(WW,N,length(WW)-N+1);
            end;

            Z:='1.0'+StringOfChar('0',ketakazu);
            K:= ansipos('.',Z);
            L:= ansipos('.',W);
            if K<L then Z:= StringOfChar('0',L-K)+Z;
            if K>L then W:= StringOfChar('0',K-L)+W;
            K:= ansipos('.',Z);
            ZZ:= copy(Z,1,K-1)+copy(Z,K+1,length(Z)-K);
            WW:= copy(W,1,K-1)+copy(W,K+1,length(W)-K);
            if length(ZZ)<length(WW) then
            begin
               U:= length(ZZ);
            end
            else
            begin
               U:= length(WW);
            end;

            setlength(ZZZ,U+1);
            setlength(WWW,U+1);
            setlength(XXX,U+1);
            for N:=1 to U do ZZZ[N]:= strtoint(copy(ZZ,N,1));
            for N:=1 to U do WWW[N]:= strtoint(copy(WW,N,1));

            TASU(ZZZ,WWW,XXX,U);
            ZZZZ:= '';
            for N:=0 to U do ZZZZ:=ZZZZ+IntToStr(XXX[N]);

            if XXX[0]=1 then
            begin
               Z:= copy(ZZZZ,1,K)+'.'+copy(ZZZZ,K+1,U-K+1);
            end
            else
            begin
               Z:= copy(ZZZZ,2,K-1)+'.'+copy(ZZZZ,K+1,U-K+1);
            end;

            M:= 3;
            while M>0 do
            begin
               K:= ansipos('.',W);
               if K= 0 then
                  A:= W
               else
                  A:= copy(W,1,K-1)+copy(W,K+1,length(W)-K);

               L:= ansipos('.',YYYY);
               if L= 0 then
                  B:= YYYY
               else
                  B:= copy(YYYY,1,L-1)+copy(YYYY,L+1,length(YYYY)-L);

               AA:=length(A);
               BB:=length(B);
               setlength(AAA,AA+1);
               setlength(BBB,BB+1);

               for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
               for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

               setlength(XXX,AA+BB+1);
               KAKERU(AAA,BBB,XXX,AA,BB);
               PPPP:='';
               for N:=AA downto 1 do PPPP:=PPPP+inttostr(XXX[N]);
               F:= AA-length(W)-length(YYYY)+K+L;
               setlength(E,ketakazu+3);
               setlength(V,ketakazu+3);

               if length(PPPP)<ketakazu+2 then
               begin
                  for N:=1 to length(PPPP) do E[N]:= strtoint(copy(PPPP,N,1));
               end
               else
               begin
                  for N:=1 to ketakazu+2 do E[N]:= strtoint(copy(PPPP,N,1));
               end;

               WARU(E,M,V,ketakazu+2);

               for N:=1 to ketakazu+2 do E[N]:= V[N];
               M:= M+1;

               WARU(E,M,V,ketakazu+2);

               I:=0;
               for N:=1 to ketakazu do
               begin
                  if V[N]<>0 then
                  begin
                     I:=1;
                     break;
                  end;
               end;

               if I=0 then break;

               Y:= '';
               for N:=1 to ketakazu do Y:= Y+inttostr(V[N]);
               WW:= copy(Y,1,F)+'.'+copy(Y,F+1,ketakazu-F);
               for N:=1 to length(WW) do
               begin
                  if copy(WW,N,1)<>'0' then break;
               end;

               if copy(WW,N,1)='.' then
               begin
                  W:= copy(WW,N-1,length(WW)-N+2);
               end
               else
               begin
                  W:= copy(WW,N,length(WW)-N+1);
               end;

               K:= ansipos('.',Z);
               L:= ansipos('.',W);
               if K<L then Z:= StringOfChar('0',L-K)+Z;
               if K>L then W:= StringOfChar('0',K-L)+W;
               K:= ansipos('.',Z);
               ZZ:= copy(Z,1,K-1)+copy(Z,K+1,length(Z)-K);
               WW:= copy(W,1,K-1)+copy(W,K+1,length(W)-K);

               if length(ZZ)<length(WW) then
               begin
                  U:= length(ZZ);
               end
               else
               begin
                  U:= length(WW);
               end;

               setlength(ZZZ,U+1);
               setlength(WWW,U+1);
               setlength(XXX,U+1);
               for N:=1 to U do ZZZ[N]:= strtoint(copy(ZZ,N,1));
               for N:=1 to U do WWW[N]:= strtoint(copy(WW,N,1));

               TASU(ZZZ,WWW,XXX,U);
               ZZZZ:= '';
               for N:=0 to U do ZZZZ:=ZZZZ+IntToStr(XXX[N]);

               if XXX[0]=1 then
               begin
                  Z:= copy(ZZZZ,1,K)+'.'+copy(ZZZZ,K+1,U-K+1);
               end
               else
               begin
                  Z:= copy(ZZZZ,2,K-1)+'.'+copy(ZZZZ,K+1,U-K+1);
               end;
               M:= M+1;
            end;

            XX1:= Z;

            Z:= YYY;
            W:= YYY;

            M:= 2;
            while M>0 do
            begin
               K:= ansipos('.',W);
               if K= 0 then
                  A:= W
               else
                  A:= copy(W,1,K-1)+copy(W,K+1,length(W)-K);

               L:= ansipos('.',YYYY);
               if L= 0 then
                  B:= YYYY
               else
                  B:= copy(YYYY,1,L-1)+copy(YYYY,L+1,length(YYYY)-L);

               AA:=length(A);
               BB:=length(B);
               setlength(AAA,AA+1);
               setlength(BBB,BB+1);

               for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
               for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

               setlength(XXX,AA+BB+1);
               KAKERU(AAA,BBB,XXX,AA,BB);
               PPPP:='';
               for N:=AA downto 1 do PPPP:=PPPP+inttostr(XXX[N]);
               F:= AA-length(W)-length(YYYY)+K+L;
               setlength(E,ketakazu+3);
               setlength(V,ketakazu+3);

               if length(PPPP)<ketakazu+2 then
               begin
                  for N:=1 to length(PPPP) do E[N]:= strtoint(copy(PPPP,N,1));
               end
               else
               begin
                  for N:=1 to ketakazu+2 do E[N]:= strtoint(copy(PPPP,N,1));
               end;

               WARU(E,M,V,ketakazu+2);

               for N:=1 to ketakazu+2 do E[N]:= V[N];
               M:= M+1;

               WARU(E,M,V,ketakazu+2);

               I:=0;
               for N:=1 to ketakazu do
               begin
                  if V[N]<>0 then
                  begin
                     I:=1;
                     break;
                  end;
               end;

               if I=0 then break;

               Y:= '';
               for N:=1 to ketakazu do Y:= Y+inttostr(V[N]);
               WW:= copy(Y,1,F)+'.'+copy(Y,F+1,ketakazu-F);
               for N:=1 to length(WW) do
               begin
                  if copy(WW,N,1)<>'0' then break;
               end;

               if copy(WW,N,1)='.' then
               begin
                  W:= copy(WW,N-1,length(WW)-N+2);
               end
               else
               begin
                  W:= copy(WW,N,length(WW)-N+1);
               end;

               K:= ansipos('.',Z);
               L:= ansipos('.',W);
               if K<L then Z:= StringOfChar('0',L-K)+Z;
               if K>L then W:= StringOfChar('0',K-L)+W;
               K:= ansipos('.',Z);
               ZZ:= copy(Z,1,K-1)+copy(Z,K+1,length(Z)-K);
               WW:= copy(W,1,K-1)+copy(W,K+1,length(W)-K);

               if length(ZZ)<length(WW) then
               begin
                  U:= length(ZZ);
               end
               else
               begin
                  U:= length(WW);
               end;

               setlength(ZZZ,U+1);
               setlength(WWW,U+1);
               setlength(XXX,U+1);
               for N:=1 to U do ZZZ[N]:= strtoint(copy(ZZ,N,1));
               for N:=1 to U do WWW[N]:= strtoint(copy(WW,N,1));

               TASU(ZZZ,WWW,XXX,U);
               ZZZZ:= '';
               for N:=0 to U do ZZZZ:=ZZZZ+IntToStr(XXX[N]);

               if XXX[0]=1 then
               begin
                  Z:= copy(ZZZZ,1,K)+'.'+copy(ZZZZ,K+1,U-K+1);
               end
               else
               begin
                  Z:= copy(ZZZZ,2,K-1)+'.'+copy(ZZZZ,K+1,U-K+1);
               end;
               M:= M+1;
            end;

            XX2:= Z;

            K:= ansipos('.',XX1);
            L:= ansipos('.',XX2);
            if K<L then XX1:= StringOfChar('0',L-K)+XX1;
            if K>L then XX2:= StringOfChar('0',K-L)+XX2;
            K:= ansipos('.',XX1);
            ZZ:= copy(XX1,1,K-1)+copy(XX1,K+1,length(XX1)-K);
            WW:= copy(XX2,1,K-1)+copy(XX2,K+1,length(XX2)-K);

            if length(ZZ)<length(WW) then
            begin
               U:= length(ZZ);
            end
            else
            begin
               U:= length(WW);
            end;

            setlength(ZZZ,U+1);
            setlength(WWW,U+1);
            setlength(XXX,U+1);
            for N:=1 to U do ZZZ[N]:= strtoint(copy(ZZ,N,1));
            for N:=1 to U do WWW[N]:= strtoint(copy(WW,N,1));

            HIKU(ZZZ,WWW,XXX,U);
            ZZZZ:= '';
            for N:=1 to U do ZZZZ:=ZZZZ+IntToStr(XXX[N]);
            Z:= copy(ZZZZ,1,K-1)+'.'+copy(ZZZZ,K,U-K+1);

            for N:=1 to length(Z) do
            begin
               if copy(Z,N,1)<>'0' then break;
            end;

            if copy(Z,N,1)='.' then
            begin
               XX:= copy(Z,N-1,length(Z)-N+2);
            end
            else
            begin
               XX:= copy(Z,N,length(Z)-N+1);
            end;
         end;
      end;

      if T=3 then    // S(指数の絶対値)の整数部分と小数部分RRRRとがともに0でないとき
      begin
         Memo1.Visible:=true;
         Memo2.Visible:=true;
         Memo2.Clear;
         Button1.Caption:='計算中止';
         Button2.Visible:=false;
         application.ProcessMessages;

         for N:=1 to length(Edit1.text) do
         begin
            if copy(Edit1.text,N,1)<>'0' then break;
         end;

         if copy(Edit1.text,N,1)='.' then
         begin
            if N=1 then
            begin
               SS:= '0'+Edit1.text;
            end
            else
            begin
               SS:= copy(Edit1.text,N-1,length(Edit1.text)-N+2);
            end;
         end
         else
         begin
            SS:= copy(Edit1.text,N,length(Edit1.text)-N+1);
         end;

         for N:=length(SS) downto 1 do
         begin
            if copy(SS,N,1)<>'0' then break;
         end;

         L:= ansipos('.',SS);

         if L<>0 then
         begin
            if copy(SS,N,1)='.' then
            begin
               SS:= copy(SS,1,N-1);
            end
            else
            begin
               SS:= copy(SS,1,N);
            end;
         end;

         L:= ansipos('.',SS);

         if L= 0 then
         begin
            SSS:= SS;
         end
         else
         begin
            SSS:= copy(SS,1,L-1)+copy(SS,L+1,length(SS)-L);
         end;

         for N:=length(SSS) downto 1 do
         begin
            if copy(SSS,N,1)<>'0' then break;
         end;

         G:= length(SSS)-N;
         SSSS:= copy(SSS,1,N);

         if copy(SSSS,1,1)='0' then
         begin
            Q:= length(SSSS)-1;
         end
         else
         begin
            Q:= 0;
         end;

         for N:=1 to length(SSSS) do
         begin
            if copy(SSSS,N,1)<>'0' then break;
         end;

         SSSSS:= copy(SSSS,N,length(SSSS)-N+1);

         A:= '1';
         B:= SSSSS;

         AA:=length(A);
         BB:=length(B);
         setlength(AAA,AA+1);
         setlength(BBB,BB+1);
         setlength(XXX,AA+BB+1);

         for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
         for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

         K:= ansipos('.',S);

         if K=0 then
         begin
            J:= strtoint(S);
         end
         else
         begin
            J:= strtoint(copy(S,1,K-1));
         end;

         M:=1;

         while (M<=J) and (BLN=true) do
         begin
            Memo2.Lines.Strings[0]:= inttostr(M);
            setlength(XXX,AA+BB+1);
            KAKERU(AAA,BBB,XXX,AA,BB);
            setlength(AAA,AA+1);
            for N:= 1 to AA do AAA[N]:= XXX[N];
            M:= M+1;
            application.ProcessMessages;
         end;

         if BLN=false then
         begin
            Memo2.Clear;
            Memo1.Visible:=false;
            Memo2.Visible:=false;
            Button1.Caption:='計算開始';
            Button2.Visible:=true;
            exit;
         end;

         PP:='';
         for N:= AA downto 1 do PP:=PP+inttostr(XXX[N]);

         if G<>0 then
         begin
            PPP:= PP+StringOfChar('0',G*J);
         end;

         if Q<>0 then
         begin
            PPP:= '0.'+StringOfChar('0',Q*J-AA)+PP;
         end;

         if (G=0) and (Q=0) then
         begin
            if L=0 then
            begin
               PPP:= PP;
            end
            else
            begin
               PPP:= copy(PP,1,AA-(length(SS)-L)*J)+'.'+copy(PP,AA-(length(SS)-L)*J+1,(length(SS)-L)*J);
            end
         end;

         X1:= PPP;

         // ここまでで底に対してS(指数の絶対値)の整数部分べきを求めた

         ketakazu:= 100;

         for N:=1 to length(Edit1.text) do
         begin
            if copy(Edit1.text,N,1)<>'0' then break;
         end;

         if copy(Edit1.text,N,1)='.' then
         begin
            if N=1 then
            begin
               R:= '0'+Edit1.text;
            end
            else
            begin
               R:= copy(Edit1.text,N-1,length(Edit1.text)-N+2);
            end;
         end
         else
         begin
            R:= copy(Edit1.text,N,length(Edit1.text)-N+1);
         end;

         for N:=length(R) downto 1 do
         begin
            if copy(R,N,1)<>'0' then break;
         end;

         L:= ansipos('.',R);
         if L<>0 then
         begin
            if copy(R,N,1)='.' then
            begin
               R:= copy(R,1,N-1);
            end
            else
            begin
               R:= copy(R,1,N);
            end;
         end;

         L:= ansipos('.',R);

         if L=0 then
         begin
            RR:= copy(R,1,1)+'.'+copy(R,2,length(R)-1);
            RRR:= IntToStr(length(R)-1)+'.'+StringOfChar('0',ketakazu);
         end
         else
         begin
            if copy(R,1,1)='0' then
            begin
               for N:=1 to length(R) do
               begin
                  if (copy(R,N,1)<>'0') and (copy(R,N,1)<>'.') then break;
               end;

               RR:= copy(R,N,1)+'.'+copy(R,N+1,length(R)-N);
               RRR:= IntToStr(N-2)+'.'+StringOfChar('0',ketakazu);
            end
            else
            begin
               if L=2 then
               begin
                  RR:= R;
                  RRR:= IntToStr(0)+'.'+StringOfChar('0',ketakazu);
               end
               else
               begin
                  RR:= copy(R,1,1)+'.'+copy(R,2,L-2)+copy(R,L+1,length(R)-L);
                  RRR:= IntToStr(L-2)+'.'+StringOfChar('0',ketakazu);
               end;
            end;
         end;

         II:= '1.0000000000000000000000';

         K:= ansipos('.',RR);
         L:= ansipos('.',II);
         if K<L then RR:= StringOfChar('0',L-K)+RR;
         if K>L then II:= StringOfChar('0',K-L)+II;
         K:= ansipos('.',RR);
         ZZ:= copy(RR,1,K-1)+copy(RR,K+1,length(RR)-K);
         WW:= copy(II,1,K-1)+copy(II,K+1,length(II)-K);

         if length(ZZ)<length(WW) then
         begin
            U:= length(ZZ);
         end
         else
         begin
            U:= length(WW);
         end;

         setlength(ZZZ,U+1);
         setlength(WWW,U+1);
         setlength(XXX,U+1);
         for N:=1 to U do ZZZ[N]:= strtoint(copy(ZZ,N,1));
         for N:=1 to U do WWW[N]:= strtoint(copy(WW,N,1));
         HIKU(ZZZ,WWW,XXX,U);
         ZZZZ:= '';
         for N:=1 to U do ZZZZ:=ZZZZ+IntToStr(XXX[N]);
         WW:= copy(ZZZZ,1,K-1)+'.'+copy(ZZZZ,K,U-K+1);

         for N:=1 to length(WW) do
         begin
            if copy(WW,N,1)<>'0' then break;
         end;

         if copy(WW,N,1)='.' then
         begin
            SS:= copy(WW,N-1,length(WW)-N+2);
         end
         else
         begin
            SS:= copy(WW,N,length(WW)-N+1);
         end;

         K:= ansipos('.',RR);
         L:= ansipos('.',II);
         if K<L then RR:= StringOfChar('0',L-K)+RR;
         if K>L then II:= StringOfChar('0',K-L)+II;
         K:= ansipos('.',RR);
         ZZ:= copy(RR,1,K-1)+copy(RR,K+1,length(RR)-K);
         WW:= copy(II,1,K-1)+copy(II,K+1,length(II)-K);

         if length(ZZ)<length(WW) then
         begin
            U:= length(ZZ);
         end
         else
         begin
            U:= length(WW);
         end;

         setlength(ZZZ,U+1);
         setlength(WWW,U+1);
         setlength(XXX,U+1);
         for N:=1 to U do ZZZ[N]:= strtoint(copy(ZZ,N,1));
         for N:=1 to U do WWW[N]:= strtoint(copy(WW,N,1));

         TASU(ZZZ,WWW,XXX,U);
         ZZZZ:= '';
         for N:=0 to U do ZZZZ:=ZZZZ+IntToStr(XXX[N]);

         if XXX[0]=1 then
         begin
            TT:= copy(ZZZZ,1,K)+'.'+copy(ZZZZ,K+1,U-K+1);
         end
         else
         begin
            TT:= copy(ZZZZ,2,K-1)+'.'+copy(ZZZZ,K+1,U-K+1);
         end;

         WARIZAN(SS, TT, YY, ketakazu);
         P:= YY;

         K:= ansipos('.',P);
         if K= 0 then
            A:= P
         else
            A:= copy(P,1,K-1)+copy(P,K+1,length(P)-K);

         B:=A;
         AA:=length(A);
         BB:=length(B);
         setlength(AAA,AA+1);
         setlength(BBB,BB+1);

         for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
         for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

         setlength(XXX,AA+BB+1);
         KAKERU(AAA,BBB,XXX,AA,BB);
         PP:='';
         for N:=AA downto 1 do PP:=PP+inttostr(XXX[N]);
         setlength(E,ketakazu+3);
         setlength(V,ketakazu+3);

         if length(PP)<ketakazu+2 then
         begin
            for N:=1 to length(PP) do E[N]:= strtoint(copy(PP,N,1));
         end
         else
         begin
            for N:=1 to ketakazu+2 do E[N]:= strtoint(copy(PP,N,1));
         end;

         WARU(E,3,V,ketakazu+2);

         V[1]:= 1;
         setlength(ZZZ,ketakazu+1);
         for N:=1 to ketakazu do ZZZ[N]:= V[N];
         PPPP:= PP;

         M:= 5;
         while M>0 do
         begin
            A:=copy(PPPP,1,ketakazu);
            B:=copy(PP,1,ketakazu);
            AA:=length(A);
            BB:=length(B);
            setlength(AAA,AA+1);
            setlength(BBB,BB+1);

            for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
            for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

            setlength(XXX,AA+BB+1);
            KAKERU(AAA,BBB,XXX,AA,BB);
            PPPP:='';
            for N:=AA downto 1 do PPPP:=PPPP+inttostr(XXX[N]);
            setlength(E,ketakazu+3);
            setlength(V,ketakazu+3);

            if length(PPPP)<ketakazu+2 then
            begin
               for N:=1 to length(PPPP) do E[N]:= strtoint(copy(PPPP,N,1));
            end
            else
            begin
               for N:=1 to ketakazu+2 do E[N]:= strtoint(copy(PPPP,N,1));
            end;

            WARU(E,M,V,ketakazu+2);
            I:=0;
            for N:=1 to ketakazu do
            begin
               if V[N]<>0 then
               begin
                  I:=1;
                  break;
               end;
            end;

            if I=0 then break;

            setlength(XXX,ketakazu+1);
            TASU(ZZZ,V,XXX,ketakazu);
            for N:=1 to ketakazu do ZZZ[N]:= XXX[N];
            Z:= '';
            for N:=1 to ketakazu do Z:= Z+inttostr(ZZZ[N]);
            M:= M+2;
         end;

         K:= ansipos('.',P);
         if K= 0 then
            A:= P
         else
            A:= copy(P,1,K-1)+copy(P,K+1,length(P)-K);

         B:=Z;
         AA:=length(A);
         BB:=length(B);
         setlength(AAA,AA+1);
         setlength(BBB,BB+1);

         for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
         for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

         setlength(XXX,AA+BB+1);
         KAKERU(AAA,BBB,XXX,AA,BB);
         Y:='';
         for N:=AA downto 1 do Y:=Y+inttostr(XXX[N]);

         A:=Y;
         B:='2';
         AA:=length(A);
         BB:=length(B);
         setlength(AAA,AA+1);
         setlength(BBB,BB+1);

         for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
         for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

         setlength(XXX,AA+BB+1);
         KAKERU(AAA,BBB,XXX,AA,BB);
         Y:='';
         for N:=AA downto 1 do Y:=Y+inttostr(XXX[N]);
         YY:= copy(Y,1,1)+'.'+copy(Y,2,ketakazu);

         TTT:= '2.302585092994045684017991454684364207601101488628772976033327900967572609677352480235997205089598298';
         WARIZAN(YY, TTT, YYY, ketakazu);

         if StrToFloat(R)>1 then
         begin
            K:= ansipos('.',YYY);
            L:= ansipos('.',RRR);
            if K<L then YYY:= StringOfChar('0',L-K)+YYY;
            if K>L then RRR:= StringOfChar('0',K-L)+RRR;
            K:= ansipos('.',YYY);
            ZZ:= copy(YYY,1,K-1)+copy(YYY,K+1,length(YYY)-K);
            WW:= copy(RRR,1,K-1)+copy(RRR,K+1,length(RRR)-K);

            if length(ZZ)<length(WW) then
            begin
               U:= length(ZZ);
            end
            else
            begin
               U:= length(WW);
            end;

            setlength(ZZZ,U+1);
            setlength(WWW,U+1);
            setlength(XXX,U+1);
            for N:=1 to U do ZZZ[N]:= strtoint(copy(ZZ,N,1));
            for N:=1 to U do WWW[N]:= strtoint(copy(WW,N,1));

            TASU(ZZZ,WWW,XXX,U);
            ZZZZ:= '';
            for N:=0 to U do ZZZZ:=ZZZZ+IntToStr(XXX[N]);

            if XXX[0]=1 then
            begin
               Z:= copy(ZZZZ,1,K)+'.'+copy(ZZZZ,K+1,U-K+1);
            end
            else
            begin
               Z:= copy(ZZZZ,2,K-1)+'.'+copy(ZZZZ,K+1,U-K+1);
            end;
         end
         else
         begin
            K:= ansipos('.',RRR);
            L:= ansipos('.',YYY);
            if K<L then RRR:= StringOfChar('0',L-K)+RRR;
            if K>L then YYY:= StringOfChar('0',K-L)+YYY;
            K:= ansipos('.',RRR);
            ZZ:= copy(RRR,1,K-1)+copy(RRR,K+1,length(RRR)-K);
            WW:= copy(YYY,1,K-1)+copy(YYY,K+1,length(YYY)-K);

            if length(ZZ)<length(WW) then
            begin
               U:= length(ZZ);
            end
            else
            begin
               U:= length(WW);
            end;

            setlength(ZZZ,U+1);
            setlength(WWW,U+1);
            setlength(XXX,U+1);
            for N:=1 to U do ZZZ[N]:= strtoint(copy(ZZ,N,1));
            for N:=1 to U do WWW[N]:= strtoint(copy(WW,N,1));
            HIKU(ZZZ,WWW,XXX,U);
            ZZZZ:= '';
            for N:=1 to U do ZZZZ:=ZZZZ+IntToStr(XXX[N]);
            WW:= copy(ZZZZ,1,K-1)+'.'+copy(ZZZZ,K,U-K+1);

            for N:=1 to length(WW) do
            begin
               if copy(WW,N,1)<>'0' then break;
            end;

            if copy(WW,N,1)='.' then
            begin
               XX:= copy(WW,N-1,length(WW)-N+2);
            end
            else
            begin
               XX:= copy(WW,N,length(WW)-N+1);
            end;

            Z:= XX;
         end;

         // ここまでで底の常用対数の絶対値を求めた

         K:= ansipos('.',TTT);
         A:= copy(TTT,1,K-1)+copy(TTT,K+1,length(TTT)-K);

         L:= ansipos('.',Z);
         if L= 0 then
            B:= Z
         else
            B:= copy(Z,1,L-1)+copy(Z,L+1,length(Z)-L);

         AA:=length(A);
         BB:=length(B);
         setlength(AAA,AA+1);
         setlength(BBB,BB+1);

         for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
         for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

         setlength(XXX,AA+BB+1);
         KAKERU(AAA,BBB,XXX,AA,BB);
         PP:='';
         for N:=AA downto 1 do PP:=PP+inttostr(XXX[N]);

         if (K<>0) and (L<>0) then
         begin
            F:= AA-length(TTT)-length(Z)+K+L;
         end
         else
         begin
            if (K<>0) and (L=0)  then
            begin
               F:= AA-length(TTT)+K;
            end
            else
            begin
               if (K=0)  and (L<>0) then
               begin
                  F:= AA-length(Z)+L;
               end
               else
               begin
                  F:= AA;
               end;
            end;
         end;

         PPP:= copy(PP,1,F)+'.'+copy(PP,F+1,AA-F);
         K:= ansipos('.',PPP);
         YY:= copy(PPP,1,K)+copy(PPP,K+1,ketakazu);

         // ここまでで底の自然対数の絶対値を求めた

         K:= ansipos('.',RRRR);
         if K= 0 then
            A:= RRRR
         else
            A:= copy(RRRR,1,K-1)+copy(RRRR,K+1,length(RRRR)-K);

         L:= ansipos('.',YY);
         if L= 0 then
            B:= YY
         else
            B:= copy(YY,1,L-1)+copy(YY,L+1,length(YY)-L);

         AA:=length(A);
         BB:=length(B);
         setlength(AAA,AA+1);
         setlength(BBB,BB+1);

         for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
         for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

         setlength(XXX,AA+BB+1);
         KAKERU(AAA,BBB,XXX,AA,BB);
         Y:='';
         for N:=AA downto 1 do Y:=Y+inttostr(XXX[N]);

         if (K<>0) and (L<>0) then F:= AA-length(RRRR)-length(YY)+K+L;
         if (K<>0) and (L=0)  then F:= AA-length(RRRR)+K;
         if (K=0)  and (L<>0) then F:= AA-length(YY)+L;
         if (K=0)  and (L=0)  then F:= AA;

         YYY:= copy(Y,1,F)+'.'+copy(Y,F+1,AA-F);

         if TEI>1 then
         begin
            Z:='1.0'+StringOfChar('0',ketakazu);
            K:= ansipos('.',Z);
            L:= ansipos('.',YYY);
            if K<L then Z:= StringOfChar('0',L-K)+Z;
            if K>L then YYY:= StringOfChar('0',K-L)+YYY;
            K:= ansipos('.',Z);
            ZZ:= copy(Z,1,K-1)+copy(Z,K+1,length(Z)-K);
            WW:= copy(YYY,1,K-1)+copy(YYY,K+1,length(YYY)-K);

            if length(ZZ)<length(WW) then
            begin
               U:= length(ZZ);
            end
            else
            begin
               U:= length(WW);
            end;

            setlength(ZZZ,U+1);
            setlength(WWW,U+1);
            setlength(XXX,U+1);
            for N:=1 to U do ZZZ[N]:= strtoint(copy(ZZ,N,1));
            for N:=1 to U do WWW[N]:= strtoint(copy(WW,N,1));

            TASU(ZZZ,WWW,XXX,U);
            ZZZZ:= '';
            for N:=0 to U do ZZZZ:=ZZZZ+IntToStr(XXX[N]);

            if XXX[0]=1 then
            begin
               Z:= copy(ZZZZ,1,K)+'.'+copy(ZZZZ,K+1,U-K+1);
            end
            else
            begin
               Z:= copy(ZZZZ,2,K-1)+'.'+copy(ZZZZ,K+1,U-K+1);
            end;

            W:= YYY;

            M:= 2;
            while M>0 do
            begin
               K:= ansipos('.',W);
               if K= 0 then
                  A:= W
               else
                  A:= copy(W,1,K-1)+copy(W,K+1,length(W)-K);

               L:= ansipos('.',YYY);
               if L= 0 then
                  B:= YYY
               else
                  B:= copy(YYY,1,L-1)+copy(YYY,L+1,length(YYY)-L);

               AA:=length(A);
               BB:=length(B);
               setlength(AAA,AA+1);
               setlength(BBB,BB+1);

               for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
               for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

               setlength(XXX,AA+BB+1);
               KAKERU(AAA,BBB,XXX,AA,BB);
               PPPP:='';
               for N:=AA downto 1 do PPPP:=PPPP+inttostr(XXX[N]);
               F:= AA-length(W)-length(YYY)+K+L;
               setlength(E,ketakazu+3);
               setlength(V,ketakazu+3);

               if length(PPPP)<ketakazu+2 then
               begin
                  for N:=1 to length(PPPP) do E[N]:= strtoint(copy(PPPP,N,1));
               end
               else
               begin
                  for N:=1 to ketakazu+2 do E[N]:= strtoint(copy(PPPP,N,1));
               end;

               WARU(E,M,V,ketakazu+2);
               I:=0;
               for N:=1 to ketakazu do
               begin
                  if V[N]<>0 then
                  begin
                     I:=1;
                     break;
                  end;
               end;

               if I=0 then break;

               Y:= '';
               for N:=1 to ketakazu do Y:= Y+inttostr(V[N]);
               WW:= copy(Y,1,F)+'.'+copy(Y,F+1,ketakazu-F);
               for N:=1 to length(WW) do
               begin
                  if copy(WW,N,1)<>'0' then break;
               end;

               if copy(WW,N,1)='.' then
               begin
                  W:= copy(WW,N-1,length(WW)-N+2);
               end
               else
               begin
                  W:= copy(WW,N,length(WW)-N+1);
               end;

               K:= ansipos('.',Z);
               L:= ansipos('.',W);
               if K<L then Z:= StringOfChar('0',L-K)+Z;
               if K>L then W:= StringOfChar('0',K-L)+W;
               K:= ansipos('.',Z);
               ZZ:= copy(Z,1,K-1)+copy(Z,K+1,length(Z)-K);
               WW:= copy(W,1,K-1)+copy(W,K+1,length(W)-K);

               if length(ZZ)<length(WW) then
               begin
                  U:= length(ZZ);
               end
               else
               begin
                  U:= length(WW);
               end;

               setlength(ZZZ,U+1);
               setlength(WWW,U+1);
               setlength(XXX,U+1);
               for N:=1 to U do ZZZ[N]:= strtoint(copy(ZZ,N,1));
               for N:=1 to U do WWW[N]:= strtoint(copy(WW,N,1));

               TASU(ZZZ,WWW,XXX,U);
               ZZZZ:= '';
               for N:=0 to U do ZZZZ:=ZZZZ+IntToStr(XXX[N]);

               if XXX[0]=1 then
               begin
                  Z:= copy(ZZZZ,1,K)+'.'+copy(ZZZZ,K+1,U-K+1);
               end
               else
               begin
                  Z:= copy(ZZZZ,2,K-1)+'.'+copy(ZZZZ,K+1,U-K+1);
               end;

               M:= M+1;
            end;

            for N:=1 to length(Z) do
            begin
               if copy(Z,N,1)<>'0' then break;
            end;

            if copy(Z,N,1)='.' then
            begin
               X2:= copy(Z,N-1,length(Z)-N+2);
            end
            else
            begin
               X2:= copy(Z,N,length(Z)-N+1);
            end;
         end;

         if TEI<1 then
         begin
            L:= ansipos('.',YYY);
            if L= 0 then
               A:= YYY
            else
               A:= copy(YYY,1,L-1)+copy(YYY,L+1,length(YYY)-L);

            B:= A;
            AA:=length(A);
            BB:=length(B);
            setlength(AAA,AA+1);
            setlength(BBB,BB+1);

            for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
            for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

            setlength(XXX,AA+BB+1);
            KAKERU(AAA,BBB,XXX,AA,BB);
            PPPP:='';
            for N:=AA downto 1 do PPPP:=PPPP+inttostr(XXX[N]);
            F:= AA-length(YYY)-length(YYY)+L+L;
            YYYY:= copy(PPPP,1,F)+'.'+copy(PPPP,F+1,ketakazu-F);
            setlength(E,ketakazu+3);
            setlength(V,ketakazu+3);

            if length(PPPP)<ketakazu+2 then
            begin
               for N:=1 to length(PPPP) do E[N]:= strtoint(copy(PPPP,N,1));
            end
            else
            begin
               for N:=1 to ketakazu+2 do E[N]:= strtoint(copy(PPPP,N,1));
            end;

            WARU(E,2,V,ketakazu+2);
            Y:= '';
            for N:=1 to ketakazu do Y:= Y+inttostr(V[N]);
            WW:= copy(Y,1,F)+'.'+copy(Y,F+1,ketakazu-F);
            for N:=1 to length(WW) do
            begin
               if copy(WW,N,1)<>'0' then break;
            end;

            if copy(WW,N,1)='.' then
            begin
               W:= copy(WW,N-1,length(WW)-N+2);
            end
            else
            begin
               W:= copy(WW,N,length(WW)-N+1);
            end;

            Z:='1.0'+StringOfChar('0',ketakazu);
            K:= ansipos('.',Z);
            L:= ansipos('.',W);
            if K<L then Z:= StringOfChar('0',L-K)+Z;
            if K>L then W:= StringOfChar('0',K-L)+W;
            K:= ansipos('.',Z);
            ZZ:= copy(Z,1,K-1)+copy(Z,K+1,length(Z)-K);
            WW:= copy(W,1,K-1)+copy(W,K+1,length(W)-K);
            if length(ZZ)<length(WW) then
            begin
               U:= length(ZZ);
            end
            else
            begin
               U:= length(WW);
            end;

            setlength(ZZZ,U+1);
            setlength(WWW,U+1);
            setlength(XXX,U+1);
            for N:=1 to U do ZZZ[N]:= strtoint(copy(ZZ,N,1));
            for N:=1 to U do WWW[N]:= strtoint(copy(WW,N,1));

            TASU(ZZZ,WWW,XXX,U);
            ZZZZ:= '';
            for N:=0 to U do ZZZZ:=ZZZZ+IntToStr(XXX[N]);

            if XXX[0]=1 then
            begin
               Z:= copy(ZZZZ,1,K)+'.'+copy(ZZZZ,K+1,U-K+1);
            end
            else
            begin
               Z:= copy(ZZZZ,2,K-1)+'.'+copy(ZZZZ,K+1,U-K+1);
            end;

            M:= 3;
            while M>0 do
            begin
               K:= ansipos('.',W);
               if K= 0 then
                  A:= W
               else
                  A:= copy(W,1,K-1)+copy(W,K+1,length(W)-K);

               L:= ansipos('.',YYYY);
               if L= 0 then
                  B:= YYYY
               else
                  B:= copy(YYYY,1,L-1)+copy(YYYY,L+1,length(YYYY)-L);

               AA:=length(A);
               BB:=length(B);
               setlength(AAA,AA+1);
               setlength(BBB,BB+1);

               for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
               for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

               setlength(XXX,AA+BB+1);
               KAKERU(AAA,BBB,XXX,AA,BB);
               PPPP:='';
               for N:=AA downto 1 do PPPP:=PPPP+inttostr(XXX[N]);
               F:= AA-length(W)-length(YYYY)+K+L;
               setlength(E,ketakazu+3);
               setlength(V,ketakazu+3);

               if length(PPPP)<ketakazu+2 then
               begin
                  for N:=1 to length(PPPP) do E[N]:= strtoint(copy(PPPP,N,1));
               end
               else
               begin
                  for N:=1 to ketakazu+2 do E[N]:= strtoint(copy(PPPP,N,1));
               end;

               WARU(E,M,V,ketakazu+2);

               for N:=1 to ketakazu+2 do E[N]:= V[N];
               M:= M+1;

               WARU(E,M,V,ketakazu+2);

               I:=0;
               for N:=1 to ketakazu do
               begin
                  if V[N]<>0 then
                  begin
                     I:=1;
                     break;
                  end;
               end;

               if I=0 then break;

               Y:= '';
               for N:=1 to ketakazu do Y:= Y+inttostr(V[N]);
               WW:= copy(Y,1,F)+'.'+copy(Y,F+1,ketakazu-F);
               for N:=1 to length(WW) do
               begin
                  if copy(WW,N,1)<>'0' then break;
               end;

               if copy(WW,N,1)='.' then
               begin
                  W:= copy(WW,N-1,length(WW)-N+2);
               end
               else
               begin
                  W:= copy(WW,N,length(WW)-N+1);
               end;

               K:= ansipos('.',Z);
               L:= ansipos('.',W);
               if K<L then Z:= StringOfChar('0',L-K)+Z;
               if K>L then W:= StringOfChar('0',K-L)+W;
               K:= ansipos('.',Z);
               ZZ:= copy(Z,1,K-1)+copy(Z,K+1,length(Z)-K);
               WW:= copy(W,1,K-1)+copy(W,K+1,length(W)-K);

               if length(ZZ)<length(WW) then
               begin
                  U:= length(ZZ);
               end
               else
               begin
                  U:= length(WW);
               end;

               setlength(ZZZ,U+1);
               setlength(WWW,U+1);
               setlength(XXX,U+1);
               for N:=1 to U do ZZZ[N]:= strtoint(copy(ZZ,N,1));
               for N:=1 to U do WWW[N]:= strtoint(copy(WW,N,1));

               TASU(ZZZ,WWW,XXX,U);
               ZZZZ:= '';
               for N:=0 to U do ZZZZ:=ZZZZ+IntToStr(XXX[N]);

               if XXX[0]=1 then
               begin
                  Z:= copy(ZZZZ,1,K)+'.'+copy(ZZZZ,K+1,U-K+1);
               end
               else
               begin
                  Z:= copy(ZZZZ,2,K-1)+'.'+copy(ZZZZ,K+1,U-K+1);
               end;
               M:= M+1;
            end;

            XX1:= Z;

            Z:= YYY;
            W:= YYY;

            M:= 2;
            while M>0 do
            begin
               K:= ansipos('.',W);
               if K= 0 then
                  A:= W
               else
                  A:= copy(W,1,K-1)+copy(W,K+1,length(W)-K);

               L:= ansipos('.',YYYY);
               if L= 0 then
                  B:= YYYY
               else
                  B:= copy(YYYY,1,L-1)+copy(YYYY,L+1,length(YYYY)-L);

               AA:=length(A);
               BB:=length(B);
               setlength(AAA,AA+1);
               setlength(BBB,BB+1);

               for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
               for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

               setlength(XXX,AA+BB+1);
               KAKERU(AAA,BBB,XXX,AA,BB);
               PPPP:='';
               for N:=AA downto 1 do PPPP:=PPPP+inttostr(XXX[N]);
               F:= AA-length(W)-length(YYYY)+K+L;
               setlength(E,ketakazu+3);
               setlength(V,ketakazu+3);

               if length(PPPP)<ketakazu+2 then
               begin
                  for N:=1 to length(PPPP) do E[N]:= strtoint(copy(PPPP,N,1));
               end
               else
               begin
                  for N:=1 to ketakazu+2 do E[N]:= strtoint(copy(PPPP,N,1));
               end;

               WARU(E,M,V,ketakazu+2);

               for N:=1 to ketakazu+2 do E[N]:= V[N];
               M:= M+1;
               WARU(E,M,V,ketakazu+2);

               I:=0;
               for N:=1 to ketakazu do
               begin
                  if V[N]<>0 then
                  begin
                     I:=1;
                     break;
                  end;
               end;

               if I=0 then break;

               Y:= '';
               for N:=1 to ketakazu do Y:= Y+inttostr(V[N]);
               WW:= copy(Y,1,F)+'.'+copy(Y,F+1,ketakazu-F);
               for N:=1 to length(WW) do
               begin
                  if copy(WW,N,1)<>'0' then break;
               end;

               if copy(WW,N,1)='.' then
               begin
                  W:= copy(WW,N-1,length(WW)-N+2);
               end
               else
               begin
                  W:= copy(WW,N,length(WW)-N+1);
               end;

               K:= ansipos('.',Z);
               L:= ansipos('.',W);
               if K<L then Z:= StringOfChar('0',L-K)+Z;
               if K>L then W:= StringOfChar('0',K-L)+W;
               K:= ansipos('.',Z);
               ZZ:= copy(Z,1,K-1)+copy(Z,K+1,length(Z)-K);
               WW:= copy(W,1,K-1)+copy(W,K+1,length(W)-K);

               if length(ZZ)<length(WW) then
               begin
                  U:= length(ZZ);
               end
               else
               begin
                  U:= length(WW);
               end;

               setlength(ZZZ,U+1);
               setlength(WWW,U+1);
               setlength(XXX,U+1);
               for N:=1 to U do ZZZ[N]:= strtoint(copy(ZZ,N,1));
               for N:=1 to U do WWW[N]:= strtoint(copy(WW,N,1));

               TASU(ZZZ,WWW,XXX,U);
               ZZZZ:= '';
               for N:=0 to U do ZZZZ:=ZZZZ+IntToStr(XXX[N]);

               if XXX[0]=1 then
               begin
                  Z:= copy(ZZZZ,1,K)+'.'+copy(ZZZZ,K+1,U-K+1);
               end
               else
               begin
                  Z:= copy(ZZZZ,2,K-1)+'.'+copy(ZZZZ,K+1,U-K+1);
               end;
               M:= M+1;
            end;

            XX2:= Z;

            K:= ansipos('.',XX1);
            L:= ansipos('.',XX2);
            if K<L then XX1:= StringOfChar('0',L-K)+XX1;
            if K>L then XX2:= StringOfChar('0',K-L)+XX2;
            K:= ansipos('.',XX1);
            ZZ:= copy(XX1,1,K-1)+copy(XX1,K+1,length(XX1)-K);
            WW:= copy(XX2,1,K-1)+copy(XX2,K+1,length(XX2)-K);

            if length(ZZ)<length(WW) then
            begin
               U:= length(ZZ);
            end
            else
            begin
               U:= length(WW);
            end;

            setlength(ZZZ,U+1);
            setlength(WWW,U+1);
            setlength(XXX,U+1);
            for N:=1 to U do ZZZ[N]:= strtoint(copy(ZZ,N,1));
            for N:=1 to U do WWW[N]:= strtoint(copy(WW,N,1));

            HIKU(ZZZ,WWW,XXX,U);
            ZZZZ:= '';
            for N:=1 to U do ZZZZ:=ZZZZ+IntToStr(XXX[N]);
            Z:= copy(ZZZZ,1,K-1)+'.'+copy(ZZZZ,K,U-K+1);

            for N:=1 to length(Z) do
            begin
               if copy(Z,N,1)<>'0' then break;
            end;

            if copy(Z,N,1)='.' then
            begin
               X2:= copy(Z,N-1,length(Z)-N+2);
            end
            else
            begin
               X2:= copy(Z,N,length(Z)-N+1);
            end;
         end;

         K:= ansipos('.',X1);
         if K= 0 then
            A:= X1
         else
            A:= copy(X1,1,K-1)+copy(X1,K+1,length(X1)-K);

         L:= ansipos('.',X2);
         if L= 0 then
            B:= X2
         else
            B:= copy(X2,1,L-1)+copy(X2,L+1,length(X2)-L);

         AA:=length(A);
         BB:=length(B);
         setlength(AAA,AA+1);
         setlength(BBB,BB+1);

         for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
         for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

         setlength(XXX,AA+BB+1);
         KAKERU(AAA,BBB,XXX,AA,BB);
         PP:='';
         for N:=AA downto 1 do PP:=PP+inttostr(XXX[N]);

         if (K<>0) and (L<>0) then F:= AA-length(X1)-length(X2)+K+L;
         if (K<>0) and (L=0)  then F:= AA-length(X1)+K;
         if (K=0)  and (L<>0) then F:= AA-length(X2)+L;
         if (K=0)  and (L=0)  then F:= AA;

         PPP:= copy(PP,1,F)+'.'+copy(PP,F+1,AA-F);

         if TEI>1 then
         begin
            XX:= copy(PP,1,1)+'.'+copy(PP,2,ketakazu-1)+'E'+IntToStr(F-1);
         end
         else
         begin
            for N:=1 to AA do
            begin
               if copy(PP,N,1)<>'0' then break;
            end;

            XX:= copy(PP,N,1)+'.'+copy(PP,N+1,ketakazu-1)+'E-'+IntToStr(N-1);
         end;
      end;

//////////////////////////////////////////////////////////////////////////////

      if copy(Edit2.text,1,1)='-' then
      begin
         A:= '1';
         K:= ansipos('E',XX);
         if K=0 then
         begin
            B:= XX;
         end
         else
         begin
            B:= copy(XX,1,K-1);
         end;

         WARIZAN(A, B, YY, 70);

         if K=0 then
         begin
            XXXX:= copy(YY,1,51);
         end
         else
         begin
            if YY='1' then
            begin
               if copy(XX,K+1,1)='-' then
               begin
                  X:= '1E'+copy(XX,K+2,length(XX)-K-1);
               end
               else
               begin
                  X:= '1E-'+copy(XX,K+1,length(XX)-K);
               end;
            end
            else
            begin
               if copy(XX,K+1,1)='-' then
               begin
                  X:= copy(YY,3,1)+'.'+copy(YY,4,length(YY)-3)+'E'+IntToStr(StrToInt(copy(XX,K+2,length(XX)-K-1))-1);
               end
               else
               begin
                  X:= copy(YY,3,1)+'.'+copy(YY,4,length(YY)-3)+'E-'+IntToStr(StrToInt(copy(XX,K+1,length(XX)-K))+1);
               end;
            end;

            L:= ansipos('E',X);
            if L<52 then
            begin
               XXXX:= X;
            end
            else
            begin
               XXXX:= copy(X,1,51)+copy(X,L,length(X)-L+1);
            end;
         end;
      end
      else
      begin
         K:= ansipos('E',XX);
         if K=0 then
         begin
            XXXX:= copy(XX,1,51) ;
         end
         else
         begin
            if K<52 then
            begin
               XXXX:= XX;
            end
            else
            begin
               XXXX:= copy(XX,1,51)+copy(XX,K,length(XX)-K+1);
            end;
         end;
      end;


      Memo1.Visible:=false;
      Label5.Visible:=true;
      Label6.Visible:=true;
      Label7.Visible:=true;
jmp1:
      Memo3.Text:=XXXX;

      Button1.Caption:='計算開始';
      Button2.Visible:=true;
      BLN:=false;

      beep;
      if MessageDlg('計算完了。　計算結果を保存または印刷しますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
      begin
         try
            if DirectoryExists('C:\Temp')=False then MkDir('C:\Temp');
            AssignFile(file1,'C:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,Edit1.text+'の'+Edit2.text+'乗');
            WriteLn(file1,XXXX);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が C:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('C:\windows\notepad.exe C:\Temp\Temp.txt',SW_SHOW);
            end;
         except
            if DirectoryExists('A:\Temp')=False then MkDir('A:\Temp');
            AssignFile(file1,'A:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,Edit1.text+'の'+Edit2.text+'乗');
            WriteLn(file1,XXXX);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が A:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('A:\windows\notepad.exe A:\Temp\Temp.txt',SW_SHOW);
            end;
         end;
      end;
      Edit2.SetFocus;
   end;
end;

procedure Tfrm_yuurisuubeki2.Button2Click(Sender: TObject);
begin
   frm_yuurisuubeki2.Close;

end;

procedure Tfrm_yuurisuubeki2.FormShow(Sender: TObject);
begin
   Edit1.SetFocus;
   Edit1.Clear;
   Edit2.Clear;
   Label5.Visible:=false;
   Label6.Visible:=false;
   Label7.Visible:=false;
   Memo1.Visible:=false;
   Memo2.Visible:=false;

end;

procedure Tfrm_yuurisuubeki2.Edit1Change(Sender: TObject);
begin
   Memo3.Clear;
   Memo2.Visible:=false;

end;

procedure Tfrm_yuurisuubeki2.Edit2Change(Sender: TObject);
begin
   Memo3.Clear;
   Memo2.Visible:=false;

end;

procedure Tfrm_yuurisuubeki2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   if BLN=true then BLN:=false;

end;

end.

*****************************************************************************************

かけ算（5000桁×5000桁）のソースコード

unit kakezan;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, StrUtils;

type
  Tfrm_kakezan = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Label2: TLabel;
    Label1: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Button2: TButton;
    Memo2: TMemo;
    Memo3: TMemo;
    Button3: TButton;
    Memo4: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Memo1Change(Sender: TObject);
    procedure Memo2Change(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  frm_kakezan: Tfrm_kakezan;

implementation

{$R *.dfm}

procedure Tfrm_kakezan.Button1Click(Sender: TObject);
var A,B:array of byte; X:array of array of byte;
var AA,BB,C,D,E,H,J,K,L,N,Q:integer;
var U:byte;
var AAA,BBB,CC,DD,XX,YY:string;
var file1:textfile;

begin
   Memo3.Clear;
   application.ProcessMessages;
   
   if rightstr(Memo1.Text,2)=#$D#$A then
   begin
      beep;
      showmessage('BackSpaceキーを押して、改行コードを取り除いてください。');
      Memo1.SetFocus;
      exit;
   end;

   H:= length(Memo1.text);
   K:= ansipos('.',Memo1.text);

   if (H>5000) and (K=0) then
   begin
      beep;
      showmessage('入力文字数を5000以下にしてください。');
      Memo1.SetFocus;
      Memo4.Text:='入力文字数＝'+inttostr(length(Memo1.Text));
      exit;
   end;

   if (H>5001) and (K<>0) then
   begin
      beep;
      showmessage('小数点を含めた入力文字数を5001以下にしてください。');
      Memo1.SetFocus;
      Memo4.Text:='入力文字数＝'+inttostr(length(Memo1.Text));
      exit;
   end;

   if K=0 then
      CC:= Memo1.text
   else
      CC:= copy(Memo1.text,1,K-1)+copy(Memo1.text,K+1,H-K);

   for N:=1 to length(CC) do
      if (ansicomparestr(copy(CC,N,1),'0')<0) or (ansicomparestr(copy(CC,N,1),'9')>0) then
      begin
         beep;
         showmessage('半角数字で5000桁以内の正の数を入力してください。');
         Memo1.SetFocus;
         exit;
      end;

   U:= 0;
   for N:=1 to length(CC) do
      if copy(CC,N,1)<>'0' then
      begin
         U:= 1;
         break;
      end;

   if U= 0 then
   begin
      beep;
      showmessage('半角数字で5000桁以内の正の数を入力してください。');
      Memo1.SetFocus;
      exit;
   end;

   if rightstr(Memo2.Text,2)=#$D#$A then
   begin
      beep;
      showmessage('BackSpaceキーを押して、改行コードを取り除いてください。');
      Memo2.SetFocus;
      exit;
   end;

   H:= length(Memo2.text);
   K:= ansipos('.',Memo2.text);

   if (H>5000) and (K=0) then
   begin
      beep;
      showmessage('入力文字数を5000以下にしてください。');
      Memo2.SetFocus;
      Memo4.Text:='入力文字数＝'+inttostr(length(Memo2.Text));
      exit;
   end;

   if (H>5001) and (K<>0) then
   begin
      beep;
      showmessage('小数点を含めた入力文字数を5001以下にしてください。');
      Memo2.SetFocus;
      Memo4.Text:='入力文字数＝'+inttostr(length(Memo2.Text));
      exit;
   end;

   if K=0 then
      CC:= Memo2.text
   else
      CC:= copy(Memo2.text,1,K-1)+copy(Memo2.text,K+1,H-K);

   for N:=1 to length(CC) do
      if (ansicomparestr(copy(CC,N,1),'0')<0) or (ansicomparestr(copy(CC,N,1),'9')>0) then
      begin
         beep;
         showmessage('半角数字で5000桁以内の正の数を入力してください。');
         Memo2.SetFocus;
         exit;
      end;

   U:= 0;
   for N:=1 to length(CC) do
      if copy(CC,N,1)<>'0' then
      begin
         U:= 1;
         break;
      end;

   if U= 0 then
   begin
      beep;
      showmessage('半角数字で5000桁以内の正の数を入力してください。');
      Memo2.SetFocus;
      exit;
   end;

   CC:= Memo1.text;
   K:= ansipos('.',CC);
   if K= 0 then
      AAA:= CC
   else
      AAA:= copy(CC,1,K-1)+copy(CC,K+1,length(CC)-K);

   DD:= Memo2.text;
   L:= ansipos('.',DD);
   if L= 0 then
      BBB:= DD
   else
      BBB:= copy(DD,1,L-1)+copy(DD,L+1,length(DD)-L);

   for N:= 1 to length(AAA) do
      if copy(AAA,N,1)<>'0' then
      begin
         AAA:= copy(AAA,N,length(AAA)-N+1);
         break;
      end;

   for N:= 1 to length(BBB) do
      if copy(BBB,N,1)<>'0' then
      begin
         BBB:= copy(BBB,N,length(BBB)-N+1);
         break;
      end;

   AA:= length(AAA);
   BB:= length(BBB);

   setlength(A,AA+1);
   setlength(B,BB+1);
   setlength(X,BB+2,AA+BB+2);

   for N:=1 to AA do A[N]:= strtoint(copy(AAA,AA-N+1,1));

   for N:=1 to BB do B[N]:= strtoint(copy(BBB,BB-N+1,1));

   for N:=1 to BB do
   begin
      Q:= 0;
      for J:= 1 to AA do
      begin
         C:= A[J]*B[N]+Q;
         X[N,J+N-1]:= C mod 10;
         Q:= C div 10;
      end;
      X[N,AA+N]:= Q;
   end;

   Q:= 0;

   for N:= 1 to AA+BB do
   begin
      C:=0;
      for J:= 1 to BB do C:= C+X[J,N];

      C:= C+Q;
      X[BB+1,N]:= C mod 10;
      Q:= C div 10;
   end;

   if X[BB+1,AA+BB]=0 then D:= AA+BB-1 else D:= AA+BB;

   XX:='';
   for N:= D downto 1 do XX:= XX+inttostr(X[BB+1,N]);

   E:=0;
   if (K=0) and (L=0) then
      YY:= XX
   else
   begin
      if (K=0) and (L<>0) then E:= D-length(DD)+L;
      if (K<>0) and (L=0) then E:= D-length(CC)+K;
      if (K<>0) and (L<>0) then E:= D-length(CC)-length(DD)+K+L;

      if E>0 then
      begin
         U:=0;
         for N:= D downto E+1 do
            if copy(XX,N,1)<>'0' then
            begin
               U:=1;
               break;
            end;

         if U=1 then YY:= copy(XX,1,E)+'.'+copy(XX,E+1,N-E);
         if U=0 then YY:= copy(XX,1,E);
      end
      else
      begin
         for N:= D downto 1 do
            if copy(XX,N,1)<>'0' then break;

         YY:= '0.'+stringofchar('0',-E)+copy(XX,1,N);
      end;
   end;

   Memo3.text:= YY;

   beep;
   if MessageDlg('計算完了。　計算結果を保存または印刷しますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
   begin
         try
            if DirectoryExists('C:\Temp')=False then MkDir('C:\Temp');
            AssignFile(file1,'C:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,Memo1.text+'×'+Memo2.text+'の計算結果（積）');
            WriteLn(file1,Chr(13));
            WriteLn(file1,YY);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が C:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('C:\windows\notepad.exe C:\Temp\Temp.txt',SW_SHOW);
            end;
         except
            if DirectoryExists('A:\Temp')=False then MkDir('A:\Temp');
            AssignFile(file1,'A:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,Memo1.text+'×'+Memo2.text+'の計算結果（積）');
            WriteLn(file1,Chr(13));
            WriteLn(file1,YY);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が A:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('A:\windows\notepad.exe A:\Temp\Temp.txt',SW_SHOW);
            end;
         end;
   end;
   Memo1.SetFocus;
end;

procedure Tfrm_kakezan.Button2Click(Sender: TObject);
begin
   frm_kakezan.Close;

end;

procedure Tfrm_kakezan.FormShow(Sender: TObject);
begin
   Memo1.Clear;
   Memo2.Clear;
   Memo3.Clear;
   Memo4.Visible:=false;
   Memo1.SetFocus;

end;

procedure Tfrm_kakezan.Memo1Change(Sender: TObject);
begin
   Memo3.Clear;
   Memo4.Visible:=true;
   Memo4.Text:='入力文字数＝'+inttostr(length(Memo1.Text));

   if rightstr(Memo1.Text,2)=#$D#$A then
   begin
      beep;
      showmessage('BackSpaceキーを押して、改行コードを取り除いてください。');
      exit;
   end;

end;

procedure Tfrm_kakezan.Memo2Change(Sender: TObject);
begin
   Memo3.Clear;
   Memo4.Visible:=true;
   Memo4.Text:='入力文字数＝'+inttostr(length(Memo2.Text));

   if rightstr(Memo2.Text,2)=#$D#$A then
   begin
      beep;
      showmessage('BackSpaceキーを押して、改行コードを取り除いてください。');
      exit;
   end;

end;

procedure Tfrm_kakezan.Button3Click(Sender: TObject);
begin
   Memo1.Clear;
   Memo2.Clear;
   Memo3.Clear;
   Memo4.Visible:=false;
   Memo1.SetFocus;

end;

end.

*****************************************************************************************

割り算１（2000桁÷2000桁で20000桁まで求める）のソースコード

unit warizan4;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, StrUtils;

type
  Tfrm_warizan4 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Label2: TLabel;
    Label1: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Button2: TButton;
    Memo2: TMemo;
    Memo3: TMemo;
    Memo4: TMemo;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Memo1Change(Sender: TObject);
    procedure Memo2Change(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  frm_warizan4: Tfrm_warizan4;

implementation

{$R *.dfm}

procedure Tfrm_warizan4.Button1Click(Sender: TObject);
var A,B:array[1..2002] of byte; C:array[1..22002] of byte; X:array[1..20000] of byte;
var AA,BB,D,E,F,G,H,J,K,N,Q,S,T,ketasuu:integer;
var P,U,V,Z:byte;
var AAA,BBB,CC,XX,YY:string;
var file1:textfile;

begin
   Memo3.Clear;
   application.ProcessMessages;
   ketasuu:= 20000;

   if rightstr(Memo1.Text,2)=#$D#$A then
   begin
      beep;
      showmessage('BackSpaceキーを押して、改行コードを取り除いてください。');
      Memo1.SetFocus;
      exit;
   end;

   H:= length(Memo1.text);
   K:= ansipos('.',Memo1.text);

   if (H>2000) and (K=0) then
   begin
      beep;
      showmessage('入力文字数を2000以下にしてください。');
      Memo1.SetFocus;
      Memo4.Text:='入力文字数＝'+inttostr(length(Memo1.Text));
      exit;
   end;

   if (H>2001) and (K<>0) then
   begin
      beep;
      showmessage('小数点を含めた入力文字数を2001以下にしてください。');
      Memo1.SetFocus;
      Memo4.Text:='入力文字数＝'+inttostr(length(Memo1.Text));
      exit;
   end;

   if K=0 then
      CC:= Memo1.text
   else
      CC:= copy(Memo1.text,1,K-1)+copy(Memo1.text,K+1,H-K);

   for N:=1 to length(CC) do
      if (ansicomparestr(copy(CC,N,1),'0')<0) or (ansicomparestr(copy(CC,N,1),'9')>0) then
      begin
         beep;
         showmessage('半角数字で2000桁以内の正の数を入力してください。');
         Memo1.SetFocus;
         exit;
      end;

   U:= 0;
   for N:=1 to length(CC) do
      if copy(CC,N,1)<>'0' then
      begin
         U:= 1;
         break;
      end;

   if U= 0 then
   begin
      beep;
      showmessage('半角数字で2000桁以内の正の数を入力してください。');
      Memo1.SetFocus;
      exit;
   end;

   if rightstr(Memo2.Text,2)=#$D#$A then
   begin
      beep;
      showmessage('BackSpaceキーを押して、改行コードを取り除いてください。');
      Memo2.SetFocus;
      exit;
   end;

   H:= length(Memo2.text);
   K:= ansipos('.',Memo2.text);

   if (H>2000) and (K=0) then
   begin
      beep;
      showmessage('入力文字数を2000以下にしてください。');
      Memo2.SetFocus;
      Memo4.Text:='入力文字数＝'+inttostr(length(Memo2.Text));
      exit;
   end;

   if (H>2001) and (K<>0) then
   begin
      beep;
      showmessage('小数点を含めた入力文字数を2001以下にしてください。');
      Memo2.SetFocus;
      Memo4.Text:='入力文字数＝'+inttostr(length(Memo2.Text));
      exit;
   end;

   if K=0 then
      CC:= Memo2.text
   else
      CC:= copy(Memo2.text,1,K-1)+copy(Memo2.text,K+1,H-K);

   for N:=1 to length(CC) do
      if (ansicomparestr(copy(CC,N,1),'0')<0) or (ansicomparestr(copy(CC,N,1),'9')>0) then
      begin
         beep;
         showmessage('半角数字で2000桁以内の正の数を入力してください。');
         Memo2.SetFocus;
         exit;
      end;

   U:= 0;
   for N:=1 to length(CC) do
      if copy(CC,N,1)<>'0' then
      begin
         U:= 1;
         break;
      end;

   if U= 0 then
   begin
      beep;
      showmessage('半角数字で2000桁以内の正の数を入力してください。');
      Memo2.SetFocus;
      exit;
   end;

   CC:= Memo1.text;
   for N:= 1 to length(CC) do
      if copy(CC,N,1)<>'0' then
      begin
         CC:= copy(CC,N,length(CC)-N+1);
         break;
      end;

   E:=0;
   K:= ansipos('.',CC);
   if K= 0 then
   begin
      AAA:= CC;
      E:= length(AAA);
   end;

   if K= 1 then
      for N:= 2 to length(CC) do
         if copy(CC,N,1)<>'0' then
         begin
            AAA:= copy(CC,N,length(CC)-N+1);
            E:= 2-N;
            break;
         end;

   if K>= 2 then
   begin
      AAA:= copy(CC,1,K-1)+copy(CC,K+1,length(CC)-K);
      E:= K-1;
   end;

   CC:= Memo2.text;
   for N:= 1 to length(CC) do
      if copy(CC,N,1)<>'0' then
      begin
         CC:= copy(CC,N,length(CC)-N+1);
         break;
      end;

   F:=0;
   K:= ansipos('.',CC);
   if K= 0 then
   begin
      BBB:= CC;
      F:= length(BBB);
   end;

   if K= 1 then
      for N:= 2 to length(CC) do
         if copy(CC,N,1)<>'0' then
         begin
            BBB:= copy(CC,N,length(CC)-N+1);
            F:= 2-N;
            break;
         end;

   if K>= 2 then
   begin
      BBB:= copy(CC,1,K-1)+copy(CC,K+1,length(CC)-K);
      F:= K-1;
   end;

   G:= E-F+1;
   AA:= length(AAA);
   BB:= length(BBB);
   T:= AA-BB+1;

   for N:=1 to 1002 do
   begin
      A[N]:= 0; B[N]:= 0;
   end;

   for N:=1 to ketasuu + 1002 do
   begin
      C[N]:= 0;
   end;

   for N:=1 to ketasuu do
   begin
      X[N]:= 0;
   end;

   for N:=1 to AA do
      C[N]:= strtoint(copy(AAA,N,1));

   for N:=1 to BB do
      A[N]:= C[BB-N+1];

   for N:=1 to BB do
      B[N]:= strtoint(copy(BBB,BB-N+1,1));

   S:= 0;

   repeat
      P:= 0;
      repeat
         Z:= 0;
         if A[BB+1]<>0 then
         begin
            Q:= 1;
            for N:=1 to BB+1 do
            begin
               D:= 10+A[N]-1+Q-B[N];
               A[N]:= D mod 10;
               Q:= D div 10;
            end;

            P:= P+1;
         end
         else
         begin
            V:= 0;
            for N:=BB downto 1 do
            begin
               if B[N]<A[N] then
               begin
                  V:= 1;
                  Q:= 1;
                  for J:=1 to BB do
                  begin
                     D:= 10+A[J]-1+Q-B[J];
                     A[J]:= D mod 10;
                     Q:= D div 10;
                  end;

                  P:= P+1;
                  break;
               end
               else if B[N]>A[N] then
               begin
                  V:= 1;
                  S:= S+1;
                  X[S]:= P;
                  if S= ketasuu then
                  begin
                     Z:= 2;
                     break;
                  end;

                  if (T<=0) or ((T>0) and (S>=T)) then
                  begin
                     U:=0;
                     for J:=BB downto 1 do
                        if A[J]<>0 then
                        begin
                           U:=1;
                           break;
                        end;

                     if U=0 then
                     begin
                        Z:= 2;
                        break;
                     end;

                     for J:=BB downto 1 do
                        A[J+1]:= A[J];

                     A[1]:= C[BB+S];
                     Z:= 1;
                  end
                  else
                  begin
                     for J:=BB downto 1 do
                        A[J+1]:= A[J];

                     A[1]:= C[BB+S];
                     Z:= 1;
                  end;
                  break;
               end;
            end;

            if V=0 then
            begin
               P:= P+1;
               for N:=BB downto 1 do
                  A[N]:= 0;

            end;
         end;
         if (Z=1) or (Z=2) then break;
      until S=-1;
      if Z=2 then break;
   until S=-1;

   XX:='';
   for N:= 1 to S do
      XX:= XX+inttostr(X[N]);

   if (G>0) and (S=G) then
   begin
      YY:= XX;
      if copy(YY,1,1)='0' then YY:= copy(YY,2,S-1);
   end;

   if (G>0) and (S<G) then
   begin
      YY:= XX+stringofchar('0',G-S);
      if copy(YY,1,1)='0' then YY:= copy(YY,2,G-1);
   end;

   if (G>0) and (S>G) then
   begin
      YY:= copy(XX,1,G)+'.'+copy(XX,G+1,BB-1+S-G);
      if G<>1 then
         if copy(YY,1,1)='0' then YY:= copy(YY,2,BB-1+S);
   end;

   if G<=0 then
      YY:= '0.'+stringofchar('0',-G)+XX;

   Memo3.text:= YY;

   beep;
   if MessageDlg('計算完了。　計算結果を保存または印刷しますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
   begin
         try
            if DirectoryExists('C:\Temp')=False then MkDir('C:\Temp');
            AssignFile(file1,'C:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,Memo1.text+'÷'+Memo2.text+'の計算結果（商）');
            WriteLn(file1,Chr(13));
            WriteLn(file1,YY);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が C:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('C:\windows\notepad.exe C:\Temp\Temp.txt',SW_SHOW);
            end;
         except
            if DirectoryExists('A:\Temp')=False then MkDir('A:\Temp');
            AssignFile(file1,'A:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,Memo1.text+'÷'+Memo2.text+'の計算結果（商）');
            WriteLn(file1,Chr(13));
            WriteLn(file1,YY);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が A:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('A:\windows\notepad.exe A:\Temp\Temp.txt',SW_SHOW);
            end;
         end;
   end;
   Memo1.SetFocus;
end;

procedure Tfrm_warizan4.Button2Click(Sender: TObject);
begin
   frm_warizan4.Close;

end;

procedure Tfrm_warizan4.FormShow(Sender: TObject);
begin
   Memo1.Clear;
   Memo2.Clear;
   Memo3.Clear;
   Memo4.Visible:=false;
   Memo1.SetFocus;

end;

procedure Tfrm_warizan4.Button3Click(Sender: TObject);
begin
   Memo1.Clear;
   Memo2.Clear;
   Memo3.Clear;
   Memo4.Visible:=false;
   Memo1.SetFocus;

end;

procedure Tfrm_warizan4.Memo1Change(Sender: TObject);
begin
   Memo3.Clear;
   Memo4.Visible:=true;
   Memo4.Text:='入力文字数＝'+inttostr(length(Memo1.Text));

   if rightstr(Memo1.Text,2)=#$D#$A then
   begin
      beep;
      showmessage('BackSpaceキーを押して、改行コードを取り除いてください。');
      exit;
   end;

end;

procedure Tfrm_warizan4.Memo2Change(Sender: TObject);
begin
   Memo3.Clear;
   Memo4.Visible:=true;
   Memo4.Text:='入力文字数＝'+inttostr(length(Memo2.Text));

   if rightstr(Memo2.Text,2)=#$D#$A then
   begin
      beep;
      showmessage('BackSpaceキーを押して、改行コードを取り除いてください。');
      exit;
   end;

end;

end.

*****************************************************************************************

割り算２（60000桁以内の２つの整数同士の割り算で整商と余りを求める）のソースコード

unit warizan3;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, StrUtils;

type
  Tfrm_warizan3 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Label2: TLabel;
    Label1: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Button2: TButton;
    Label5: TLabel;
    Memo2: TMemo;
    Memo3: TMemo;
    Memo4: TMemo;
    Memo5: TMemo;
    Button3: TButton;
    Memo6: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Memo1Change(Sender: TObject);
    procedure Memo2Change(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  frm_warizan3: Tfrm_warizan3;

implementation

{$R *.dfm}

procedure SYOU_AMARI(A,B:array of byte; var X,Y:array of byte);
//割り算（整数÷整数）の整商と余りを求めるサブプロシージャ   A÷B＝X　余り Y
//BB>AA のときは，このサブプロシージャでは処理できない
var E:array[0..120000] of byte;
var D,P,Q,V,Z:byte;
var AA,BB,J,N,S:integer;

begin
   AA:=high(A);
   BB:=high(B);
   E[0]:=0;

   for N:=1 to BB do X[N]:=0;
   for N:=1 to BB do E[N]:=A[N];
   S:=0;

   repeat
      P:= 0;
      repeat
         Z:= 0;
         if E[0]<>0 then
         begin
            Q:= 1;
            for N:=BB downto 0 do
            begin
               D:= 10+E[N]-1+Q-B[N];
               E[N]:= D mod 10;
               Q:= D div 10;
            end;

            P:= P+1;
         end
         else
         begin
            V:= 0;
            for N:=1 to BB do
            begin
               if B[N]<E[N] then
               begin
                  V:= 1;
                  Q:= 1;
                  for J:=BB downto 1 do
                  begin
                     D:= 10+E[J]-1+Q-B[J];
                     E[J]:= D mod 10;
                     Q:= D div 10;
                  end;

                  P:= P+1;
                  break;
               end
               else if B[N]>E[N] then
               begin
                  V:= 1;
                  S:= S+1;
                  X[BB-1+S]:= P;
                  if BB-1+S= AA then
                  begin
                     for J:=1 to BB do Y[J]:=E[J];
                     Z:= 2;
                     break;
                  end;

                  for J:=0 to BB-1 do E[J]:= E[J+1];
                  E[BB]:= A[BB+S];
                  Z:= 1;
                  break;
               end;
            end;

            if V=0 then
            begin
               P:= P+1;
               for N:=1 to BB do E[N]:= 0;
            end;
         end;
         if (Z=1) or (Z=2) then break;
      until S=-1;
      if Z=2 then break;
   until S=-1;

end;

procedure Tfrm_warizan3.Button1Click(Sender: TObject);
var AAA,BBB,XX,YY:array of byte;
var AA,BB,J,N:integer;
var U,Z:byte;
var A,B,CC,X,Y:string;
var file1:textfile;

begin
   Memo3.Clear;
   Memo4.Clear;
   application.ProcessMessages;

   if rightstr(Memo1.Text,2)=#$D#$A then
   begin
      beep;
      showmessage('BackSpaceキーを押して、改行コードを取り除いてください。');
      Memo1.SetFocus;
      exit;
   end;

   CC:= Memo1.text;
   for N:=1 to length(CC) do
      if (ansicomparestr(copy(CC,N,1),'0')<0) or (ansicomparestr(copy(CC,N,1),'9')>0) then
      begin
         beep;
         showmessage('半角数字で60000桁以内の正の整数を入力してください。');
         Memo1.SetFocus;
         exit;
      end;

   if length(CC)>60000 then
   begin
      beep;
      showmessage('入力文字数を60000以下にしてください。');
      Memo1.SetFocus;
      Memo6.Text:='入力文字数＝'+inttostr(length(Memo1.Text));
      exit;
   end;

   U:= 0;
   for N:=1 to length(CC) do
      if copy(CC,N,1)<>'0' then
      begin
         U:= 1;
         break;
      end;

   if U= 0 then
   begin
      beep;
      showmessage('半角数字で60000桁以内の正の整数を入力してください。');
      Memo1.SetFocus;
      exit;
   end;

   if rightstr(Memo2.Text,2)=#$D#$A then
   begin
      beep;
      showmessage('BackSpaceキーを押して、改行コードを取り除いてください。');
      Memo2.SetFocus;
      exit;
   end;

   CC:= Memo2.text;
   for N:=1 to length(CC) do
      if (ansicomparestr(copy(CC,N,1),'0')<0) or (ansicomparestr(copy(CC,N,1),'9')>0) then
      begin
         beep;
         showmessage('半角数字で60000桁以内の正の整数を入力してください。');
         Memo2.SetFocus;
         exit;
      end;

   if length(CC)>60000 then
   begin
      beep;
      showmessage('入力文字数を60000以下にしてください。');
      Memo2.SetFocus;
      Memo6.Text:='入力文字数＝'+inttostr(length(Memo2.Text));
      exit;
   end;

   U:= 0;
   for N:=1 to length(CC) do
      if copy(CC,N,1)<>'0' then
      begin
         U:= 1;
         break;
      end;

   if U= 0 then
   begin
      beep;
      showmessage('半角数字で60000桁以内の正の整数を入力してください。');
      Memo2.SetFocus;
      exit;
   end;

   Memo5.Visible:=true;
   application.ProcessMessages;

   for N:= 1 to length(Memo1.Text) do
      if copy(Memo1.Text,N,1)<>'0' then
      begin
         A:= copy(Memo1.Text,N,length(Memo1.Text)-N+1);
         break;
      end;

   for N:= 1 to length(Memo2.Text) do
      if copy(Memo2.Text,N,1)<>'0' then
      begin
         B:= copy(Memo2.Text,N,length(Memo2.Text)-N+1);
         break;
      end;

   AA:= length(A);
   BB:= length(B);

   if BB>AA then
   begin
      Memo3.Lines.text:= '0';
      Memo4.Lines.text:= A;
      Memo5.Visible:=false;
      beep;
      Memo1.SetFocus;
      exit;
   end;

   if BB<=AA then
   begin
      setlength(AAA,AA+1);
      setlength(BBB,BB+1);
      setlength(XX,AA+1);
      setlength(YY,BB+1);
      for N:=1 to AA do AAA[N]:= strtoint(copy(A,N,1));
      for N:=1 to BB do BBB[N]:= strtoint(copy(B,N,1));

      SYOU_AMARI(AAA,BBB,XX,YY);

      Z:=0;
      for N:=1 to AA do
         if XX[N]<>0 then
         begin
            Z:=1;
            break;
         end;

      if Z=0 then
      begin
         X:= '0';
      end
      else
      begin
         X:='';
         for J:=N to AA do X:=X+inttostr(XX[J]);
      end;

      Z:=0;
      for N:=1 to BB do
         if YY[N]<>0 then
         begin
            Z:=1;
            break;
         end;

      if Z=0 then
      begin
         Y:= '0';
      end
      else
      begin
         Y:='';
         for J:=N to BB do Y:=Y+inttostr(YY[J]);
      end;

      Memo3.text:= X;
      Memo4.text:= Y;
      Memo5.Visible:=false;

      application.ProcessMessages;

      beep;
      if MessageDlg('計算完了。　計算結果を保存または印刷しますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
      begin
         try
            if DirectoryExists('C:\Temp')=False then MkDir('C:\Temp');
            AssignFile(file1,'C:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,Memo1.text+'÷'+Memo2.text+' の');
            WriteLn(file1,Chr(13));
            WriteLn(file1,'整商＝'+X);
            WriteLn(file1,Chr(13));
            WriteLn(file1,'余り＝'+Y);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が C:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('C:\windows\notepad.exe C:\Temp\Temp.txt',SW_SHOW);
            end;
         except
            if DirectoryExists('A:\Temp')=False then MkDir('A:\Temp');
            AssignFile(file1,'A:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,Memo1.text+'÷'+Memo2.text+' の');
            WriteLn(file1,Chr(13));
            WriteLn(file1,'整商＝'+X);
            WriteLn(file1,Chr(13));
            WriteLn(file1,'余り＝'+Y);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が A:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('A:\windows\notepad.exe A:\Temp\Temp.txt',SW_SHOW);
            end;
         end;
      end;
      Memo1.SetFocus;
   end;
end;

procedure Tfrm_warizan3.Button2Click(Sender: TObject);
begin
   frm_warizan3.Close;

end;

procedure Tfrm_warizan3.FormShow(Sender: TObject);
begin
   Memo1.SetFocus;
   Memo1.Clear;
   Memo2.Clear;
   Memo3.Clear;
   Memo4.Clear;
   Memo5.Visible:=false;
   Memo6.Visible:=false;

end;

procedure Tfrm_warizan3.Button3Click(Sender: TObject);
begin
   Memo1.Clear;
   Memo2.Clear;
   Memo3.Clear;
   Memo4.Clear;
   Memo6.Visible:=false;
   Memo1.SetFocus;

end;

procedure Tfrm_warizan3.Memo1Change(Sender: TObject);
begin
   Memo3.Clear;
   Memo4.Clear;
   Memo6.Visible:=true;
   Memo6.Text:='入力文字数＝'+inttostr(length(Memo1.Text));

   if rightstr(Memo1.Text,2)=#$D#$A then
   begin
      beep;
      showmessage('BackSpaceキーを押して、改行コードを取り除いてください。');
      exit;
   end;

   if Memo1.Text='' then exit;
   if (ansicomparestr(rightstr(Memo1.Text,1),'0')<0) or (ansicomparestr(rightstr(Memo1.Text,1),'9')>0) then
   begin
      beep;
      showmessage('半角数字を入力してください。');
      exit;
   end;

end;

procedure Tfrm_warizan3.Memo2Change(Sender: TObject);
begin
   Memo3.Clear;
   Memo4.Clear;
   Memo6.Visible:=true;
   Memo6.Text:='入力文字数＝'+inttostr(length(Memo2.Text));

   if rightstr(Memo2.Text,2)=#$D#$A then
   begin
      beep;
      showmessage('BackSpaceキーを押して、改行コードを取り除いてください。');
      exit;
   end;

   if Memo2.Text='' then exit;
   if (ansicomparestr(rightstr(Memo2.Text,1),'0')<0) or (ansicomparestr(rightstr(Memo2.Text,1),'9')>0) then
   begin
      beep;
      showmessage('半角数字を入力してください。');
      exit;
   end;

end;

end.

*****************************************************************************************

自然対数を求めるソースコード

unit sizentaisuu;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  Tfrm_sizentaisuu = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Label2: TLabel;
    Label1: TLabel;
    Label4: TLabel;
    Button2: TButton;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  frm_sizentaisuu: Tfrm_sizentaisuu;

implementation

{$R *.dfm}

procedure KAKERU(A,B:array of byte; var X:array of byte; var AA:integer; BB:integer);
//かけ算のサブプロシージャ   A×B＝X
var XX:array of array of byte;
var C,J,N:integer;
var Q:byte;

begin
   setlength(XX,BB+1,AA+BB+1);
   for J:= 1 to BB do
   begin
      Q:=0;
      for N:= 1 to AA do
      begin
         C:= A[N]*B[J]+Q;
         XX[J,N+J-1]:= C mod 10;
         Q:= C div 10;
      end;
      XX[J,AA+J]:= Q;
   end;

   Q:= 0;
   for N:= 1 to AA+BB do
   begin
      C:= 0;
      for J:= 1 to BB do C:= C+XX[J,N];
      C:= C+Q;
      X[N]:= C mod 10;
      Q:= C div 10;
   end;

   if X[AA+BB]=0 then AA:= AA+BB-1 else AA:= AA+BB;
end;

procedure WARIZAN(AAAA:string; BBBB:string; var YY:string; ketasuu:integer);
//割り算のサブプロシージャ   AAAA÷BBBB=YY
var A,B:array[1..202] of byte; C:array[1..1202] of byte; X:array[1..1000] of byte;
var D,E,F,G,J,N,Q,S,T:integer;
var AA,BB,H,K,P,U,V,Z:byte;
var AAA,BBB,CC,XX:string;

begin
   for N:= 1 to length(AAAA) do
      if copy(AAAA,N,1)<>'0' then
      begin
         AAAA:= copy(AAAA,N,length(AAAA)-N+1);
         break;
      end;

   E:=0;
   K:= ansipos('.',AAAA);
   if K= 0 then
   begin
      AAA:= AAAA;
      E:= length(AAA);
   end;

   if K= 1 then
      for N:= 2 to length(AAAA) do
         if copy(AAAA,N,1)<>'0' then
         begin
            AAA:= copy(AAAA,N,length(AAAA)-N+1);
            E:= 2-N;
            break;
         end;

   if K>= 2 then
   begin
      AAA:= copy(AAAA,1,K-1)+copy(AAAA,K+1,length(AAAA)-K);
      E:= K-1;
   end;

   for N:= 1 to length(BBBB) do
      if copy(BBBB,N,1)<>'0' then
      begin
         BBBB:= copy(BBBB,N,length(BBBB)-N+1);
         break;
      end;

   F:=0;
   K:= ansipos('.',BBBB);
   if K= 0 then
   begin
      BBB:= BBBB;
      F:= length(BBB);
   end;

   if K= 1 then
      for N:= 2 to length(BBBB) do
         if copy(BBBB,N,1)<>'0' then
         begin
            BBB:= copy(BBBB,N,length(BBBB)-N+1);
            F:= 2-N;
            break;
         end;

   if K>= 2 then
   begin
      BBB:= copy(BBBB,1,K-1)+copy(BBBB,K+1,length(BBBB)-K);
      F:= K-1;
   end;

   G:= E-F+1;
   AA:= length(AAA);
   BB:= length(BBB);
   T:= AA-BB+1;

   for N:=1 to 202 do
   begin
      A[N]:= 0; B[N]:= 0;
   end;

   for N:=1 to 1202 do
   begin
      C[N]:= 0;
   end;

   for N:=1 to 1000 do
   begin
      X[N]:= 0;
   end;

   for N:=1 to AA do
      C[N]:= strtoint(copy(AAA,N,1));

   for N:=1 to BB do
      A[N]:= C[BB-N+1];

   for N:=1 to BB do
      B[N]:= strtoint(copy(BBB,BB-N+1,1));

   S:= 0;

   repeat
      P:= 0;
      repeat
         Z:= 0;
         if A[BB+1]<>0 then
         begin
            Q:= 1;
            for N:=1 to BB+1 do
            begin
               D:= 10+A[N]-1+Q-B[N];
               A[N]:= D mod 10;
               Q:= D div 10;
            end;

            P:= P+1;
         end
         else
         begin
            V:= 0;
            for N:=BB downto 1 do
            begin
               if B[N]<A[N] then
               begin
                  V:= 1;
                  Q:= 1;
                  for J:=1 to BB do
                  begin
                     D:= 10+A[J]-1+Q-B[J];
                     A[J]:= D mod 10;
                     Q:= D div 10;
                  end;

                  P:= P+1;
                  break;
               end
               else if B[N]>A[N] then
               begin
                  V:= 1;
                  S:= S+1;
                  X[S]:= P;
                  if S= ketasuu then
                  begin
                     Z:= 2;
                     break;
                  end;

                  if (T<=0) or ((T>0) and (S>=T)) then
                  begin
                     U:=0;
                     for J:=BB downto 1 do
                        if A[J]<>0 then
                        begin
                           U:=1;
                           break;
                        end;

                     if U=0 then
                     begin
                        Z:= 2;
                        break;
                     end;

                     for J:=BB downto 1 do
                        A[J+1]:= A[J];

                     A[1]:= C[BB+S];
                     Z:= 1;
                  end
                  else
                  begin
                     for J:=BB downto 1 do
                        A[J+1]:= A[J];

                     A[1]:= C[BB+S];
                     Z:= 1;
                  end;
                  break;
               end;
            end;

            if V=0 then
            begin
               P:= P+1;
               for N:=BB downto 1 do
                  A[N]:= 0;

            end;
         end;
         if (Z=1) or (Z=2) then break;
      until S=-1;
      if Z=2 then break;
   until S=-1;

   XX:='';
   for N:= 1 to S do
      XX:= XX+inttostr(X[N]);

   if (G>0) and (S=G) then
   begin
      YY:= XX;
      if copy(YY,1,1)='0' then YY:= copy(YY,2,S-1);
   end;

   if (G>0) and (S<G) then
   begin
      YY:= XX+stringofchar('0',G-S);
      if copy(YY,1,1)='0' then YY:= copy(YY,2,G-1);
   end;

   if (G>0) and (S>G) then
   begin
      YY:= copy(XX,1,G)+'.'+copy(XX,G+1,BB-1+S-G);
      if G<>1 then
         if copy(YY,1,1)='0' then YY:= copy(YY,2,BB-1+S);
   end;

   if G<=0 then
      YY:= '0.'+stringofchar('0',-G)+XX;
end;

procedure WARU(A:array of byte; B:integer; var X:array of byte; ketasuu:integer);
//割り算のサブプロシージャ   A/B=X
var D,K,N,RR:integer;
var C:string;

begin
   K:=length(inttostr(B));
   C:='';
   for N:=1 to K do
      C:=C+inttostr(A[N]);

   D:=strtoint(C);

   for N:=0 to ketasuu do
      X[N]:=0;
      
   for N:=0 to ketasuu-1-k do
   begin
      X[K+N]:=D div B;
      RR:=D-B*X[K+N];
      D:=RR*10+A[K+1+N];
   end;
end;

procedure TASU(A,B:array of byte; var X:array of byte; ketasuu:integer);
//足し算のサブプロシージャ   A+B=X
var C,N,Q:integer;
begin
   for N:=0 to ketasuu do
      X[N]:=0;

   Q:=0;
   for N:=ketasuu downto 0 do
   begin
      C:=A[N]+B[N]+Q;
      X[N]:=C mod 10;
      Q:=C div 10;
   end;
end;

procedure HIKU(A,B:array of byte; var X:array of byte; ketasuu:integer);
//引き算のサブプロシージャ   A-B=X
var C,N,Q:integer;
begin
   for N:=0 to ketasuu do
      X[N]:=0;

   Q:=1;
   for N:=ketasuu downto 1 do
   begin
      C:=10+A[N]-1+Q-B[N];
      X[N]:=C mod 10;
      Q:=C div 10;
   end;
end;

procedure Tfrm_sizentaisuu.Button1Click(Sender: TObject);
var AAA,BBB,E,V,WWW,XXX,ZZZ:array of byte;
var AA,BB,F,M,N,ketakazu:integer;
var S,T:extended;
var H,I,K,L,U:byte;
var A,B,CC,II,SS,TT,TTT,P,PP,PPP,PPPP,R,RR,RRR,VV,WW,XX,Y,YY,YYY,Z,ZZ,ZZZZ:string;
var file1:textfile;
label jmp1;

begin
   Edit2.Clear;
   application.ProcessMessages;

   if Edit1.text='' then
   begin
      beep;
      showmessage('半角数字で20桁以内の正の数を入力してください。');
      Edit1.SetFocus;
      exit;
   end;

   H:= length(Edit1.text);
   K:= ansipos('.',Edit1.text);

   if K=0 then
   begin
      if H>20 then
      begin
         beep;
         showmessage('半角数字で20桁以内の正の数を入力してください。');
         Edit1.SetFocus;
         exit;
      end;
   end
   else
   begin
      if K=1 then
      begin
         if H>20 then
         begin
            beep;
            showmessage('位取り表示のための 0 も含めて半角数字で20桁以内の正の数を入力してください。');
            Edit1.SetFocus;
            exit;
         end;
      end
      else
      begin
         if H>21 then
         begin
            beep;
            showmessage('位取り表示のための 0 も含めて半角数字で20桁以内の正の数を入力してください。');
            Edit1.SetFocus;
            exit;
         end;
      end;
   end;

   if K=0 then
      CC:= Edit1.text
   else
      CC:= copy(Edit1.text,1,K-1)+copy(Edit1.text,K+1,H-K);

   for N:=1 to length(CC) do
      if (ansicomparestr(copy(CC,N,1),'0')<0) or (ansicomparestr(copy(CC,N,1),'9')>0) then
      begin
         beep;
         showmessage('半角数字で20桁以内の正の数を入力してください。');
         Edit1.SetFocus;
         exit;
      end;

   if StrToFloat(Edit1.text)<=0 then
   begin
      beep;
      showmessage('半角数字で20桁以内の正の数を入力してください。');
      Edit1.SetFocus;
      exit;
   end;

   if StrToFloat(Edit1.text)=1 then
   begin
      VV:= '0';
      goto jmp1;
   end;

   ketakazu:= 100;

   for N:=1 to length(Edit1.text) do
   begin
       if copy(Edit1.text,N,1)<>'0' then break;
   end;

   if copy(Edit1.text,N,1)='.' then
   begin
      if N=1 then
      begin
         R:= '0'+Edit1.text;
      end
      else
      begin
         R:= copy(Edit1.text,N-1,length(Edit1.text)-N+2);
      end;
   end
   else
   begin
      R:= copy(Edit1.text,N,length(Edit1.text)-N+1);
   end;

   for N:=length(R) downto 1 do
   begin
      if copy(R,N,1)<>'0' then break;
   end;

   L:= ansipos('.',R);
   if L<>0 then
   begin
      if copy(R,N,1)='.' then
      begin
         R:= copy(R,1,N-1);
      end
      else
      begin
         R:= copy(R,1,N);
      end;
   end;

   L:= ansipos('.',R);

   if L=0 then
   begin
      RR:= copy(R,1,1)+'.'+copy(R,2,length(R)-1);
      RRR:= IntToStr(length(R)-1)+'.'+StringOfChar('0',ketakazu);
   end
   else
   begin
      if copy(R,1,1)='0' then
      begin
         for N:=1 to length(R) do
         begin
            if (copy(R,N,1)<>'0') and (copy(R,N,1)<>'.') then break;
         end;

         RR:= copy(R,N,1)+'.'+copy(R,N+1,length(R)-N);
         RRR:= IntToStr(N-2)+'.'+StringOfChar('0',ketakazu);
      end
      else
      begin
         if L=2 then
         begin
            RR:= R;
            RRR:= IntToStr(0)+'.'+StringOfChar('0',ketakazu);
         end
         else
         begin
            RR:= copy(R,1,1)+'.'+copy(R,2,L-2)+copy(R,L+1,length(R)-L);
            RRR:= IntToStr(L-2)+'.'+StringOfChar('0',ketakazu);
         end;
      end;
   end;

   II:= '1.0000000000000000000000';

   K:= ansipos('.',RR);
   L:= ansipos('.',II);
   if K<L then RR:= StringOfChar('0',L-K)+RR;
   if K>L then II:= StringOfChar('0',K-L)+II;
   K:= ansipos('.',RR);
   ZZ:= copy(RR,1,K-1)+copy(RR,K+1,length(RR)-K);
   WW:= copy(II,1,K-1)+copy(II,K+1,length(II)-K);

   if length(ZZ)<length(WW) then
   begin
      U:= length(ZZ);
   end
   else
   begin
      U:= length(WW);
   end;

   setlength(ZZZ,U+1);
   setlength(WWW,U+1);
   setlength(XXX,U+1);
   for N:=1 to U do ZZZ[N]:= strtoint(copy(ZZ,N,1));
   for N:=1 to U do WWW[N]:= strtoint(copy(WW,N,1));
   HIKU(ZZZ,WWW,XXX,U);
   ZZZZ:= '';
   for N:=1 to U do ZZZZ:=ZZZZ+IntToStr(XXX[N]);
   WW:= copy(ZZZZ,1,K-1)+'.'+copy(ZZZZ,K,U-K+1);

   for N:=1 to length(WW) do
   begin
      if copy(WW,N,1)<>'0' then break;
   end;

   if copy(WW,N,1)='.' then
   begin
      SS:= copy(WW,N-1,length(WW)-N+2);
   end
   else
   begin
      SS:= copy(WW,N,length(WW)-N+1);
   end;

   K:= ansipos('.',RR);
   L:= ansipos('.',II);
   if K<L then RR:= StringOfChar('0',L-K)+RR;
   if K>L then II:= StringOfChar('0',K-L)+II;
   K:= ansipos('.',RR);
   ZZ:= copy(RR,1,K-1)+copy(RR,K+1,length(RR)-K);
   WW:= copy(II,1,K-1)+copy(II,K+1,length(II)-K);

   if length(ZZ)<length(WW) then
   begin
      U:= length(ZZ);
   end
   else
   begin
      U:= length(WW);
   end;

   setlength(ZZZ,U+1);
   setlength(WWW,U+1);
   setlength(XXX,U+1);
   for N:=1 to U do ZZZ[N]:= strtoint(copy(ZZ,N,1));
   for N:=1 to U do WWW[N]:= strtoint(copy(WW,N,1));

   TASU(ZZZ,WWW,XXX,U);
   ZZZZ:= '';
   for N:=0 to U do ZZZZ:=ZZZZ+IntToStr(XXX[N]);

   if XXX[0]=1 then
   begin
      TT:= copy(ZZZZ,1,K)+'.'+copy(ZZZZ,K+1,U-K+1);
   end
   else
   begin
      TT:= copy(ZZZZ,2,K-1)+'.'+copy(ZZZZ,K+1,U-K+1);
   end;

   WARIZAN(SS, TT, YY, ketakazu);
   P:= YY;

   K:= ansipos('.',P);
   if K= 0 then
      A:= P
   else
      A:= copy(P,1,K-1)+copy(P,K+1,length(P)-K);

   B:=A;
   AA:=length(A);
   BB:=length(B);
   setlength(AAA,AA+1);
   setlength(BBB,BB+1);

   for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
   for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

   setlength(XXX,AA+BB+1);
   KAKERU(AAA,BBB,XXX,AA,BB);
   PP:='';
   for N:=AA downto 1 do PP:=PP+inttostr(XXX[N]);
   setlength(E,ketakazu+3);
   setlength(V,ketakazu+3);

   if length(PP)<ketakazu+2 then
   begin
      for N:=1 to length(PP) do E[N]:= strtoint(copy(PP,N,1));
   end
   else
   begin
      for N:=1 to ketakazu+2 do E[N]:= strtoint(copy(PP,N,1));
   end;

   WARU(E,3,V,ketakazu+2);
   V[1]:= 1;
   setlength(ZZZ,ketakazu+1);
   for N:=1 to ketakazu do ZZZ[N]:= V[N];
   PPPP:= PP;

   M:= 5;
   while M>0 do
   begin
      A:=copy(PPPP,1,ketakazu);
      B:=copy(PP,1,ketakazu);
      AA:=length(A);
      BB:=length(B);
      setlength(AAA,AA+1);
      setlength(BBB,BB+1);

      for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
      for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

      setlength(XXX,AA+BB+1);
      KAKERU(AAA,BBB,XXX,AA,BB);
      PPPP:='';
      for N:=AA downto 1 do PPPP:=PPPP+inttostr(XXX[N]);
      setlength(E,ketakazu+3);
      setlength(V,ketakazu+3);

      if length(PPPP)<ketakazu+2 then
      begin
         for N:=1 to length(PPPP) do E[N]:= strtoint(copy(PPPP,N,1));
      end
      else
      begin
         for N:=1 to ketakazu+2 do E[N]:= strtoint(copy(PPPP,N,1));
      end;

      WARU(E,M,V,ketakazu+2);
      I:=0;
      for N:=1 to ketakazu do
      begin
         if V[N]<>0 then
         begin
            I:=1;
            break;
         end;
      end;

      if I=0 then break;

      setlength(XXX,ketakazu+1);
      TASU(ZZZ,V,XXX,ketakazu);
      for N:=1 to ketakazu do ZZZ[N]:= XXX[N];
      Z:= '';
      for N:=1 to ketakazu do Z:= Z+inttostr(ZZZ[N]);
      M:= M+2;
   end;

   K:= ansipos('.',P);
   if K= 0 then
      A:= P
   else
      A:= copy(P,1,K-1)+copy(P,K+1,length(P)-K);

   B:=Z;
   AA:=length(A);
   BB:=length(B);
   setlength(AAA,AA+1);
   setlength(BBB,BB+1);

   for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
   for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

   setlength(XXX,AA+BB+1);
   KAKERU(AAA,BBB,XXX,AA,BB);
   Y:='';
   for N:=AA downto 1 do Y:=Y+inttostr(XXX[N]);

   A:=Y;
   B:='2';
   AA:=length(A);
   BB:=length(B);
   setlength(AAA,AA+1);
   setlength(BBB,BB+1);

   for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
   for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

   setlength(XXX,AA+BB+1);
   KAKERU(AAA,BBB,XXX,AA,BB);
   Y:='';
   for N:=AA downto 1 do Y:=Y+inttostr(XXX[N]);
   YY:= copy(Y,1,1)+'.'+copy(Y,2,ketakazu);

   TTT:= '2.302585092994045684017991454684364207601101488628772976033327900967572609677352480235997205089598298';
   WARIZAN(YY, TTT, YYY, ketakazu);

   if StrToFloat(R)>1 then
   begin
      K:= ansipos('.',YYY);
      L:= ansipos('.',RRR);
      if K<L then YYY:= StringOfChar('0',L-K)+YYY;
      if K>L then RRR:= StringOfChar('0',K-L)+RRR;
      K:= ansipos('.',YYY);
      ZZ:= copy(YYY,1,K-1)+copy(YYY,K+1,length(YYY)-K);
      WW:= copy(RRR,1,K-1)+copy(RRR,K+1,length(RRR)-K);

      if length(ZZ)<length(WW) then
      begin
         U:= length(ZZ);
      end
      else
      begin
         U:= length(WW);
      end;

      setlength(ZZZ,U+1);
      setlength(WWW,U+1);
      setlength(XXX,U+1);
      for N:=1 to U do ZZZ[N]:= strtoint(copy(ZZ,N,1));
      for N:=1 to U do WWW[N]:= strtoint(copy(WW,N,1));

      TASU(ZZZ,WWW,XXX,U);
      ZZZZ:= '';
      for N:=0 to U do ZZZZ:=ZZZZ+IntToStr(XXX[N]);

      if XXX[0]=1 then
      begin
         Z:= copy(ZZZZ,1,K)+'.'+copy(ZZZZ,K+1,U-K+1);
      end
      else
      begin
         Z:= copy(ZZZZ,2,K-1)+'.'+copy(ZZZZ,K+1,U-K+1);
      end;
   end
   else
   begin
      K:= ansipos('.',RRR);
      L:= ansipos('.',YYY);
      if K<L then RRR:= StringOfChar('0',L-K)+RRR;
      if K>L then YYY:= StringOfChar('0',K-L)+YYY;
      K:= ansipos('.',RRR);
      ZZ:= copy(RRR,1,K-1)+copy(RRR,K+1,length(RRR)-K);
      WW:= copy(YYY,1,K-1)+copy(YYY,K+1,length(YYY)-K);

      if length(ZZ)<length(WW) then
      begin
         U:= length(ZZ);
      end
      else
      begin
         U:= length(WW);
      end;

      setlength(ZZZ,U+1);
      setlength(WWW,U+1);
      setlength(XXX,U+1);
      for N:=1 to U do ZZZ[N]:= strtoint(copy(ZZ,N,1));
      for N:=1 to U do WWW[N]:= strtoint(copy(WW,N,1));
      HIKU(ZZZ,WWW,XXX,U);
      ZZZZ:= '';
      for N:=1 to U do ZZZZ:=ZZZZ+IntToStr(XXX[N]);
      WW:= copy(ZZZZ,1,K-1)+'.'+copy(ZZZZ,K,U-K+1);

      for N:=1 to length(WW) do
      begin
         if copy(WW,N,1)<>'0' then break;
      end;

      if copy(WW,N,1)='.' then
      begin
         XX:= copy(WW,N-1,length(WW)-N+2);
      end
      else
      begin
         XX:= copy(WW,N,length(WW)-N+1);
      end;

      Z:= XX;
   end;

   K:= ansipos('.',TTT);
   A:= copy(TTT,1,K-1)+copy(TTT,K+1,length(TTT)-K);

   L:= ansipos('.',Z);
   if L= 0 then
      B:= Z
   else
      B:= copy(Z,1,L-1)+copy(Z,L+1,length(Z)-L);

   AA:=length(A);
   BB:=length(B);
   setlength(AAA,AA+1);
   setlength(BBB,BB+1);

   for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
   for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

   setlength(XXX,AA+BB+1);
   KAKERU(AAA,BBB,XXX,AA,BB);
   PP:='';
   for N:=AA downto 1 do PP:=PP+inttostr(XXX[N]);

   if (K<>0) and (L<>0) then
   begin
      F:= AA-length(TTT)-length(Z)+K+L;
   end
   else
   begin
      if (K<>0) and (L=0)  then
      begin
         F:= AA-length(TTT)+K;
      end
      else
      begin
         if (K=0)  and (L<>0) then
         begin
            F:= AA-length(Z)+L;
         end
         else
         begin
            F:= AA;
         end;
      end;
   end;

   PPP:= copy(PP,1,F)+'.'+copy(PP,F+1,AA-F);

   if StrToFloat(Edit1.text)<1 then PPP:= '−'+PPP;

   K:= ansipos('.',PPP);
   VV:= copy(PPP,1,K)+copy(PPP,K+1,50);

jmp1:
   Edit2.text:= VV;

   beep;
   if MessageDlg('計算完了。　計算結果を保存または印刷しますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
   begin
         try
            if DirectoryExists('C:\Temp')=False then MkDir('C:\Temp');
            AssignFile(file1,'C:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,Edit1.text+'の自然対数');
            WriteLn(file1,VV);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が C:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('C:\windows\notepad.exe C:\Temp\Temp.txt',SW_SHOW);
            end;
         except
            if DirectoryExists('A:\Temp')=False then MkDir('A:\Temp');
            AssignFile(file1,'A:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,Edit1.text+'の自然対数');
            WriteLn(file1,VV);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が A:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('A:\windows\notepad.exe A:\Temp\Temp.txt',SW_SHOW);
            end;
         end;
   end;
   Edit1.SetFocus;
end;

procedure Tfrm_sizentaisuu.Button2Click(Sender: TObject);
begin
   frm_sizentaisuu.Close;

end;

procedure Tfrm_sizentaisuu.FormShow(Sender: TObject);
begin
   Edit1.SetFocus;
   Edit1.Clear;
   Edit2.Clear;

end;

procedure Tfrm_sizentaisuu.Edit1Change(Sender: TObject);
begin
   Edit2.Clear;

end;

end.

*****************************************************************************************

常用対数を求めるソースコード

unit jouyoutaisuu;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  Tfrm_jouyoutaisuu = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Label2: TLabel;
    Label1: TLabel;
    Label4: TLabel;
    Button2: TButton;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  frm_jouyoutaisuu: Tfrm_jouyoutaisuu;

implementation

{$R *.dfm}

procedure KAKERU(A,B:array of byte; var X:array of byte; var AA:integer; BB:integer);
//かけ算のサブプロシージャ   A×B＝X
var XX:array of array of byte;
var C,J,N:integer;
var Q:byte;

begin
   setlength(XX,BB+1,AA+BB+1);
   for J:= 1 to BB do
   begin
      Q:=0;
      for N:= 1 to AA do
      begin
         C:= A[N]*B[J]+Q;
         XX[J,N+J-1]:= C mod 10;
         Q:= C div 10;
      end;
      XX[J,AA+J]:= Q;
   end;

   Q:= 0;
   for N:= 1 to AA+BB do
   begin
      C:= 0;
      for J:= 1 to BB do C:= C+XX[J,N];
      C:= C+Q;
      X[N]:= C mod 10;
      Q:= C div 10;
   end;

   if X[AA+BB]=0 then AA:= AA+BB-1 else AA:= AA+BB;
end;

procedure WARIZAN(AAAA:string; BBBB:string; var YY:string; ketasuu:integer);
//割り算のサブプロシージャ   AAAA÷BBBB=YY
var A,B:array[1..202] of byte; C:array[1..1202] of byte; X:array[1..1000] of byte;
var D,E,F,G,J,N,Q,S,T:integer;
var AA,BB,H,K,P,U,V,Z:byte;
var AAA,BBB,CC,XX:string;

begin
   for N:= 1 to length(AAAA) do
      if copy(AAAA,N,1)<>'0' then
      begin
         AAAA:= copy(AAAA,N,length(AAAA)-N+1);
         break;
      end;

   E:=0;
   K:= ansipos('.',AAAA);
   if K= 0 then
   begin
      AAA:= AAAA;
      E:= length(AAA);
   end;

   if K= 1 then
      for N:= 2 to length(AAAA) do
         if copy(AAAA,N,1)<>'0' then
         begin
            AAA:= copy(AAAA,N,length(AAAA)-N+1);
            E:= 2-N;
            break;
         end;

   if K>= 2 then
   begin
      AAA:= copy(AAAA,1,K-1)+copy(AAAA,K+1,length(AAAA)-K);
      E:= K-1;
   end;

   for N:= 1 to length(BBBB) do
      if copy(BBBB,N,1)<>'0' then
      begin
         BBBB:= copy(BBBB,N,length(BBBB)-N+1);
         break;
      end;

   F:=0;
   K:= ansipos('.',BBBB);
   if K= 0 then
   begin
      BBB:= BBBB;
      F:= length(BBB);
   end;

   if K= 1 then
      for N:= 2 to length(BBBB) do
         if copy(BBBB,N,1)<>'0' then
         begin
            BBB:= copy(BBBB,N,length(BBBB)-N+1);
            F:= 2-N;
            break;
         end;

   if K>= 2 then
   begin
      BBB:= copy(BBBB,1,K-1)+copy(BBBB,K+1,length(BBBB)-K);
      F:= K-1;
   end;

   G:= E-F+1;
   AA:= length(AAA);
   BB:= length(BBB);
   T:= AA-BB+1;

   for N:=1 to 202 do
   begin
      A[N]:= 0; B[N]:= 0;
   end;

   for N:=1 to 1202 do
   begin
      C[N]:= 0;
   end;

   for N:=1 to 1000 do
   begin
      X[N]:= 0;
   end;

   for N:=1 to AA do
      C[N]:= strtoint(copy(AAA,N,1));

   for N:=1 to BB do
      A[N]:= C[BB-N+1];

   for N:=1 to BB do
      B[N]:= strtoint(copy(BBB,BB-N+1,1));

   S:= 0;

   repeat
      P:= 0;
      repeat
         Z:= 0;
         if A[BB+1]<>0 then
         begin
            Q:= 1;
            for N:=1 to BB+1 do
            begin
               D:= 10+A[N]-1+Q-B[N];
               A[N]:= D mod 10;
               Q:= D div 10;
            end;

            P:= P+1;
         end
         else
         begin
            V:= 0;
            for N:=BB downto 1 do
            begin
               if B[N]<A[N] then
               begin
                  V:= 1;
                  Q:= 1;
                  for J:=1 to BB do
                  begin
                     D:= 10+A[J]-1+Q-B[J];
                     A[J]:= D mod 10;
                     Q:= D div 10;
                  end;

                  P:= P+1;
                  break;
               end
               else if B[N]>A[N] then
               begin
                  V:= 1;
                  S:= S+1;
                  X[S]:= P;
                  if S= ketasuu then
                  begin
                     Z:= 2;
                     break;
                  end;

                  if (T<=0) or ((T>0) and (S>=T)) then
                  begin
                     U:=0;
                     for J:=BB downto 1 do
                        if A[J]<>0 then
                        begin
                           U:=1;
                           break;
                        end;

                     if U=0 then
                     begin
                        Z:= 2;
                        break;
                     end;

                     for J:=BB downto 1 do
                        A[J+1]:= A[J];

                     A[1]:= C[BB+S];
                     Z:= 1;
                  end
                  else
                  begin
                     for J:=BB downto 1 do
                        A[J+1]:= A[J];

                     A[1]:= C[BB+S];
                     Z:= 1;
                  end;
                  break;
               end;
            end;

            if V=0 then
            begin
               P:= P+1;
               for N:=BB downto 1 do
                  A[N]:= 0;

            end;
         end;
         if (Z=1) or (Z=2) then break;
      until S=-1;
      if Z=2 then break;
   until S=-1;

   XX:='';
   for N:= 1 to S do
      XX:= XX+inttostr(X[N]);

   if (G>0) and (S=G) then
   begin
      YY:= XX;
      if copy(YY,1,1)='0' then YY:= copy(YY,2,S-1);
   end;

   if (G>0) and (S<G) then
   begin
      YY:= XX+stringofchar('0',G-S);
      if copy(YY,1,1)='0' then YY:= copy(YY,2,G-1);
   end;

   if (G>0) and (S>G) then
   begin
      YY:= copy(XX,1,G)+'.'+copy(XX,G+1,BB-1+S-G);
      if G<>1 then
         if copy(YY,1,1)='0' then YY:= copy(YY,2,BB-1+S);
   end;

   if G<=0 then
      YY:= '0.'+stringofchar('0',-G)+XX;
end;

procedure WARU(A:array of byte; B:integer; var X:array of byte; ketasuu:integer);
//割り算のサブプロシージャ   A/B=X
var D,K,N,RR:integer;
var C:string;

begin
   K:=length(inttostr(B));
   C:='';
   for N:=1 to K do
      C:=C+inttostr(A[N]);

   D:=strtoint(C);

   for N:=0 to ketasuu do
      X[N]:=0;
      
   for N:=0 to ketasuu-1-k do
   begin
      X[K+N]:=D div B;
      RR:=D-B*X[K+N];
      D:=RR*10+A[K+1+N];
   end;
end;

procedure TASU(A,B:array of byte; var X:array of byte; ketasuu:integer);
//足し算のサブプロシージャ   A+B=X
var C,N,Q:integer;
begin
   for N:=0 to ketasuu do
      X[N]:=0;

   Q:=0;
   for N:=ketasuu downto 0 do
   begin
      C:=A[N]+B[N]+Q;
      X[N]:=C mod 10;
      Q:=C div 10;
   end;
end;

procedure HIKU(A,B:array of byte; var X:array of byte; ketasuu:integer);
//引き算のサブプロシージャ   A-B=X
var C,N,Q:integer;
begin
   for N:=0 to ketasuu do
      X[N]:=0;

   Q:=1;
   for N:=ketasuu downto 1 do
   begin
      C:=10+A[N]-1+Q-B[N];
      X[N]:=C mod 10;
      Q:=C div 10;
   end;
end;

procedure Tfrm_jouyoutaisuu.Button1Click(Sender: TObject);
var AAA,BBB,E,V,WWW,XXX,ZZZ:array of byte;
var AA,BB,M,N,ketakazu:integer;
var S,T:extended;
var H,I,K,L,U:byte;
var A,B,CC,II,R,RR,RRR,SS,TT,TTT,P,PP,PPP,PPPP,WW,XX,Y,YY,YYY,Z,ZZ,ZZZZ:string;
var file1:textfile;
label jmp1;

begin
   Edit2.Clear;
   application.ProcessMessages;

   if Edit1.text='' then
   begin
      beep;
      showmessage('半角数字で20桁以内の正の数を入力してください。');
      Edit1.SetFocus;
      exit;
   end;

   H:= length(Edit1.text);
   K:= ansipos('.',Edit1.text);

   if K=0 then
   begin
      if H>20 then
      begin
         beep;
         showmessage('半角数字で20桁以内の正の数を入力してください。');
         Edit1.SetFocus;
         exit;
      end;
   end
   else
   begin
      if K=1 then
      begin
         if H>20 then
         begin
            beep;
            showmessage('位取り表示のための 0 も含めて半角数字で20桁以内の正の数を入力してください。');
            Edit1.SetFocus;
            exit;
         end;
      end
      else
      begin
         if H>21 then
         begin
            beep;
            showmessage('位取り表示のための 0 も含めて半角数字で20桁以内の正の数を入力してください。');
            Edit1.SetFocus;
            exit;
         end;
      end;
   end;

   if K=0 then
      CC:= Edit1.text
   else
      CC:= copy(Edit1.text,1,K-1)+copy(Edit1.text,K+1,H-K);

   for N:=1 to length(CC) do
      if (ansicomparestr(copy(CC,N,1),'0')<0) or (ansicomparestr(copy(CC,N,1),'9')>0) then
      begin
         beep;
         showmessage('半角数字で20桁以内の正の数を入力してください。');
         Edit1.SetFocus;
         exit;
      end;

   if StrToFloat(Edit1.text)<=0 then
   begin
      beep;
      showmessage('半角数字で20桁以内の正の数を入力してください。');
      Edit1.SetFocus;
      exit;
   end;

   if StrToFloat(Edit1.text)=1 then
   begin
      Z:= '0';
      goto jmp1;
   end;

   ketakazu:= 100;

   for N:=1 to length(Edit1.text) do
   begin
       if copy(Edit1.text,N,1)<>'0' then break;
   end;

   if copy(Edit1.text,N,1)='.' then
   begin
      if N=1 then
      begin
         R:= '0'+Edit1.text;
      end
      else
      begin
         R:= copy(Edit1.text,N-1,length(Edit1.text)-N+2);
      end;
   end
   else
   begin
      R:= copy(Edit1.text,N,length(Edit1.text)-N+1);
   end;

   for N:=length(R) downto 1 do
   begin
      if copy(R,N,1)<>'0' then break;
   end;

   L:= ansipos('.',R);
   if L<>0 then
   begin
      if copy(R,N,1)='.' then
      begin
         R:= copy(R,1,N-1);
      end
      else
      begin
         R:= copy(R,1,N);
      end;
   end;

   L:= ansipos('.',R);

   if L=0 then
   begin
      RR:= copy(R,1,1)+'.'+copy(R,2,length(R)-1);
      RRR:= IntToStr(length(R)-1)+'.'+StringOfChar('0',ketakazu);
   end
   else
   begin
      if copy(R,1,1)='0' then
      begin
         for N:=1 to length(R) do
         begin
            if (copy(R,N,1)<>'0') and (copy(R,N,1)<>'.') then break;
         end;

         RR:= copy(R,N,1)+'.'+copy(R,N+1,length(R)-N);
         RRR:= IntToStr(N-2)+'.'+StringOfChar('0',ketakazu);
      end
      else
      begin
         if L=2 then
         begin
            RR:= R;
            RRR:= IntToStr(0)+'.'+StringOfChar('0',ketakazu);
         end
         else
         begin
            RR:= copy(R,1,1)+'.'+copy(R,2,L-2)+copy(R,L+1,length(R)-L);
            RRR:= IntToStr(L-2)+'.'+StringOfChar('0',ketakazu);
         end;
      end;
   end;

   II:= '1.0000000000000000000000';

   K:= ansipos('.',RR);
   L:= ansipos('.',II);
   if K<L then RR:= StringOfChar('0',L-K)+RR;
   if K>L then II:= StringOfChar('0',K-L)+II;
   K:= ansipos('.',RR);
   ZZ:= copy(RR,1,K-1)+copy(RR,K+1,length(RR)-K);
   WW:= copy(II,1,K-1)+copy(II,K+1,length(II)-K);

   if length(ZZ)<length(WW) then
   begin
      U:= length(ZZ);
   end
   else
   begin
      U:= length(WW);
   end;

   setlength(ZZZ,U+1);
   setlength(WWW,U+1);
   setlength(XXX,U+1);
   for N:=1 to U do ZZZ[N]:= strtoint(copy(ZZ,N,1));
   for N:=1 to U do WWW[N]:= strtoint(copy(WW,N,1));
   HIKU(ZZZ,WWW,XXX,U);
   ZZZZ:= '';
   for N:=1 to U do ZZZZ:=ZZZZ+IntToStr(XXX[N]);
   WW:= copy(ZZZZ,1,K-1)+'.'+copy(ZZZZ,K,U-K+1);

   for N:=1 to length(WW) do
   begin
      if copy(WW,N,1)<>'0' then break;
   end;

   if copy(WW,N,1)='.' then
   begin
      SS:= copy(WW,N-1,length(WW)-N+2);
   end
   else
   begin
      SS:= copy(WW,N,length(WW)-N+1);
   end;

   K:= ansipos('.',RR);
   L:= ansipos('.',II);
   if K<L then RR:= StringOfChar('0',L-K)+RR;
   if K>L then II:= StringOfChar('0',K-L)+II;
   K:= ansipos('.',RR);
   ZZ:= copy(RR,1,K-1)+copy(RR,K+1,length(RR)-K);
   WW:= copy(II,1,K-1)+copy(II,K+1,length(II)-K);

   if length(ZZ)<length(WW) then
   begin
      U:= length(ZZ);
   end
   else
   begin
      U:= length(WW);
   end;

   setlength(ZZZ,U+1);
   setlength(WWW,U+1);
   setlength(XXX,U+1);
   for N:=1 to U do ZZZ[N]:= strtoint(copy(ZZ,N,1));
   for N:=1 to U do WWW[N]:= strtoint(copy(WW,N,1));

   TASU(ZZZ,WWW,XXX,U);
   ZZZZ:= '';
   for N:=0 to U do ZZZZ:=ZZZZ+IntToStr(XXX[N]);

   if XXX[0]=1 then
   begin
      TT:= copy(ZZZZ,1,K)+'.'+copy(ZZZZ,K+1,U-K+1);
   end
   else
   begin
      TT:= copy(ZZZZ,2,K-1)+'.'+copy(ZZZZ,K+1,U-K+1);
   end;

   WARIZAN(SS, TT, YY, ketakazu);
   P:= YY;

   K:= ansipos('.',P);
   if K= 0 then
      A:= P
   else
      A:= copy(P,1,K-1)+copy(P,K+1,length(P)-K);

   B:=A;
   AA:=length(A);
   BB:=length(B);
   setlength(AAA,AA+1);
   setlength(BBB,BB+1);

   for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
   for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

   setlength(XXX,AA+BB+1);
   KAKERU(AAA,BBB,XXX,AA,BB);
   PP:='';
   for N:=AA downto 1 do PP:=PP+inttostr(XXX[N]);
   setlength(E,ketakazu+3);
   setlength(V,ketakazu+3);

   if length(PP)<ketakazu+2 then
   begin
      for N:=1 to length(PP) do E[N]:= strtoint(copy(PP,N,1));
   end
   else
   begin
      for N:=1 to ketakazu+2 do E[N]:= strtoint(copy(PP,N,1));
   end;

   WARU(E,3,V,ketakazu+2);
   V[1]:= 1;
   setlength(ZZZ,ketakazu+1);
   for N:=1 to ketakazu do ZZZ[N]:= V[N];
   PPPP:= PP;

   M:= 5;
   while M>0 do
   begin
      A:=copy(PPPP,1,ketakazu);
      B:=copy(PP,1,ketakazu);
      AA:=length(A);
      BB:=length(B);
      setlength(AAA,AA+1);
      setlength(BBB,BB+1);

      for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
      for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

      setlength(XXX,AA+BB+1);
      KAKERU(AAA,BBB,XXX,AA,BB);
      PPPP:='';
      for N:=AA downto 1 do PPPP:=PPPP+inttostr(XXX[N]);
      setlength(E,ketakazu+3);
      setlength(V,ketakazu+3);

      if length(PPPP)<ketakazu+2 then
      begin
         for N:=1 to length(PPPP) do E[N]:= strtoint(copy(PPPP,N,1));
      end
      else
      begin
         for N:=1 to ketakazu+2 do E[N]:= strtoint(copy(PPPP,N,1));
      end;

      WARU(E,M,V,ketakazu+2);
      I:=0;
      for N:=1 to ketakazu do
      begin
         if V[N]<>0 then
         begin
            I:=1;
            break;
         end;
      end;

      if I=0 then break;

      setlength(XXX,ketakazu+1);
      TASU(ZZZ,V,XXX,ketakazu);
      for N:=1 to ketakazu do ZZZ[N]:= XXX[N];
      Z:= '';
      for N:=1 to ketakazu do Z:= Z+inttostr(ZZZ[N]);
      M:= M+2;
   end;

   K:= ansipos('.',P);
   if K= 0 then
      A:= P
   else
      A:= copy(P,1,K-1)+copy(P,K+1,length(P)-K);

   B:=Z;
   AA:=length(A);
   BB:=length(B);
   setlength(AAA,AA+1);
   setlength(BBB,BB+1);

   for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
   for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

   setlength(XXX,AA+BB+1);
   KAKERU(AAA,BBB,XXX,AA,BB);
   Y:='';
   for N:=AA downto 1 do Y:=Y+inttostr(XXX[N]);

   A:=Y;
   B:='2';
   AA:=length(A);
   BB:=length(B);
   setlength(AAA,AA+1);
   setlength(BBB,BB+1);

   for N:=1 to AA do AAA[N]:= strtoint(copy(A,AA-N+1,1));
   for N:=1 to BB do BBB[N]:= strtoint(copy(B,BB-N+1,1));

   setlength(XXX,AA+BB+1);
   KAKERU(AAA,BBB,XXX,AA,BB);
   Y:='';
   for N:=AA downto 1 do Y:=Y+inttostr(XXX[N]);
   YY:= copy(Y,1,1)+'.'+copy(Y,2,ketakazu);

   TTT:= '2.302585092994045684017991454684364207601101488628772976033327900967572609677352480235997205089598298';
   WARIZAN(YY, TTT, YYY, ketakazu);

   if StrToFloat(R)>1 then
   begin
      K:= ansipos('.',YYY);
      L:= ansipos('.',RRR);
      if K<L then YYY:= StringOfChar('0',L-K)+YYY;
      if K>L then RRR:= StringOfChar('0',K-L)+RRR;
      K:= ansipos('.',YYY);
      ZZ:= copy(YYY,1,K-1)+copy(YYY,K+1,length(YYY)-K);
      WW:= copy(RRR,1,K-1)+copy(RRR,K+1,length(RRR)-K);

      if length(ZZ)<length(WW) then
      begin
         U:= length(ZZ);
      end
      else
      begin
         U:= length(WW);
      end;

      setlength(ZZZ,U+1);
      setlength(WWW,U+1);
      setlength(XXX,U+1);
      for N:=1 to U do ZZZ[N]:= strtoint(copy(ZZ,N,1));
      for N:=1 to U do WWW[N]:= strtoint(copy(WW,N,1));

      TASU(ZZZ,WWW,XXX,U);
      ZZZZ:= '';
      for N:=0 to U do ZZZZ:=ZZZZ+IntToStr(XXX[N]);

      if XXX[0]=1 then
      begin
         Z:= copy(ZZZZ,1,K)+'.'+copy(ZZZZ,K+1,U-K+1);
      end
      else
      begin
         Z:= copy(ZZZZ,2,K-1)+'.'+copy(ZZZZ,K+1,U-K+1);
      end;
   end
   else
   begin
      K:= ansipos('.',RRR);
      L:= ansipos('.',YYY);
      if K<L then RRR:= StringOfChar('0',L-K)+RRR;
      if K>L then YYY:= StringOfChar('0',K-L)+YYY;
      K:= ansipos('.',RRR);
      ZZ:= copy(RRR,1,K-1)+copy(RRR,K+1,length(RRR)-K);
      WW:= copy(YYY,1,K-1)+copy(YYY,K+1,length(YYY)-K);

      if length(ZZ)<length(WW) then
      begin
         U:= length(ZZ);
      end
      else
      begin
         U:= length(WW);
      end;

      setlength(ZZZ,U+1);
      setlength(WWW,U+1);
      setlength(XXX,U+1);
      for N:=1 to U do ZZZ[N]:= strtoint(copy(ZZ,N,1));
      for N:=1 to U do WWW[N]:= strtoint(copy(WW,N,1));
      HIKU(ZZZ,WWW,XXX,U);
      ZZZZ:= '';
      for N:=1 to U do ZZZZ:=ZZZZ+IntToStr(XXX[N]);
      WW:= copy(ZZZZ,1,K-1)+'.'+copy(ZZZZ,K,U-K+1);

      for N:=1 to length(WW) do
      begin
         if copy(WW,N,1)<>'0' then break;
      end;

      if copy(WW,N,1)='.' then
      begin
         XX:= copy(WW,N-1,length(WW)-N+2);
      end
      else
      begin
         XX:= copy(WW,N,length(WW)-N+1);
      end;

      Z:= '−'+XX;
   end;

   K:= ansipos('.',Z);
   Z:= copy(Z,1,K)+copy(Z,K+1,50);
   
   if (copy(Z,length(Z),1)='0') and (copy(Z,length(Z)-1,1)='.') then Z:= copy(Z,1,length(Z)-2);

jmp1:
   Edit2.text:= Z;

   beep;
   if MessageDlg('計算完了。　計算結果を保存または印刷しますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
   begin
         try
            if DirectoryExists('C:\Temp')=False then MkDir('C:\Temp');
            AssignFile(file1,'C:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,Edit1.text+'の常用対数');
            WriteLn(file1,Z);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が C:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('C:\windows\notepad.exe C:\Temp\Temp.txt',SW_SHOW);
            end;
         except
            if DirectoryExists('A:\Temp')=False then MkDir('A:\Temp');
            AssignFile(file1,'A:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,Edit1.text+'の常用対数');
            WriteLn(file1,Z);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が A:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('A:\windows\notepad.exe A:\Temp\Temp.txt',SW_SHOW);
            end;
         end;
   end;
   Edit1.SetFocus;
end;

procedure Tfrm_jouyoutaisuu.Button2Click(Sender: TObject);
begin
   frm_jouyoutaisuu.Close;

end;

procedure Tfrm_jouyoutaisuu.FormShow(Sender: TObject);
begin
   Edit1.SetFocus;
   Edit1.Clear;
   Edit2.Clear;

end;

procedure Tfrm_jouyoutaisuu.Edit1Change(Sender: TObject);
begin
   Edit2.Clear;

end;

end.

*****************************************************************************************

階乗を求めるソースコード

unit kaijou;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Printers, ComCtrls, Menus;

type
  Tfrm_kaijou = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    Memo2: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    RichEdit1: TRichEdit;
    PopupMenu1: TPopupMenu;
    Copy1: TMenuItem;
    Paste1: TMenuItem;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Copy1Click(Sender: TObject);
    procedure Paste1Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  frm_kaijou: Tfrm_kaijou;
  BLN:boolean;

implementation

{$R *.dfm}

procedure Tfrm_kaijou.FormShow(Sender: TObject);
begin
   RichEdit1.Clear;
   Memo2.Visible:=false;
   Edit1.SetFocus;
   Edit1.Clear;

end;

procedure Tfrm_kaijou.Button1Click(Sender: TObject);
var AAA,BBB,XXX:array of byte;
var CCC:array of array of byte;
var A,B,C,D,J,N,M,Q,Z:integer;
var BB,CC,XX:string;
var file1:textfile;

begin
   if BLN=true then
      BLN:=false
   else
   begin
      BLN:=true;
      RichEdit1.Clear;
      application.ProcessMessages;

      if Edit1.text='' then
      begin
         beep;
         showmessage('半角数字で 50000以下の自然数を入力してください。');
         Edit1.SetFocus;
         BLN:=false;
         exit;
      end;

      CC:= Edit1.text;
      for N:=1 to length(CC) do
         if (ansicomparestr(copy(CC,N,1),'0')<0) or (ansicomparestr(copy(CC,N,1),'9')>0) then
         begin
            beep;
            showmessage('半角数字で 50000以下の自然数を入力してください。');
            Edit1.SetFocus;
            BLN:=false;
            exit;
         end;

      if length(CC)>5 then
      begin
         beep;
         showmessage('入力文字数を5以下にしてください。');
         Edit1.SetFocus;
         BLN:=false;
         exit;
      end;

      if (strtoint(CC)>50000) or (strtoint(CC)<1) then
      begin
         beep;
         showmessage('半角数字で 50000以下の自然数を入力してください。');
         Edit1.SetFocus;
         BLN:=false;
         exit;
      end;

      RichEdit1.text:='';
      Memo2.Visible:=true;
      Button1.Caption:='計算中止';
      Button2.Visible:=false;

      Z:= strtoint(Edit1.text);
      setlength(AAA,2);
      AAA[1]:=1;
      D:=1;

      M:=1;

      while (BLN=true) and (M<=Z) do
      begin
         Memo2.Lines.Strings[0]:= inttostr(M);
         BB:=inttostr(M);
         A:=D;
         B:=length(BB);
         setlength(BBB,B+1);
         setlength(CCC,B+1,A+B+1);
         setlength(XXX,A+B+1);
         for N:= 1 to B do BBB[N]:= strtoint(copy(BB,B-N+1,1));
         for J:= 1 to B do
         begin
            Q:=0;
            for N:= 1 to A do
            begin
               C:=AAA[N]*BBB[J]+Q;
               CCC[J,N+J-1]:=C mod 10;
               Q:=C div 10;
            end;
            CCC[J,A+J]:=Q;
         end;

         Q:=0;

         for N:= 1 to A+B do
         begin
            C:=0;
            for J:= 1 to B do C:=C+CCC[J,N];
            C:=C+Q;
            XXX[N]:=C mod 10;
            Q:=C div 10;
         end;

         if XXX[A+B]=0 then D:=A+B-1 else D:=A+B;
         setlength(AAA,D+1);
         for N:= 1 to D do AAA[N]:=XXX[N];
         M:= M+1;
         application.ProcessMessages;
      end;

      if BLN=false then
      begin
         Button1.Caption:='計算開始';
         Button2.Visible:=true;
         exit;
      end;

      XX:=Edit1.text+' の階乗＝';
      for N:=D downto 1 do XX:=XX+inttostr(XXX[N]);

      XX:=XX+'    (桁数＝'+inttostr(D)+')';
      RichEdit1.Text:=XX;

      Button1.Caption:='計算開始';
      Button2.Visible:=true;
      BLN:=false;

      beep;
      if MessageDlg('計算完了。　計算結果を保存または印刷しますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
      begin
         try
            if DirectoryExists('C:\Temp')=False then MkDir('C:\Temp');
            AssignFile(file1,'C:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,Edit1.text+'の階乗');
            WriteLn(file1,XX+'    (桁数＝'+inttostr(D)+')');
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が C:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('C:\windows\notepad.exe C:\Temp\Temp.txt',SW_SHOW);
            end;
         except
            if DirectoryExists('A:\Temp')=False then MkDir('A:\Temp');
            AssignFile(file1,'A:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,Edit1.text+'の階乗');
            WriteLn(file1,XX+'    (桁数＝'+inttostr(D)+')');
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が A:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('A:\windows\notepad.exe A:\Temp\Temp.txt',SW_SHOW);
            end;
         end;
      end;
      Edit1.SetFocus;
   end;
end;

procedure Tfrm_kaijou.Button2Click(Sender: TObject);
begin
   frm_kaijou.Close;

end;

procedure Tfrm_kaijou.Copy1Click(Sender: TObject);
begin
   RichEdit1.CopyToClipboard;

end;

procedure Tfrm_kaijou.Paste1Click(Sender: TObject);
begin
   RichEdit1.PasteFromClipboard;
   
end;

procedure Tfrm_kaijou.Edit1Change(Sender: TObject);
begin
   Memo2.Visible:=false;
   RichEdit1.Clear;

end;

procedure Tfrm_kaijou.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   if BLN=true then BLN:=false;

end;

end.

*****************************************************************************************

順列の総数を求めるソースコード

unit junretu;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Printers, ComCtrls, Menus;

type
  Tfrm_junretu = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    Memo2: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    RichEdit1: TRichEdit;
    PopupMenu1: TPopupMenu;
    Copy1: TMenuItem;
    Paste1: TMenuItem;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Edit2: TEdit;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Copy1Click(Sender: TObject);
    procedure Paste1Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  frm_junretu: Tfrm_junretu;
  BLN:boolean;

implementation

{$R *.dfm}

procedure Tfrm_junretu.FormShow(Sender: TObject);
begin
   Edit1.SetFocus;
   Edit1.Clear;
   Edit2.Clear;
   RichEdit1.Clear;
   Memo2.Visible:=false;

end;

procedure Tfrm_junretu.Button1Click(Sender: TObject);
var AAA,BBB,XXX:array of byte;
var CCC:array of array of byte;
var A,B,C,D,J,N,M,Q,R,Z:integer;
var BB,CC,XX:string;
var file1:textfile;

begin
   if BLN=true then
      BLN:=false
   else
   begin
      BLN:=true;
      RichEdit1.Clear;
      application.ProcessMessages;

      if Edit1.text='' then
      begin
         beep;
         showmessage('半角数字で 50000以下の自然数を入力してください。');
         Edit1.SetFocus;
         BLN:=false;
         exit;
      end;

      CC:= Edit1.text;
      for N:=1 to length(CC) do
         if (ansicomparestr(copy(CC,N,1),'0')<0) or (ansicomparestr(copy(CC,N,1),'9')>0) then
         begin
            beep;
            showmessage('半角数字で 50000以下の自然数を入力してください。');
            Edit1.SetFocus;
            BLN:=false;
            exit;
         end;

      if length(CC)>5 then
      begin
         beep;
         showmessage('入力文字数を5以下にしてください。');
         Edit1.SetFocus;
         BLN:=false;
         exit;
      end;

      if (strtoint(CC)>50000) or (strtoint(CC)<1) then
      begin
         beep;
         showmessage('半角数字で 50000以下の自然数を入力してください。');
         Edit1.SetFocus;
         BLN:=false;
         exit;
      end;

      if Edit2.text='' then
      begin
         beep;
         showmessage('半角数字で 50000以下の自然数を入力してください。');
         Edit2.SetFocus;
         BLN:=false;
         exit;
      end;

      CC:= Edit2.text;
      for N:=1 to length(CC) do
         if (ansicomparestr(copy(CC,N,1),'0')<0) or (ansicomparestr(copy(CC,N,1),'9')>0) then
         begin
            beep;
            showmessage('半角数字で 50000以下の自然数を入力してください。');
            Edit2.SetFocus;
            BLN:=false;
            exit;
         end;

      if length(CC)>5 then
      begin
         beep;
         showmessage('入力文字数を5以下にしてください。');
         Edit2.SetFocus;
         BLN:=false;
         exit;
      end;

      if (strtoint(CC)>50000) or (strtoint(CC)<1) then
      begin
         beep;
         showmessage('半角数字で 50000以下の自然数を入力してください。');
         Edit2.SetFocus;
         BLN:=false;
         exit;
      end;

      if strtoint(Edit2.text)>strtoint(Edit1.text) then
      begin
         beep;
         showmessage('r は n 以下でなければなりません。');
         Edit2.SetFocus;
         BLN:=false;
         exit;
      end;

      RichEdit1.text:='';
      Memo2.Visible:=true;
      Button1.Caption:='計算中止';
      Button2.Visible:=false;

      Z:= strtoint(Edit1.text);
      R:= strtoint(Edit2.text);
      setlength(AAA,2);
      AAA[1]:=1;
      D:=1;

      M:=Z-R+1;

      while (BLN=true) and (M<=Z) do
      begin
         Memo2.Lines.Strings[0]:= inttostr(M);
         BB:=inttostr(M);
         A:=D;
         B:=length(BB);
         setlength(BBB,B+1);
         setlength(CCC,B+1,A+B+1);
         setlength(XXX,A+B+1);
         for N:= 1 to B do BBB[N]:= strtoint(copy(BB,B-N+1,1));
         for J:= 1 to B do
         begin
            Q:=0;
            for N:= 1 to A do
            begin
               C:=AAA[N]*BBB[J]+Q;
               CCC[J,N+J-1]:=C mod 10;
               Q:=C div 10;
            end;
            CCC[J,A+J]:=Q;
         end;

         Q:=0;

         for N:= 1 to A+B do
         begin
            C:=0;
            for J:= 1 to B do C:=C+CCC[J,N];
            C:=C+Q;
            XXX[N]:=C mod 10;
            Q:=C div 10;
         end;

         if XXX[A+B]=0 then D:=A+B-1 else D:=A+B;
         setlength(AAA,D+1);
         for N:= 1 to D do AAA[N]:=XXX[N];
         M:= M+1;
         application.ProcessMessages;
      end;

      if BLN=false then
      begin
         Button1.Caption:='計算開始';
         Button2.Visible:=true;
         exit;
      end;

      for N:=D downto 1 do XX:=XX+inttostr(XXX[N]);

      XX:=XX+'    (桁数＝'+inttostr(D)+')';
      RichEdit1.Text:=XX;

      Button1.Caption:='計算開始';
      Button2.Visible:=true;
      BLN:=false;

      beep;
      if MessageDlg('計算完了。　計算結果を保存または印刷しますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
      begin
         try
            if DirectoryExists('C:\Temp')=False then MkDir('C:\Temp');
            AssignFile(file1,'C:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,'異なる'+Edit1.text+'個のものから'+Edit2.text+'個とった順列の総数');
            WriteLn(file1,XX);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が C:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('C:\windows\notepad.exe C:\Temp\Temp.txt',SW_SHOW);
            end;
         except
            if DirectoryExists('A:\Temp')=False then MkDir('A:\Temp');
            AssignFile(file1,'A:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,'異なる'+Edit1.text+'個のものから'+Edit2.text+'個とった順列の総数');
            WriteLn(file1,XX);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が A:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('A:\windows\notepad.exe A:\Temp\Temp.txt',SW_SHOW);
            end;
         end;
      end;
      Edit1.SetFocus;
   end;
end;

procedure Tfrm_junretu.Button2Click(Sender: TObject);
begin
   frm_junretu.Close;

end;

procedure Tfrm_junretu.Copy1Click(Sender: TObject);
begin
   RichEdit1.CopyToClipboard;

end;

procedure Tfrm_junretu.Paste1Click(Sender: TObject);
begin
   RichEdit1.PasteFromClipboard;

end;

procedure Tfrm_junretu.Edit1Change(Sender: TObject);
begin
   Memo2.Visible:=false;
   RichEdit1.Clear;

end;

procedure Tfrm_junretu.Edit2Change(Sender: TObject);
begin
   Memo2.Visible:=false;
   RichEdit1.Clear;

end;

procedure Tfrm_junretu.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   if BLN=true then BLN:=false;

end;

end.

*****************************************************************************************

組合せの総数を求めるソースコード

unit kumiawase;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Printers, ComCtrls, Menus;

type
  Tfrm_kumiawase = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    Memo2: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    RichEdit1: TRichEdit;
    PopupMenu1: TPopupMenu;
    Copy1: TMenuItem;
    Paste1: TMenuItem;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Edit2: TEdit;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Copy1Click(Sender: TObject);
    procedure Paste1Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  frm_kumiawase: Tfrm_kumiawase;
  BLN:boolean;

implementation

{$R *.dfm}

procedure Tfrm_kumiawase.FormShow(Sender: TObject);
begin
   Edit1.SetFocus;
   Edit1.Clear;
   Edit2.Clear;
   RichEdit1.Clear;
   Memo2.Visible:=false;

end;

procedure Tfrm_kumiawase.Button1Click(Sender: TObject);
var AAA,BBB,X,XXX,YYY:array of byte;
var CCC:array of array of byte;
var A,AA,B,BBBB,C,D,J,N,M,Q,R,S,T,Z:integer;
var P,U,V:byte;
var BB,CC,XX:string;
var file1:textfile;

begin
   if BLN=true then
      BLN:=false
   else
   begin
      BLN:=true;
      RichEdit1.Clear;
      application.ProcessMessages;

      if Edit1.text='' then
      begin
         beep;
         showmessage('半角数字で 50000以下の自然数を入力してください。');
         Edit1.SetFocus;
         BLN:=false;
         exit;
      end;

      CC:= Edit1.text;
      for N:=1 to length(CC) do
         if (ansicomparestr(copy(CC,N,1),'0')<0) or (ansicomparestr(copy(CC,N,1),'9')>0) then
         begin
            beep;
            showmessage('半角数字で 50000以下の自然数を入力してください。');
            Edit1.SetFocus;
            BLN:=false;
            exit;
         end;

      if length(CC)>5 then
      begin
         beep;
         showmessage('入力文字数を5以下にしてください。');
         Edit1.SetFocus;
         BLN:=false;
         exit;
      end;

      if (strtoint(CC)>50000) or (strtoint(CC)<1) then
      begin
         beep;
         showmessage('半角数字で 50000以下の自然数を入力してください。');
         Edit1.SetFocus;
         BLN:=false;
         exit;
      end;

      if Edit2.text='' then
      begin
         beep;
         showmessage('半角数字で 50000以下の自然数を入力してください。');
         Edit2.SetFocus;
         BLN:=false;
         exit;
      end;

      CC:= Edit2.text;
      for N:=1 to length(CC) do
         if (ansicomparestr(copy(CC,N,1),'0')<0) or (ansicomparestr(copy(CC,N,1),'9')>0) then
         begin
            beep;
            showmessage('半角数字で 50000以下の自然数を入力してください。');
            Edit2.SetFocus;
            BLN:=false;
            exit;
         end;

      if length(CC)>5 then
      begin
         beep;
         showmessage('入力文字数を5以下にしてください。');
         Edit2.SetFocus;
         BLN:=false;
         exit;
      end;

      if (strtoint(CC)>50000) or (strtoint(CC)<1) then
      begin
         beep;
         showmessage('半角数字で 50000以下の自然数を入力してください。');
         Edit2.SetFocus;
         BLN:=false;
         exit;
      end;

      if strtoint(Edit2.text)>strtoint(Edit1.text) then
      begin
         beep;
         showmessage('r は n 以下でなければなりません。');
         Edit2.SetFocus;
         BLN:=false;
         exit;
      end;

      Z:= strtoint(Edit1.text);
      R:= strtoint(Edit2.text);

      if Z=R then
      begin
         beep;
         Button1.Caption:='計算開始';
         Button2.Visible:=true;
         Edit1.SetFocus;
         BLN:=false;
         RichEdit1.Text:='1    (桁数＝1)';
         exit;
      end;

      RichEdit1.text:='';
      Memo2.Visible:=true;
      Button1.Caption:='計算中止';
      Button2.Visible:=false;

      if R>Z-R then R:=Z-R;

      setlength(AAA,2);
      AAA[1]:=1;
      D:=1;

      M:=Z-R+1;

      while (BLN=true) and (M<=Z) do
      begin
         Memo2.Lines.Strings[0]:= inttostr(M);
         BB:=inttostr(M);
         A:=D;
         B:=length(BB);
         setlength(BBB,B+1);
         setlength(CCC,B+1,A+B+1);
         setlength(XXX,A+B+1);
         for N:= 1 to B do BBB[N]:= strtoint(copy(BB,B-N+1,1));
         for J:= 1 to B do
         begin
            Q:=0;
            for N:= 1 to A do
            begin
               C:=AAA[N]*BBB[J]+Q;
               CCC[J,N+J-1]:=C mod 10;
               Q:=C div 10;
            end;
            CCC[J,A+J]:=Q;
         end;

         Q:=0;

         for N:= 1 to A+B do
         begin
            C:=0;
            for J:= 1 to B do C:=C+CCC[J,N];
            C:=C+Q;
            XXX[N]:=C mod 10;
            Q:=C div 10;
         end;

         if XXX[A+B]=0 then D:=A+B-1 else D:=A+B;
         setlength(AAA,D+1);
         for N:= 1 to D do AAA[N]:=XXX[N];
         M:= M+1;
         application.ProcessMessages;
      end;

      setlength(XXX,D+1);
      for N:= 1 to D do XXX[N]:=AAA[N];

      if BLN=false then
      begin
         Button1.Caption:='計算開始';
         Button2.Visible:=true;
         exit;
      end;

      setlength(AAA,2);
      AAA[1]:=1;
      D:=1;

      M:=1;

      while (BLN=true) and (M<=R) do
      begin
         Memo2.Lines.Strings[0]:= inttostr(M);
         BB:=inttostr(M);
         A:=D;
         B:=length(BB);
         setlength(BBB,B+1);
         setlength(CCC,B+1,A+B+1);
         setlength(YYY,A+B+1);
         for N:= 1 to B do BBB[N]:= strtoint(copy(BB,B-N+1,1));
         for J:= 1 to B do
         begin
            Q:=0;
            for N:= 1 to A do
            begin
               C:=AAA[N]*BBB[J]+Q;
               CCC[J,N+J-1]:=C mod 10;
               Q:=C div 10;
            end;
            CCC[J,A+J]:=Q;
         end;

         Q:=0;

         for N:= 1 to A+B do
         begin
            C:=0;
            for J:= 1 to B do C:=C+CCC[J,N];
            C:=C+Q;
            YYY[N]:=C mod 10;
            Q:=C div 10;
         end;

         if YYY[A+B]=0 then D:=A+B-1 else D:=A+B;
         setlength(AAA,D+1);
         for N:= 1 to D do AAA[N]:=YYY[N];
         M:= M+1;
         application.ProcessMessages;
      end;

      setlength(YYY,D+1);
      for N:= 1 to D do YYY[N]:=AAA[N];

      if BLN=false then
      begin
         Button1.Caption:='計算開始';
         Button2.Visible:=true;
         exit;
      end;

      AA:=High(XXX);
      BBBB:=High(YYY);

      setlength(AAA,BBBB+2);
      setlength(BBB,BBBB+2);
      setlength(X,AA-BBBB+5);
      T:=AA-BBBB+1;

      for N:=1 to BBBB do
      begin
         AAA[N]:=XXX[AA-BBBB+N];
         BBB[N]:=YYY[N];
      end;

      S:= 0;

      while BLN=true do
      begin
         P:= 0;
         repeat
            Z:= 0;
            if AAA[BBBB+1]<>0 then
            begin
               Q:= 1;
               for N:=1 to BBBB+1 do
               begin
                  D:= 10+AAA[N]-1+Q-BBB[N];
                  AAA[N]:= D mod 10;
                  Q:= D div 10;
               end;

               P:= P+1;
            end
            else
            begin
               V:= 0;
               for N:=BBBB downto 1 do
               begin
                  if BBB[N]<AAA[N] then
                  begin
                     V:= 1;
                     Q:= 1;
                     for J:=1 to BBBB do
                     begin
                        D:= 10+AAA[J]-1+Q-BBB[J];
                        AAA[J]:= D mod 10;
                        Q:= D div 10;
                     end;

                     P:= P+1;
                     break;
                  end
                  else if BBB[N]>AAA[N] then
                  begin
                     V:= 1;
                     S:= S+1;
                     Memo2.Lines.Strings[0]:= inttostr(S);
                     X[S]:= P;

                     if (T<=0) or ((T>0) and (S>=T)) then
                     begin
                        U:=0;
                        for J:=BBBB downto 1 do
                           if AAA[J]<>0 then
                           begin
                              U:=1;
                              break;
                           end;

                        if U=0 then
                        begin
                           Z:= 2;
                           break;
                        end;

                        for J:=BBBB downto 1 do
                           AAA[J+1]:= AAA[J];

                        AAA[1]:= XXX[AA-BBBB-S+1];
                        Z:= 1;
                     end
                     else
                     begin
                        for J:=BBBB downto 1 do
                           AAA[J+1]:= AAA[J];

                        AAA[1]:= XXX[AA-BBBB-S+1];
                        Z:= 1;
                     end;
                     break;
                  end;
               end;

               if V=0 then
               begin
                  P:= P+1;
                  for N:=BBBB downto 1 do
                     AAA[N]:= 0;

               end;
            end;
            if (Z=1) or (Z=2) then break;
         until S=-1;
         if Z=2 then break;
         application.ProcessMessages;
      end;

      if BLN=false then
      begin
         Button1.Caption:='計算開始';
         Button2.Visible:=true;
         exit;
      end;

      U:=0;
      for N:= 1 to S do
      begin
         if X[N]<>0 then
         begin
            U:=N;
            break;
         end;
      end;

      XX:='';
      for N:= U to S do XX:= XX+inttostr(X[N]);

      XX:=XX+'    (桁数＝'+inttostr(S-U+1)+')';
      RichEdit1.Text:=XX;

      Button1.Caption:='計算開始';
      Button2.Visible:=true;
      BLN:=false;

      beep;
      if MessageDlg('計算完了。　計算結果を保存または印刷しますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
      begin
         try
            if DirectoryExists('C:\Temp')=False then MkDir('C:\Temp');
            AssignFile(file1,'C:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,'異なる'+Edit1.text+'個のものから'+Edit2.text+'個とった組合せの総数');
            WriteLn(file1,XX);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が C:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('C:\windows\notepad.exe C:\Temp\Temp.txt',SW_SHOW);
            end;
         except
            if DirectoryExists('A:\Temp')=False then MkDir('A:\Temp');
            AssignFile(file1,'A:\Temp\Temp.txt');
            Rewrite(file1);
            WriteLn(file1,'異なる'+Edit1.text+'個のものから'+Edit2.text+'個とった組合せの総数');
            WriteLn(file1,XX);
            CloseFile(file1);
            beep;
            if MessageDlg('計算結果が A:\Temp\Temp.txt に保存されました。 このテキストファイルを開きますか。',mtconfirmation,[mbYes,mbNo],-1)=mrYes then
            begin
               winexec('A:\windows\notepad.exe A:\Temp\Temp.txt',SW_SHOW);
            end;
         end;
      end;
      Edit1.SetFocus;
   end;
end;

procedure Tfrm_kumiawase.Button2Click(Sender: TObject);
begin
   frm_kumiawase.Close;

end;

procedure Tfrm_kumiawase.Copy1Click(Sender: TObject);
begin
   RichEdit1.CopyToClipboard;

end;

procedure Tfrm_kumiawase.Paste1Click(Sender: TObject);
begin
   RichEdit1.PasteFromClipboard;

end;

procedure Tfrm_kumiawase.Edit1Change(Sender: TObject);
begin
   Memo2.Visible:=false;
   RichEdit1.Clear;

end;

procedure Tfrm_kumiawase.Edit2Change(Sender: TObject);
begin
   Memo2.Visible:=false;
   RichEdit1.Clear;

end;

procedure Tfrm_kumiawase.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   if BLN=true then BLN:=false;

end;

end.