unit meganum;
{$Q-,R-}

interface

uses math;

const
maxstellen=1000;
reserve=maxstellen+1;

type
pmeganum=^tmeganum;
tdata=array[1..maxstellen+reserve]of byte;
twurzelproc=procedure (erg:pmeganum;prozent:integer);
tstringproc=procedure (erg:string;prozent:double);
tmeganum=object
  data:tdata;
  komma:integer;
  positiv:boolean;
  length:integer;
  taskstopped:boolean;

  constructor init; overload;
  constructor init(s:string); overload;
  constructor init(p:pmeganum); overload;
  constructor init(i:integer); overload;
  constructor init(r:double); overload;
  destructor done;

  { Organisatorisches }
  procedure clear;
  procedure setdata(p:pmeganum); overload;
  procedure setdata(i:integer); overload;
  procedure setdata(s:string); overload;
  procedure setdata(r:double); overload;
  function getstring:string;
  function getint:integer;
  function getreal:double;
  procedure copynum(p:pmeganum);
  procedure save(f:string);
  procedure load(f:string);
  procedure stoptask;

  { Rechenarten }
  procedure add(p:pmeganum); overload;
  procedure add(s:string); overload;
  procedure add(i:integer); overload;
  procedure sub(p:pmeganum); overload;
  procedure sub(s:string); overload;
  procedure sub(i:integer); overload;
  procedure mul(p:pmeganum); overload;
  procedure mul(s:string); overload;
  procedure mul(i:integer); overload;
  procedure divid(p:pmeganum); overload;
  procedure divid(s:string); overload;
  procedure divid(i:integer); overload;
  procedure modulo(p:pmeganum;ergebnis:pmeganum); overload;
  procedure modulo(s:string;ergebnis:pmeganum); overload;
  procedure modulo(i:integer;ergebnis:pmeganum); overload;
  procedure hoch(p:pmeganum;cb:twurzelproc=nil); overload;
  procedure hoch(s:string;cb:twurzelproc); overload;
  procedure hoch(i:integer;cb:twurzelproc); overload;
  procedure wurzel(cb:twurzelproc=nil;times:integer=0); overload;
  procedure quadrat;
  procedure fakultaet; overload;

  { Trigonometrische Funktionen }
  procedure sin;
  procedure cos;
  procedure tan;
  procedure cotan;

  procedure arctan(cb:twurzelproc;intervall:integer;schritte:integer); overload;
  procedure arctan(schritte:integer); overload;

  { Sonstiges }
  procedure equalkomma(p:pmeganum);
  procedure mul10(z:integer); { mit Komma }
  procedure div10(z:integer); { mit Komma }
  procedure kuerze;
  function kleiner(p:pmeganum):boolean;
  function gleich(p:pmeganum):boolean;
  procedure negiere;
  procedure kehrwert;
  procedure schiebel(z:integer); { Ohne Komma }
  procedure schieber(z:integer); { Ohne Komma }
  function null:boolean;
  procedure calculateterm(s:string);
  function dectobin(cb:tstringproc=nil;maxs:integer=65535):string; overload;
end;

procedure calculateterm(s:string;erg:pmeganum);

implementation

uses sysutils;

constructor tmeganum.init;
begin
  clear;
end;

constructor tmeganum.init(s:string);
begin
  init;
  setdata(s);
end;

constructor tmeganum.init(p:pmeganum);
begin
  init;
  copynum(p);
end;

constructor tmeganum.init(i:integer);
begin
  init;
  setdata(i);
end;

constructor tmeganum.init(r:double);
begin
  init;
  setdata(r);
end;

destructor tmeganum.done;
begin

end;

procedure tmeganum.clear;
var
zhl:integer;
begin
  for zhl:=1 to maxstellen do data[zhl]:=0;
  positiv:=true;
  komma:=1;
  length:=1;
end;

procedure tmeganum.setdata(p:pmeganum);
begin
  copynum(p);
end;

procedure tmeganum.setdata(i:integer);
var
zhl:integer;
begin
  clear;
  zhl:=1;
  positiv:=i>=0;
  if i<0 then i:=-i;
  komma:=1;
  while i<>0 do
  begin
    data[zhl]:=i mod 10;
    i:=i div 10;
    inc(zhl);
    if zhl>maxstellen then raise erangeerror.Create('Zahl überschreitet '+inttostr(maxstellen)+' Stellen.');
  end;
  length:=zhl-1;
  if length=0 then length:=1;
end;

procedure tmeganum.setdata(s:string);
var
i:integer;
begin
  clear;
  length:=0;
  s:=trim(s);
  for i:=system.length(s) downto 1 do
  begin
    case upcase(s[i]) of
      '0'..'9':begin
        inc(length);
        data[length]:=byte(s[i])-byte('0');
        if length>maxstellen then raise erangeerror.create('Zahl überschreitet '+inttostr(maxstellen)+' Stellen.');
      end;
      ',','.':komma:=length+1;
      '-','+':begin
        if i<>1 then
        begin
          raise ematherror.create('Vorzeichen in String (Zahl) gefunden!');
          exit;
        end;
        if s[i]='-' then positiv:=false else positiv:=true;
      end;
      else begin
        raise ematherror.create('Angegebe String nicht als Zahl interpretierbar!');
        exit;
      end;
    end;
  end;
  if komma=length+1 then
  begin
    inc(length);
    data[length]:=0;
  end;
end;

procedure tmeganum.setdata(r:double);
var
s:string;
begin
  s:=formatfloat('',r);
  setdata(s);
end;

function tmeganum.getstring;
var
s:string;
zhl:integer;
begin
  s:='';
  for zhl:=length downto 1 do
  begin
    if (zhl=komma-1)and(zhl>=1) then s:=s+',';
    s:=s+inttostr(data[zhl]);
  end;
  if positiv=false then s:='-'+s;

  getstring:=s;
end;

function tmeganum.getint;
var
i,zhl,min:integer;
begin
  i:=0;
  min:=length-komma;
//  if min>8 then raise ematherror.create('Getint: Zahl überschreitet Integergrenzen!');
  for zhl:=length downto length-min do
  begin
    i:=i*10+data[zhl];
  end;
  if not positiv then i:=-i;
  result:=i;
end;

function tmeganum.getreal;
var
r:double;
zhl,min:integer;
begin
  if length-komma>15 then raise ematherror.create('Getreal: Zahl überschreitet Real-Grenzen!');
  r:=0;
  min:=1;
  if length-min>15 then min:=length-15;
  for zhl:=length downto min do
  begin
    r:=r*10+data[zhl];
  end;
  if komma>1 then for zhl:=1 to komma-min do r:=r/10;
  if not positiv then r:=-r;
  result:=r;
end;


procedure tmeganum.add(p:pmeganum);
var
max,i,j:integer;
ub:boolean;
temp:pmeganum;
pos:integer;
begin
  new(temp,init(p));
  
  if (positiv=true)and(temp^.positiv=false)then
  begin
    temp^.positiv:=true;
    sub(temp);
    dispose(temp);
    exit;
  end;       
  if (positiv=false)and(temp^.positiv=true)then
  begin
    positiv:=true;
    temp^.sub(@self);
    copynum(temp);
    dispose(temp);
    exit;
  end;
  if (positiv=false)and(temp^.positiv=false)then
  begin
    positiv:=true;
    temp^.positiv:=true;
    add(temp);
    dispose(temp);
    positiv:=false;
    exit;
  end;
  equalkomma(p);
  temp.komma:=komma;
  max:=length;
  if p^.length>max then max:=p^.length;

  ub:=false;
  length:=max;
  pos:=1;
  for i:=1 to max do
  begin
    j:=p^.data[i]+data[i]+byte(ub);
    temp.data[pos]:=j mod 10;
    ub:=false;
    if j>=10 then ub:=true;
    inc(pos);
    if pos>maxstellen then
    begin
      temp.length:=pos;
      temp.div10(1);
      dec(pos);
    end;
  end;
  temp.length:=length;
  if ub then
  begin
    temp.data[max+1]:=1;
    inc(temp.length);
  end;
  copynum(temp);
  kuerze;
  p^.kuerze;
  dispose(temp);
end;

procedure tmeganum.add(s:string);
var
p:pmeganum;
begin
  new(p,init(s));
  add(p);
  dispose(p,done);
end;

procedure tmeganum.add(i:integer);
var
p:pmeganum;
begin
  new(p,init(i));
  add(p);
  dispose(p,done);
end;

procedure tmeganum.sub(p:pmeganum);
var
i,j,max:integer;
ub:boolean;
temp:pmeganum;
begin
  new(temp,init(p));
  if (positiv=true)and(temp^.positiv=false)then
  begin
    temp^.positiv:=true;
    add(temp);
    dispose(temp);
    exit;
  end;
  if (positiv=false)and(temp^.positiv=true)then
  begin
    positiv:=true;
    add(temp);
    dispose(temp);
    positiv:=false;
    exit;
  end;
  if (positiv=false)and(temp^.positiv=false)then
  begin
    temp^.positiv:=true;
    positiv:=true;
    sub(temp);
    dispose(temp);
    negiere;
    kuerze;
    exit;
  end;
  if kleiner(p) then
  begin
    temp^.sub(@self);
    self.copynum(temp);
    dispose(temp,done);
    negiere;
    exit;
  end;
  dispose(temp);
  equalkomma(p);

  ub:=false;
  max:=length;
  if p^.length>max then max:=p^.length;

  for i:=1 to max do
  begin
    j:=0;
    if i<=length then j:=data[i];
    if i<=p^.length then j:=j-p^.data[i];
    j:=j-byte(ub);
    ub:=false;
    if j<0 then ub:=true;
    while j<0 do j:=j+10;
    data[i]:=j;
  end;
  
  kuerze;
  p^.kuerze;
end;

procedure tmeganum.sub(s:string);
var
p:pmeganum;
begin
  new(p,init(s));
  sub(p);
  dispose(p,done);
end;

procedure tmeganum.sub(i:integer);
var
p:pmeganum;
begin
  new(p,init(i));
  sub(p);
  dispose(p,done);
end;

procedure tmeganum.mul(p:pmeganum);
var
zhl1,zhl2:integer;
erg,zerg:pmeganum;
ub:integer;
begin
  if p.length>length then
  begin              { ggf Faktoren vertauschen }
    new(erg,init(p));
    erg.mul(@self);
    copynum(erg);
    dispose(erg,done);
    exit;
  end;
  new(erg,init);
  new(zerg,init);
  kuerze;
  p.kuerze;
  equalkomma(p);
  if (p.length-p.komma)+(length-komma)>maxstellen then raise EMathError.Create('Mul: Zahl würde  '+inttostr(maxstellen)+' Stellen überschreiten.');
  for zhl1:=1 to p.length do
  begin
    ub:=0;
    zerg.clear;
    zerg.length:=zhl1;
    zerg.komma:=p.komma*2-1;
    for zhl2:=1 to length do
    begin
      ub:=ub+data[zhl2]*p.data[zhl1];
      zerg.data[zerg.length]:=ub mod 10;
      ub:=ub div 10;
      inc(zerg.length);
    end;
    if ub<>0 then
    begin
      zerg.data[zerg.length]:=ub;
      inc(zerg.length);
    end;
    zerg.kuerze;
    erg.add(zerg);
  end;

  erg.positiv:=(positiv=p.positiv);
  copynum(erg);
  dispose(erg,done);
  dispose(zerg,done);
end;

procedure tmeganum.mul(s:string);
var
p:pmeganum;
begin
  new(p,init(s));
  mul(p);
  dispose(p,done);
end;

procedure tmeganum.mul(i:integer);
var
p:pmeganum;
begin
  new(p,init(i));
  mul(p);
  dispose(p,done);
end;

procedure tmeganum.divid(p:pmeganum);
{ 256 / 4     256: Dividend
              4  : Divisor }
var
zhl,pos:integer;
dividend,erg:pmeganum;
oldkomma:integer;
oldpos1,oldpos2:boolean;
begin
  if p.null then raise ematherror.create('Divid: Divisor ist NULL!');
  new(dividend,init);
  new(erg,init);
  oldkomma:=p.komma;
  p.komma:=1;
  dividend.data[1]:=data[length];
  pos:=length-1;
  erg.komma:=0;
  oldpos1:=p.positiv;
  oldpos2:=positiv;
  p.positiv:=true;
  positiv:=true;

  repeat
    zhl:=0;
    repeat
      if dividend.kleiner(p)=false then
      begin
        dividend.sub(p);
        inc(zhl);
      end else break;
    until zhl=9;

    erg.data[1]:=zhl;
    if erg.null=false then erg.schiebel(1);
    dividend.schiebel(1);
    if pos<=0 then dividend.data[1]:=0 else dividend.data[1]:=data[pos];
    dec(pos);
    if pos<komma-1 then inc(erg.komma);
  until ((dividend.null)and(pos<=0))or(erg.length>=maxstellen);
  erg.schieber(1);

  p.komma:=oldkomma;
  erg.komma:=erg.komma-p.komma+1;
  while erg.komma<=0 do
  begin
    erg.mul10(1);
  end;
  p.positiv:=oldpos1;
  positiv:=oldpos2;

  erg.positiv:=oldpos1=oldpos2;

  copynum(erg);
  dispose(dividend,done);
  dispose(erg,done);
  kuerze;
  p.kuerze;
end;

procedure tmeganum.divid(s:string);
var
p:pmeganum;
begin
  new(p,init(s));
  divid(p);
  dispose(p,done);
end;

procedure tmeganum.divid(i:integer);
var
p:pmeganum;
begin
  new(p,init(i));
  divid(p);
  dispose(p,done);
end;


procedure tmeganum.modulo(p:pmeganum;ergebnis:pmeganum);
{ 256 / 4     256: Dividend
              4  : Divisor }
var
zhl,pos:integer;
dividend,erg:pmeganum;
oldkomma:integer;
oldpos1,oldpos2:boolean;
begin
  if p.null then raise ematherror.create('Modulo: Divisor ist NULL!');
  new(dividend,init);
  new(erg,init);
  oldkomma:=p.komma;
  equalkomma(p);
  p.komma:=1;
  dividend.data[1]:=data[length];
  pos:=length-1;
  erg.komma:=0;
  oldpos1:=p.positiv;
  p.positiv:=true;
  oldpos2:=positiv;
  positiv:=true;


  repeat
    zhl:=0;
    repeat
      if dividend.kleiner(p)=false then
      begin
        dividend.sub(p);
        inc(zhl);
      end else break;
    until zhl=9;

    erg.data[1]:=zhl;
    if erg.null=false then erg.schiebel(1);
    dividend.schiebel(1);
    if pos<=0 then dividend.data[1]:=0 else dividend.data[1]:=data[pos];
    dec(pos);           
    if pos<komma-1 then inc(erg.komma);
  until (pos<0)or((dividend.null)and(pos<=0))or(erg.length>=maxstellen);
  p.positiv:=oldpos1;
  positiv:=oldpos2;
  erg.positiv:=oldpos1=oldpos2;
  dividend.positiv:=oldpos1;
  dividend.schieber(1);
  dividend.komma:=komma;
  copynum(dividend);

  erg.schieber(1);
  erg.komma:=1;
  p.komma:=oldkomma;
  kuerze;
  p.kuerze;
  if ergebnis<>nil then ergebnis.copynum(erg);

  dispose(dividend,done);
  dispose(erg,done);
end;

procedure tmeganum.modulo(s:string;ergebnis:pmeganum);
var
p:pmeganum;
begin
  new(p,init(s));
  modulo(p,ergebnis);
  dispose(p,done);
end;

procedure tmeganum.modulo(i:integer;ergebnis:pmeganum);
var
p:pmeganum;
begin
  new(p,init(i));
  modulo(p,ergebnis);
  dispose(p,done);
end;

procedure tmeganum.hoch(p:pmeganum;cb:twurzelproc);
var
temp,temp2:pmeganum;
erg:pmeganum;
eins:pmeganum;
i,zahl:integer;
begin
  if p.null then
  begin
    setdata(1);
    exit;
  end;
  if (p.komma<>1)and(p.komma<>0)then raise ematherror.create('Hoch: Als Exponent nur Ganzzahl erlaubt!');

  taskstopped:=false;
  new(temp,init(p));
  new(temp2,init(p));
  new(erg,init(@self));
  zahl:=2;
  repeat
    temp2.setdata(temp);
    temp.modulo(zahl,nil);
    if temp.null then
    begin
      if @cb<>nil then cb(temp2,temp2.getint);
      temp.setdata(temp2);
      temp.divid(zahl);
      for i:=1 to zahl-1 do mul(erg);
      erg.setdata(@self);
    end else
    begin
      case zahl of
        2:zahl:=3;
        3:zahl:=5;
        5:zahl:=0;
      end;
      temp.setdata(temp2);
    end;
  until zahl=0;
  erg.setdata(@self);
  temp.setdata(temp2);
  dispose(temp2,done);
  temp.positiv:=true;
  new(eins,init(1));
  temp.sub(eins);
  while (temp.length>1)or(temp.data[1]<>0) do
  begin
    erg.mul(@self);
    temp.sub(eins);
    if taskstopped then break;
    if @cb<>nil then cb(temp2,temp2.getint);
  end;
  if p.positiv=false then erg.kehrwert;
  copynum(erg);
  dispose(eins,done);
  dispose(erg,done);
  dispose(temp,done);
end;

procedure tmeganum.hoch(s:string;cb:twurzelproc);
var
p:pmeganum;
begin
  new(p,init(s));
  hoch(p,cb);
  dispose(p,done);
end;

procedure tmeganum.hoch(i:integer;cb:twurzelproc);
var
p:pmeganum;
begin
  new(p,init(i));
  hoch(p,cb);
  dispose(p,done);
end;

procedure tmeganum.wurzel(cb:twurzelproc;times:integer);
var
erg,divisor,temp,temp2:pmeganum;
procedure vorkomma;
var
stelle:integer;
i,j:integer;
begin
  if (length=1)and(komma<=1)and(data[1]=0)then
  begin
    clear;
    exit;
  end;
  
  stelle:=length;
  if odd(length-komma+1)then
  begin
    divisor.setdata(data[length]);
    if stelle=komma then erg.komma:=1;
    dec(stelle);
  end else
  begin
    divisor.setdata(data[stelle]*10+data[stelle-1]);
    dec(stelle,2);
  end;
  erg.data[1]:=trunc(sqrt(divisor.getint));
  divisor.sub(erg.data[1]*erg.data[1]);

  if (stelle<>0)or(divisor.null=false)then
  repeat
    begin { Nächsten Stellen holen }
      divisor.schiebel(2);
      if stelle>0 then
      begin
        divisor.data[2]:=data[stelle];
        dec(stelle);
      end else if (erg.komma=0)then erg.komma:=1;
      if stelle>0 then
      begin
        divisor.data[1]:=data[stelle];
        dec(stelle);
      end else if (erg.komma=0)then erg.komma:=1;
    end;
    begin
      temp.copynum(erg);
      temp.komma:=1;
      temp.add(temp);
      temp.schiebel(1);

      for i:=1 to 9 do
      begin
        temp2.copynum(temp);
        temp2.data[1]:=i;
        temp2.mul(i);
        j:=i;
        if divisor.gleich(temp2)then break;
        if divisor.kleiner(temp2)then
        begin
          dec(j);
          break;
        end;
      end;
      i:=j;
      temp.copynum(erg);
      temp.komma:=1;
      temp.add(temp);
      temp.schiebel(1);
      temp.data[1]:=i;
      temp.mul(i);
      divisor.sub(temp);
      if erg.komma<>0 then inc(erg.komma);
      erg.schiebel(1);
      erg.data[1]:=i;
    end;
    if (times<>0)and(erg.length mod times=0)and(@cb<>nil) then
    begin
      cb(erg,round((erg.length/maxstellen)*100));
      warte;
    end;
  until ((stelle=0)and(divisor.null))or(erg.length>=maxstellen)or(divisor.length>=maxstellen-1)or(erg.length>=maxstellen-1)or(taskstopped);
end;
begin
  if (positiv=false)then raise ematherror.create('Wurzel darf nur aus positiven Zahlen gezogen werden ('+getstring+').');
  taskstopped:=false;
  new(erg,init);
  new(divisor,init);
  new(temp,init);
  new(temp2,init);

  erg.komma:=0;
  vorkomma;

  if erg.komma=0 then erg.komma:=1;
  copynum(erg);
  kuerze;
  dispose(temp2,done);
  dispose(temp,done);
  dispose(divisor,done);
  dispose(erg,done);
end;
                    
procedure tmeganum.quadrat;
begin
  mul(@self);
end;

procedure tmeganum.fakultaet;
var
zhl:pmeganum;
max:pmeganum;
begin
  if (komma>1)or(positiv=false) then raise ematherror.Create('Fakultät nur mit ganzen positiven Zahlen möglich.');
  if null then exit;  
  new(zhl,init(0));
  new(max,init(@self));
  setdata(1);
  repeat
    zhl.add(1);
    mul(zhl);
  until zhl.gleich(max);

  dispose(max,done);
  dispose(zhl,done);
end;


procedure tmeganum.sin;
var
i:integer;
b:boolean;
z1,z2,temp,erg:pmeganum;
begin
  new(z1,init(@self));
  new(z2,init(1));
  new(temp,init);
  new(erg,init(@self));
  i:=3;
  b:=false;

  repeat
    z1.mul(@self);
    z1.mul(@self);
    z2.mul(i-1);
    z2.mul(i);
    temp.copynum(z1);
    temp.divid(z2);

    if b then erg.add(temp) else erg.sub(temp);
    b:=b=false;
    i:=i+2;
  until (z1.length>=maxstellen-3)or(z2.length>=maxstellen-3);
  copynum(erg);
  dispose(erg,done);
  dispose(z1,done);
  dispose(z2,done);
  dispose(temp,done);
  kuerze;
end;

procedure tmeganum.cos;
var
i:integer;
b:boolean;
z1,z2,temp,erg:pmeganum;
begin
  new(z1,init(1));
  new(z2,init(1));
  new(temp,init);
  new(erg,init(1));
  i:=2;
  b:=false;

  repeat
    z1.mul(@self);
    z1.mul(@self);
    z2.mul(i-1);
    z2.mul(i);
    temp.copynum(z1);
    temp.divid(z2);

    if b then erg.add(temp) else erg.sub(temp);
    b:=b=false;
    i:=i+2;
  until (z1.length>=maxstellen-3)or(z2.length>=maxstellen-3);
  copynum(erg);
  dispose(erg,done);
  dispose(z1,done);
  dispose(z2,done);
  dispose(temp,done);
  kuerze;
end;

procedure tmeganum.tan;
var
temp:pmeganum;
begin
  new(temp,init(@self));
  sin;
  temp.cos;

  divid(temp);
  dispose(temp,done);
end;

procedure tmeganum.cotan;
var
temp:pmeganum;
begin
  new(temp,init(@self));
  cos;
  temp.sin;

  divid(temp);
  dispose(temp,done);
end;

procedure tmeganum.arctan(cb:twurzelproc;intervall:integer;schritte:integer);
var
i:integer;
b:boolean;
z1,temp,erg:pmeganum;
begin
  new(z1,init(@self));
  new(temp,init);
  new(erg,init(@self));
  i:=3;
  b:=false;

  repeat
    z1.mul(@self);
    z1.mul(@self);
    temp.copynum(z1);
    temp.divid(i);

    if b then erg.add(temp) else erg.sub(temp);
    b:=b=false;
    i:=i+2;
    if (@cb<>nil)and(intervall<>0)and((i div 2)mod intervall=0) then
    begin
      cb(erg,round(i/(schritte*2)*100));
    end;
  until (z1.length>=maxstellen-3)or(i>=schritte*2);
  copynum(erg);
  dispose(erg,done);
  dispose(z1,done);
  dispose(temp,done);
  kuerze;
end;

procedure tmeganum.arctan(schritte:integer);
begin       
  arctan(nil,0,schritte);
end;



procedure tmeganum.equalkomma;
label neu;
begin
  neu:
  if komma=p.komma then exit;

  if komma>p^.komma then
  begin
    if p.length+(komma-p.komma)>=maxstellen then
    begin
      div10(1);
      goto neu;
    end;
    p^.mul10(komma-p.komma);
  end;
  if komma<p^.komma then
  begin
    if length+(p.komma-komma)>=maxstellen then
    begin
      p.div10(1);
      goto neu;
    end;
    mul10(p.komma-komma);
  end;
end;

procedure tmeganum.mul10;
var        { Mit Komma }
i:integer;
begin
  for i:=length+z downto z+1 do data[i]:=data[i-z];
  for i:=1 to z do data[i]:=0;
  inc(length,z);
  inc(komma,z);
end;

procedure tmeganum.div10;
var
i:integer;
begin
  if (z<=0)or(z>=maxstellen) then exit;
  for i:=1 to length-z do data[i]:=data[i+z];
  for i:=length-z+1 to length do data[i]:=0;
  dec(length,z);
  dec(komma,z);
end;

procedure tmeganum.kuerze;
var
i:integer;
begin
  while (komma>length) do inc(length);   { Länge muss größer sein als Komma }
  for i:=1 to length do if data[i]<>0 then break; { Wenn Leer, dann lösche }
  if (i=length)and(data[length]=0)then
  begin
    clear;
    exit;
  end;
  if komma>1 then
  begin      { Nullen hinter Komma kürzen }
    for i:=1 to komma-1 do if data[i]<>0 then break;
    div10(i-1);
  end;
  while (length>1)and(data[length]=0)and(komma<>length) do
  begin          { führende Nullen kürzen }
    dec(length);
  end;
  if (length<=1)and(data[1]=0) then
  begin
    length:=1;
    komma:=1;
    positiv:=true;
  end;
  if length>maxstellen then div10(length-maxstellen);
end;

function tmeganum.kleiner;
{ True, wenn p<self }
var
zhl:integer;
max:integer;
begin
  result:=false;
  if (positiv=p^.positiv)then
  begin
    equalkomma(p);
    max:=length;
    if p.length>max then max:=p.length;
    for zhl:=max downto 1 do
    begin
      if data[zhl]<p^.data[zhl] then
      begin
        result:=true;
        kuerze;
        p^.kuerze;
        exit;
      end;
      if data[zhl]>p^.data[zhl] then
      begin
        result:=false;
        kuerze;
        p^.kuerze;
        exit;
      end;
    end;
  end else result:=positiv=false;
end;

function tmeganum.gleich;
var
zhl:integer;
begin
  result:=false;
  equalkomma(p);
  if (length<>p^.length)or(positiv<>p^.positiv)or(komma<>p.komma)then
  begin
    kuerze;
    p.kuerze;
    exit;
  end;

  for zhl:=length downto 1 do if data[zhl]<>p.data[zhl] then
  begin
    kuerze;
    p.kuerze;
    exit;
  end;
  result:=true;
end;

procedure tmeganum.copynum;
begin
  komma:=p^.komma;
  positiv:=p^.positiv;
  length:=p^.length;
  data:=p^.data;
end;

procedure tmeganum.negiere;
begin
  positiv:=positiv=false;
end;

procedure tmeganum.kehrwert;
var
temp:pmeganum;
begin
  new(temp,init(1));
  temp.divid(@self);
  copynum(temp);
  dispose(temp,done);
end;

procedure tmeganum.schiebel;
var
zhl1:integer;
begin
  if z<=0 then exit;
  if length+z>maxstellen then
  begin
    komma:=komma-(length+z-maxstellen);
    z:=z-(length+z-maxstellen);
  end;
  for zhl1:=length downto 1 do data[zhl1+z]:=data[zhl1];
  for zhl1:=1 to z do data[zhl1]:=0;
  inc(length,z);
end;

procedure tmeganum.schieber;
var
zhl1:integer;
begin
  if z<=0 then exit;

  for zhl1:=1 to length-z do data[zhl1]:=data[zhl1+z];
  for zhl1:=length downto (length-z+1) do data[zhl1]:=0;

  dec(length,z);
end;

procedure tmeganum.save;
var
t:textfile;
i:integer;
begin
  assignfile(t,f);
  rewrite(t);

  if positiv then write(t,'+') else write(t,'-');
  for i:=length downto 1 do
  begin
    write(t,inttostr(data[i]));
    if i=komma then write(t,',');
  end;

  closefile(t);
end;

procedure tmeganum.load;
var
t:textfile;
c:char;
s:string;
begin
  if not fileexists(f) then exit;
  assignfile(t,f);
  reset(t);

  clear;
  s:='';
  while eof(t)=false do
  begin
    read(t,c);
    s:=s+c;
  end;

  closefile(t);
  setdata(s);
end;

procedure tmeganum.stoptask;
begin
  taskstopped:=true;
end;

function tmeganum.null;
var
zhl:integer;
begin
  result:=false;
  for zhl:=1 to length do if data[zhl]<>0 then exit;
  result:=true;
end;

procedure tmeganum.calculateterm;
const
punkt=['*','/',':','^'];
strich=['-','+'];
klammerauf=['(','[','{'];
klammerzu=[')',']','}'];

procedure part(s:string;erg:pmeganum);
var
z:pmeganum;
i,j:integer;
s2:string;
operator:char;
begin
  new(z,init(0));
  operator:='+';
  s2:='';
  i:=0;
  repeat
    inc(i);

    if s[i]in klammerauf then
    begin
      for j:=system.length(s) downto 1 do if s[j] in klammerzu then break;
      part(copy(s,i+1,j-i-1),z);
      s2:=z.getstring;
      i:=j+1;
    end;

    if (i<=system.length(s))and(s[i] in ['0'..'9',',','.',' '])then s2:=s2+s[i] else
    begin
      z.setdata(trim(s2));

      case operator of
        '+':erg.add(z);
        '-':erg.sub(z);
        '*':erg.mul(z);
        '/',':':erg.divid(z);
        '^':erg.hoch(z);
      end;
      z.clear;
      s2:='';

      if (i<system.length(s))then if s[i] in ['-','+','*','/',':','^']then operator:=s[i] else raise ematherror('Fehler in Term gefunden ('+s[i]+')');
    end;
  until i>system.length(s);
  dispose(z,done);
end;
begin
  clear;
  part(s,@self);
end;

function tmeganum.dectobin(cb:tstringproc;maxs:integer):string;
var
s:string;
exp:pmeganum;
temp:pmeganum;
k:boolean;
begin
  s:='';
  new(exp,init(1));
  new(temp,init(@self));

  while temp.kleiner(exp)=false do exp.add(exp);
  k:=false;
  repeat
    if (exp.kleiner(temp))or(exp.gleich(temp))then
    begin
      s:=s+'1';
      temp.sub(exp);
    end else if s<>'' then s:=s+'0';    

    exp.divid(2);
    if (k=false)and(exp.komma<>1)and(temp.null=false)then
    begin
      s:=s+',';
      k:=true;
    end;
    if (system.length(s)mod 10=0)and(@cb<>nil) then cb(s,(100/maxs)*system.length(s));
  until (system.length(s)>maxs)or((temp.null)and(exp.komma<>1))or(exp.length>maxstellen-10);
  
  dispose(temp,done);
  dispose(exp,done);
  result:=s;
end;



procedure calculateterm;
begin
  erg.calculateterm(s);
end;


end.