eskiler

[salelltd]

65520 basamaklı sayılarla dört işlem(bölmeyi de siz yapın benim çok kafam karıştığı için bırakmıştım eskiden şimdi de canım hiç uğraşmak istemiyo)

uses crt;
const buyukN=65520;
type sayi=record s:array[1..buyukN] of char;n:word;end;
.....psayi=^sayi;
procedure birlestir(n:word;a,b: psayi;var c: psayi);{b'yi a'nın n'inci yerine ekle}
var i:word;
begin
..if (a=nil) or (b=nil) or ((n>a^.n) and (a^.n>1)) or (n=0) then exit;
..for i:=1 to n-1 do c^.s[i]:=a^.s[i];
..for i:=1 to b^.n do if i+n>buyukN then begin c^.n:=i+n-1;exit;end else c^.s[i+n-1]:=b^.s[i];
..for i:=n to a^.n do if i+b^.n>buyukN then begin c^.n:=i+b^.n-1;exit;end else c^.s[i+b^.n]:=a^.s[i];
..c^.n:=a^.n+b^.n;
end;
procedure sil(a: psayi;n,k:word;var b: psayi);{a'nın n'inci harfinden başlayarak k harf sil}
var i:word;
begin
..if a=nil then exit;
..if n>a^.n then begin b^.n:=0;exit;end;
..for i:=1 to n-1 do b^.s[i]:=a^.s[i];
..if n+k>a^.n then begin b^.n:=n-1;exit;end;
..for i:=n+k to a^.n do b^.s[i-k]:=a^.s[i];
..b^.n:=a^.n-k;
end;
function buyuk(a,b: psayi):shortint;{-1:hata ,0:eşit, 1:a büyük, 2:b büyük}
var i:byte;bul,n:boolean;
begin
..if (a=nil) or (b=nil) then begin buyuk:=-1;exit;end;n:=false;
..if (a^.s[1]='-') and (b^.s[1]='-') then n:=true;
..if (a^.s[1]='-') and (b^.s[1]<>'-') then buyuk:=2 else if (a^.s[1]<>'-') and (b^.s[1]='-') then buyuk:=1 else
..begin
....bul:=false;
....if a^.n>b^.n then begin bul:=true;if n then buyuk:=2 else buyuk:=1;end else
....if b^.n>a^.n then begin bul:=true;if n then buyuk:=1 else buyuk:=2;end else
....begin
......for i:=1 to a^.n do
......if ord(a^.s[i])>ord(b^.s[i]) then begin if n then buyuk:=2 else buyuk:=1;bul:=true;break;end else
......if ord(b^.s[i])>ord(a^.s[i]) then begin if n then buyuk:=1 else buyuk:=2;bul:=true;break;end;
......if not bul then buyuk:=0;
....end;
..end;
end;
procedure carpim(a,b: psayi;var carpilan: psayi);forward;
function katbul(a,b: psayi):char;
var i:byte;k,l: psayi;bs:shortint;
begin
..new(k);new(l);
..for i:=1 to 10 do
..begin
....k^.n:=1;k^.s[1]:=chr(i+48);carpim(k,a,l);bs:=buyuk(l,b);if (bs=1) or (bs=0) then break;
..end;
..katbul:=chr(i+47);
..dispose(k);dispose(l);
end;
procedure toplam(a,b: psayi;var toplanan: psayi);
var tmp,tmp2: psayi;an,bn,x:longint;c:byte;af:boolean;y:word;
begin
..af:=false;new(tmp);new(tmp2);new(toplanan);topla nan^.n:=0;
..an:=a^.n;bn:=b^.n;x:=an-bn;
..if x<>0 then
..begin
....tmp^.n:=abs(x);for y:=1 to abs(x) do tmp^.s[y]:='0';
....if x>0 then begin birlestir(1,tmp,b,tmp2);b^.s:=tmp2^.s;b^.n:=tmp2^. n;end else
....if x<0 then begin birlestir(1,tmp,a,tmp2);a^.s:=tmp2^.s;a^.n:=tmp2^. n;end;
..end;
..for x:=a^.n downto 1 do
..begin
....if not ((ord(a^.s[x])-48 in [0..9]) and (ord(b^.s[x])-48 in [0..9])) then break;
....c:=ord(a^.s[x])-48+ord(b^.s[x])-48+ord(af);af:=false;
....if c>9 then begin c:=c-10;af:=true;end;
....tmp2^.n:=1;tmp2^.s[1]:=chr(c+48);
....birlestir(1,toplanan,tmp2,tmp);toplanan^.s:=tm p^.s;toplanan^.n:=tmp^.n;
..end;
..if af then
..begin
....tmp2^.n:=1;tmp2^.s[1]:='1';birlestir(1,toplanan,tmp2,tmp);toplanan^.s:= tmp^.s;toplanan^.n:=tmp^.n;
..end;
..dispose(tmp);dispose(tmp2);
end;
procedure carpim(a,b: psayi;var carpilan: psayi);
var s,tmp,tmp2: psayi;x,y,z,k,l:byte;
begin
..new(carpilan);new(s);new(tmp);new(tmp2);
..carpilan^.s[1]:='0';carpilan^.n:=1;
..if a^.n<b^.n then
..begin
....s^.n:=a^.n;s^.s:=a^.s;
....a^.n:=b^.n;a^.s:=b^.s;
....b^.n:=s^.n;b^.s:=s^.s;
..end;
..l:=0;
..for x:=b^.n downto 1 do
..begin
....s^.n:=0;k:=0;
....for y:=a^.n downto 1 do
....begin
......if not ((ord(a^.s[y])-48 in [0..9]) and (ord(b^.s[x])-48 in [0..9])) then break;
......z:=(ord(b^.s[x])-48)*(ord(a^.s[y])-48)+k;k:=0;if z>9 then k:=z div 10;
......tmp^.n:=1;tmp^.s[1]:=chr(z mod 10+48);
......birlestir(1,s,tmp,tmp2);s^.n:=tmp2^.n;s^.s:= tmp2^.s;
....end;
....if k>0 then
....begin
......tmp^.n:=1;tmp^.s[1]:=chr(k+48);
......birlestir(1,s,tmp,tmp2);s^.n:=tmp2^.n;s^.s:= tmp2^.s;
....end;
....tmp^.n:=x+l-1;for y:=1 to x+l-1 do tmp^.s[y]:='0';
....birlestir(1,s,tmp,tmp2);s^.n:=tmp2^.n;s^.s:=tm p2^.s;
....toplam(carpilan,s,tmp2);carpilan^.n:=tmp2^.n;c arpilan^.s:=tmp2^.s;
..end;
..while carpilan^.s[1]='0' do
..begin
....sil(carpilan,1,1,tmp);carpilan^.n:=tmp^.n;carp ilan^.s:=tmp^.s;if carpilan^.n=0 then break;
..end;
..dispose(tmp);dispose(tmp2);dispose(s);
end;
procedure yaz(p: psayi);
var i:word;
begin
..for i:=1 to p^.n do write(p^.s[i]);
end;
procedure oku(var p: psayi);
var i:word;c:char;
begin
..i:=1;new(p);
..repeat
....c:=readkey;
....case c of
......'0'..'9':begin
.................p^.s[i]:=c;i:=i+1;gotoxy(1,wherey);p^.n:=i-1;yaz(p);
.............. end;
......#8:if i>1 then
.........begin
...........i:=i-1;gotoxy(1,wherey);p^.n:=i-1;yaz(p);mem[$B800: (wherex-1)*2+(wherey-1)*160]:=32;
........ end;
......#27:halt;
....end;
..until (i>buyukN) or (c=#13);
..p^.n:=i-1;writeln;
end;
var a,b,c: psayi;
begin
..writeln('iki sayı giriniz:');oku(a);oku(b);
..writeln('çarpımı:');carpim(a,b,c);
{..writeln('Birleşimi:');birlestir(2,a,b,c);}
{..writeln('Toplamı:');toplam(a,b,c);}
..yaz(c);readln;
..dispose(a);dispose(b);dispose(c);
end.