program DOS_Calculator;{bietet auch Komandozeilenbedienung+ /h Hilfe}
{$M 16384,0,655360}    {bei Fehleingabe entspr. Errorlevel}
{$A+,B-,D-,L-,Y-,O-,F-,I-,G-,N+,E+,P-,Q-,R-,S+,T-,V-,X-}
{Schalterbefehle f�r Programme}
{in der Testphase}{D+,L+,Y+,I+,Q+,R+}
uses CRT;
var Code:Integer;
    P:string;{Eingabepuffer}
    Bin,Hex,Time,Deg,Grd:Boolean;
    Car,Fkz,Opz:Char;
    a,b,c,m:extended;
    h,k,i,j:LongInt;
    S,Z:Byte;{Spalte,Zeile}
const Komma:Boolean=True;
      Pos1=9;Leer=63;
      {MaxF=1755;gr��te Zahl f�r Fakult�t=1754}
      {Pi=3.1415926535897932384626433832795; schon vorh.}

{Da ich viele der Funktionen der TP-FAQ entnommen habe,
stelle ich auch den Quelltext zur Verf�gung. So k�nnen
Sie gerne das Programm erweitern. Bitte die Weitergabe
von ge�ndertem Code mit mir unter Gerrit@GERRiTsoft.de
mit mir abstimmen. Der Autor}

procedure Init;
begin TextAttr:=LightGray;
  WriteLn('     ��������������������������������������������������������������������Ŀ');
    Write('     �                     ');
  TextColor(LightBlue);Write('�-=*�~\\\ G-CALC ///~�*=-�');
  TextColor(LightGray);WriteLn('                     �');
  WriteLn('     � ����������������������������������������������������������������Ŀ �');
  WriteLn('     � �                                                              0 � �');
  WriteLn('     � ������������������������������������������������������������������ �');
  WriteLn('     � ����������������������������������������������������������������ͻ �');
  WriteLn('     � � Bin<F4>� Dez<F5>� Hex<F6>� Time<F7>� Rad<F8>� Deg<F9>� Grd<F10>� �');
  WriteLn('     � ����������������������������������������������������������������͹ �');
  WriteLn('     � �Save<F2>�        � <ENTF> � <Alt+X> �   <R�cktaste>   �<ESC>� M � �');
  WriteLn('     � ����������������������������������������������������������������ͼ �');
  WriteLn('     � �����������                              �����������������������ͻ �');
  WriteLn('     � � 1/x<K>        sin<S>        OR<O>      � A � B � C � D � E � F � �');
  WriteLn('     �                 cos<C>       AND<&>      �����������������������͹ �');
  WriteLn('     �   SQR<R>        tan<T>       XOR<X>      � 7 � 8 � 9 � / � % � MX� �');
  WriteLn('     �                              DIV<\>      �����������ĺ������ĺ��ĺ �');
  WriteLn('     �   x^2<Q>                     MOD<;>      � 4 � 5 � 6 � * � n!� MR� �');
  WriteLn('     �                                          �����������ĺ������ĺ��ĺ �');
  WriteLn('     �   x^3<H>        log<G>       NOT<N>      � 1 � 2 � 3 � - � pi� MC� �');
  WriteLn('     �                  ln<L>       LSH(<)      �����������ĺ������ĺ��ĺ �');
  WriteLn('     �   x^y<^>        e^x<E>       INT<I>      � 0 � , �+#-� + � = � M+� �');
  WriteLn('     �                                          �����������������������ͼ �');
    Write('     �');
  TextColor(LightCyan);Write('       Der GERRiTsoft-Calculator');
  TextColor(LightGray);WriteLn('                           ��������ٳ');
  WriteLn('     ����������������������������������������������������������������������');
  Writeln;
end;

procedure Err(Stri:string);
begin
  TextColor(LightRed);
  GotoXY(Pos1,Z);Write(Stri);
  GotoXY(WhereX-1,Z);
{  repeat
    for i:=Pos1 to Pos1+Length(Stri)-1do
      GotoXY(i,Zeile);
  until KeyPressed;}
  Car:=ReadKey;
  TextColor(LightGreen);
end;

procedure Point(A,B,C,D:Byte);
begin
  TextColor(Yellow);
  S:=WhereX;Z:=WhereY;
  GotoXY(Pos1+B,Z+3);Write(' ');
  GotoXY(Pos1+C,Z+3);Write(' ');
  GotoXY(Pos1+D,Z+3);Write(' ');
  GotoXY(Pos1+A,Z+3);Write('�');
  TextColor(LightGreen);
  GotoXY(S,Z);
end;

procedure Mem;
begin
  TextColor(White);
  S:=WhereX;Z:=WhereY;
  GotoXY(Pos1+62,Z+5);Write('M');
  TextColor(LightGreen);
  GotoXY(S,Z);
end;

procedure MemF;
begin{rot ist blau und plus ist minus}
  if m>0then TextColor(LightRed)else
    if m<0then TextColor(LightBlue)else TextColor(LightGray);
  S:=WhereX;Z:=WhereY;
  GotoXY(Pos1+62,Z+5);Write('M');
  TextColor(LightGreen);
  GotoXY(S,Z);
end;

function BinCon(Zahl:LongInt):string;
const Basis=2;BinStr:string[2]='01';
var   Hex:array[0..3]of Byte absolute Zahl;
      S:string;
begin
  if Zahl=0then S:='0'else S:='';
  while Zahl>0do
    begin
      S:=BinStr[(Zahl mod Basis)+1]+S;
      Zahl:=Zahl div Basis;
    end;
  if Zahl<0then
    for i:=0to 3do begin
      j:=1;
      while j<$81 do begin
	if Hex[i]and j=j then S:='1'+S else S:='0'+S;
	Inc(j,j);
      end;
    end;
  BinCon:=S;
end;

function HexCon(Zahl:LongInt):string;
const Basis=16;
      HexStr:string[16]='0123456789ABCDEF';
var   Hex:array[0..3]of Byte absolute Zahl;
      S:string;
begin
  if Zahl=0then S:='0'else S:='';
  while Zahl>0do
    begin
      S:=HexStr[(Zahl mod Basis)+1]+S;
      Zahl:=Zahl div Basis;
    end;
  if Zahl<0then
    for i:=3downto 0do
      if Hex[i]<16then S:=S+'0'+HexCon(Hex[i])else S:=S+HexCon(Hex[i]);
  HexCon:=S;
end;

procedure SaveAll;
var F:Text;
begin
  {$I-}
  Assign(F,'ERGEBNIS.TXT');
  Append(F);
  if IOResult<>0then begin
    Assign(F,'ERGEBNIS.TXT');
    Rewrite(F);
    if IOResult<>0then Exit;
  end;
  {$I+}
  if Bin then Writeln(F,'Bin');
  if Hex then Writeln(F,'Hex');
  if Time then Writeln(F,'Time');
  if Deg then Writeln(F,'Deg');
  if Grd then Writeln(F,'Grd');
  Writeln(F,'Puffer=',P);
  if m<>0then Writeln(F,'Mem=',m:0:20);
  Writeln(F,'x=',a:0:20);
  Writeln(F,'hexa=$',HexCon(h));
  Writeln(F,'y=',b:0:20);
  Writeln(F,'hexb=$',HexCon(k));
  Writeln(F);
  Close(F);
end;

function Hoch(basis,exponent:extended):extended;
procedure h;
  begin
    if basis>0then c:=Exp(Ln(basis)*exponent);
    if basis=0then c:=0;
    if basis<0then
      if Int(exponent)/2=Int(Int(exponent)/2)then
	c:=Exp(Ln(basis*-1)*exponent)else
	c:=Exp(Ln(basis*-1)*exponent)*-1
  end;
begin{Hoch}
  if exponent>4931then begin c:=exponent;Err('OV Error')end else
    if exponent<0then begin
      exponent:=exponent*-1;
      h;c:=1/c;
    end else h;
  Hoch:=c;
end;

function Fakul(F:Integer):extended;
var    Lw      :Integer;     { Zum Hochz�hlen bis F }
       Zwischen:extended;    { notwendige Zwischenvariable }
begin{Fakultaet}
{  if(F>MaxF)or(F<}
  Zwischen:=1;                            { f�r F=0 oder F=1 }
  for Lw:=2to F do
    Zwischen:=Zwischen*Lw;           { Fakult�tsberechnung }
  Fakul:=Zwischen;                   { Funktionsergebnis }
end;{Fakultaet}

function Sinus(w:extended):extended;
begin
  c:=w;
  if Deg then w:=w/180*Pi;
  if Grd then w:=w/200*Pi;
  if(w>37778931862957161700000.0)or(w<-37778931862957161700000.0)then
    begin Sinus:=c;Err('OV Error')end else Sinus:=Sin(w);
end;

function Cosin(w:extended):extended;
begin
  c:=w;
  if Deg then w:=w/180*Pi;
  if Grd then w:=w/200*Pi;
  if(w>37778931862957161700000.0)or(w<-37778931862957161700000.0)then
    begin Cosin:=c;Err('OV Error')end else Cosin:=Cos(w);
end;

function Tan(w:extended):extended;
begin
  c:=w;
  if Deg then w:=w/180*Pi;
  if Grd then w:=w/200*Pi;
  if(w>37778931862957161700000.0)or(w<-37778931862957161700000.0)or
    (Cos(w)=0)then begin Tan:=c;Err('DIV/0 Error')end else Tan:=Sin(w)/Cos(w)
end;

function Atn(x:extended):extended;
begin
  x:=ArcTan(x);
  if Deg then Atn:=x*180/Pi else
    if Grd then Atn:=x*200/Pi else
      Atn:=x;
end;

function Arcsin(x:extended):extended;
begin
  if x<0then Arcsin:=-Arcsin(-x)
  else
    if x=1then Arcsin:=Pi/2
    else Arcsin:=ArcTan(x/Sqrt(1-x*x))
end;

function Arccos(x:extended):extended;
begin
  if x<0then Arccos:=Pi-Arccos(-x)
  else
    if x=0then Arccos:=Pi/2
    else Arccos:=ArcTan(Sqrt(1-x*x)/x)
end;

{function Dms(x:extended):extended;
begin
  c:=Frac(x);
  c:=c*0.6;
end;}

function valB(S:String):LongInt;
var b:LongInt;
begin
  b:=0;j:=1;
  for i:=Length(S)downto 1do begin
    if S[i]>'0'then Inc(b,j);
    Inc(j,j);
  end;
  valB:=b;
end;

procedure SetP(car:Char);
begin
  if P='0'then P:=car else begin
    if Hex and(Length(P)<8)then P:=P+car;
    if Bin and(Length(P)<32)then P:=P+car;
    if(Hex=Bin)and(Length(P)<63)then P:=P+car;
  end;
  GotoXY(Pos1,Z);Write('':Leer);
  GotoXY(WhereX-Length(P),Z);
  Write(P);
end;

procedure SKomma;
begin
  if P=''then P:='0.'else P:=P+'.';
  GotoXY(Pos1,Z);Write('':Leer);
  GotoXY(WhereX-Length(P),Z);
  Komma:=False;
  Write(P);
end;

procedure TKomma;
begin
  if P=''then P:='0:'else P:=P+':';
  GotoXY(Pos1,Z);Write('':Leer);
  GotoXY(WhereX-Length(P),Z);
  Komma:=False;
  Write(P);
end;

procedure ResetP;
begin
  if(P[Length(P)]='.')or(P[Length(P)]=':')then Komma:=True;
  GotoXY(WhereX-Length(P),Z);
  Delete(P,Length(P),1);
  Write(' ',P);
end;

procedure Print(a:extended);
begin
  Str(a:0:20,P);
  while P[Length(P)]='0'do Delete(P,Length(P),1);
  while P[Length(P)]='.'do Delete(P,Length(P),1);
  GotoXY(Pos1,Z);Write('':Leer);
  GotoXY(WhereX-Length(P),Z);
  Write(P);
end;

procedure PrintBin(h:LongInt);
begin
  P:=BinCon(h);
  GotoXY(Pos1,Z);Write('':Leer);
  GotoXY(WhereX-Length(P),Z);
  Write(P);
end;

procedure PrintHex(h:LongInt);
begin
  P:=HexCon(h);
  GotoXY(Pos1,Z);Write('':Leer);
  GotoXY(WhereX-Length(P),Z);
  Write(P);
end;

procedure PrintT(a:extended);
begin
  Str(a:0:20,P);
  while P[Length(P)]='0'do Delete(P,Length(P),1);
  while P[Length(P)]='.'do Delete(P,Length(P),1);
  if Pos('.',P)>0then P[Pos('.',P)]:=':'else P:=P+':00';
  if Pos(':',P)+1=Length(P)then P:=P+'0';
  GotoXY(Pos1,Z);Write('':Leer);
  GotoXY(WhereX-Length(P),Z);
  Write(P);
end;

procedure Wandel(w:Byte);
begin
  Fkz:=#0;Opz:=#0;k:=0;
  if not(Bin or Hex or Time)then begin
    if P>''then val(P,a,Code);
    if a>MaxLongInt then h:=MaxLongInt else
      if a<-MaxLongInt-1then h:=-MaxLongInt-1 else
	h:=Trunc(a);
    case w of
      2:PrintBin(h);
     16:PrintHex(h);
     17:PrintT(a);
    end;
  end;{if}
  if Hex then begin
    if P>''then val('$'+P,h,Code);
    a:=h;
    case w of
      2:PrintBin(h);
     10:Print(a);
     17:PrintT(a);
    end;
  end;{if}
  if Bin then begin
    if P>''then h:=valB(P);
    a:=h;
    case w of
     10:Print(a);
     16:PrintHex(h);
     17:PrintT(a);
    end;
  end;{if}
  if Time then begin
    if(P>'')and(Pos(':',P)=0)then val(P,a,Code)else
      if P>''then begin P[Pos(':',P)]:='.';val(P,a,Code)end;
    if a>MaxLongInt then h:=MaxLongInt else
      if a<-MaxLongInt-1then h:=-MaxLongInt-1 else
	h:=Trunc(a);
    case w of
      2:PrintBin(h);
     10:Print(a);
     16:PrintHex(h);
    end;
  end;{if}
  Komma:=True;
  P:='';
end;

procedure FKB;
begin
  if Bin and(P>'')then h:=valB(P);
  if Hex and(P>'')then val('$'+P,h,Code);
  Fkz:=Car;
  case Fkz of
    '0':h:=0;
    'm','M':begin Mem;
      Car:=ReadKey;
    case Car of
      '+':m:=m+h;
      '-':m:=m-h;
      'c','C':m:=0;
      'r','R':if(m>MaxLongInt)then h:=MaxLongInt else
		if(m<-MaxLongInt-1)then h:=-MaxLongInt-1
		  else h:=Trunc(m);
      'x','X':begin c:=m;m:=h;if(c>MaxLongInt)then h:=MaxLongInt else
		if(c<-MaxLongInt-1)then h:=-MaxLongInt-1
		  else h:=Trunc(c)end;
    end;
      MemF;
    end;{case M}
    'h':if h>$50Athen Err('OV Error')else h:=h*h*h;
    'q','R':if h>$B504then Err('OV Error')else h:=h*h;
    'r','Q':if h<0then Err('<0 Error')else h:=Round(Sqrt(h));
    'n','N':h:=not h;
    '<':begin P:=BinCon(h);if Length(P)<32then h:=valB(P+'0')else
	h:=valB(Copy(P,2,31)+'0')end;
    '>':begin P:=BinCon(h);h:=valB(Copy(P,1,Length(P)-1))end;
  end;{case Fkz}
  if Bin then PrintBin(h);
  if Hex then PrintHex(h);
  P:='';
end;

procedure OPB;
begin
  if Bin and(P>'')then h:=valB(P);
  if Hex and(P>'')then val('$'+P,h,Code);
  case Opz of
    '+':Inc(h,k);
    '-':begin Dec(k,h);h:=k;end;
    '*':h:=k*h;
    '/','\':h:=k div h;
    'o','O':h:=k or h;
    '&':h:=k and h;
    'x','X':h:=k xor h;
    ';':h:=k mod h;
  end;{case}
  if Bin then PrintBin(h);
  if Hex then PrintHex(h);
  Opz:=Car;
  P:='';
  k:=h;
end;

function IncT(a,b:extended):extended;
begin{IncTime}
  c:=(Int(b)*60+Frac(b)*100)+(Int(a)*60+Frac(a)*100);
  b:=int(c/60);IncT:=b+(c-b*60)/100;
{  c:=Int(a)+Int(b);
  a:=Frac(a);b:=Frac(b);
  if a+b<0.6then IncT:=c+a+b
    else if a+b<1.2then IncT:=c+a+b+0.4 else
      if a+b<1.8then IncT:=c+a+b+0.8 else
	IncT:=c+a+b+1.2}
end;

{Mein Dank gilt an dieser Stelle Frank Ludwig f�r
das Verfahren, die Minuten einfach in Sekunden umzurechnen}

function DecT(b,a:extended):extended;
begin{DecTime}
{  if b<a then begin Err('<0 Error');DecT:=b-a;Exit;end;}
  c:=(Int(b)*60+Frac(b)*100)-(Int(a)*60+Frac(a)*100);
  b:=int(c/60);DecT:=b+(c-b*60)/100;
{  b:=Frac(b);a:=Frac(a);
  if b-a<-0.001then DecT:=c+b-a-0.4 else
    if b-a<=0then DecT:=c else
      if b-a<0.6then DecT:=c+b-a else
	DecT:=c+b-a+0.4;}
end;

procedure FKT;
begin
  if(P>'')and(Pos(':',P)=0)then val(P,a,Code)else
    if P>''then begin P[Pos(':',P)]:='.';val(P,a,Code)end;
  Komma:=True;
  Fkz:=Car;
  case Fkz of
    'm','M':begin Mem;
      Car:=ReadKey;
    case Car of
      '+':m:=IncT(m,a);
      '-':m:=DecT(m,a);
      'c','C':m:=0;
      'r','R':a:=m;
      'x','X':begin c:=a;a:=m;m:=c;end;
    end;
      MemF;
    end;{case M}
  end;{case}
  PrintT(a);
  P:='';
end;

procedure OPT;
begin{OP Time}
  if(P>'')and(Pos(':',P)=0)then val(P,a,Code)else
    if P>''then begin P[Pos(':',P)]:='.';val(P,a,Code)end;
  Komma:=True;
  case Opz of
    '+':a:=IncT(a,b);
    '-':a:=DecT(b,a);
  end;{case}
  PrintT(a);
  Opz:=Car;
  P:='';
  b:=a;
end;

procedure Sign;
begin
  if P=''then Print(a);
  if P='0'then Exit;
  GotoXY(WhereX-Length(P),Z);
  if P[1]='-'then begin Delete(P,1,1);Write(' ',P)end
    else begin P:='-'+P;GotoXY(WhereX-1,Z);Write(P)end;
  val(P,a,Code);
end;

procedure FK;
begin
  if P>''then val(P,a,Code);
  Komma:=True;
  Fkz:=Car;
  case Fkz of
    '0':a:=0;
    'p':a:=Pi;
    '%':if b=0then a:=a/100 else a:=b*a/100;
    'm','M':begin Mem;
      Car:=ReadKey;
    case Car of
      '+':m:=m+a;
      '-':m:=m-a;
      'c','C':m:=0;
      'r','R':a:=m;
      'x','X':begin c:=a;a:=m;m:=c;end;
    end;
      MemF;
    end;{case M}
    'i','I':a:=Int(a);
    'k','K':if a=0then Err('DIV/0 Error')else a:=1/a;
    'r','Q':if a<0then Err('<0 Error')else a:=Sqrt(a);
    'q','R':a:=a*a;
    'h':a:=a*a*a;
    'H':a:=Hoch(a,1/3);
    'g':if a>0then a:=Ln(a)/Ln(10)else Err('Error');
    'G':if a>4932then Err('OV Error')else a:=Hoch(10,a);
    'l','E':if a>0then a:=Ln(a)else Err('Error');
    'e','L':if a>11356.523then Err('OV Error')else a:=Exp(a);
    '!':if a<1755then a:=Fakul(Trunc(a))else Err('OV Error');
    's':a:=Sinus(a);
    'S':if(a<-1)or(a>1)then Err('Error')else
	  if Deg then a:=Arcsin(a)*180/Pi else
	    if Grd then a:=Arcsin(a)*200/Pi else
	      a:=Arcsin(a);
    'c':a:=Cosin(a);
    'C':if(a<-1)or(a>1)then Err('Error')else
	  if Deg then a:=Arccos(a)*180/Pi else
	    if Grd then a:=Arccos(a)*200/Pi else
	      a:=Arccos(a);
    't':a:=Tan(a);
    'T':a:=Atn(a);
    'n','N':if(a>MaxLongInt)or(a<-MaxLongInt-1)then Err('OV Error')else
	    a:=not Trunc(a);
    '<':if(a>MaxLongInt)or(a<-MaxLongInt-1)then Err('OV Error')else
	  begin P:=BinCon(Trunc(a));if Length(P)<32then a:=valB(P+'0')else
	      a:=valB(Copy(P,2,31)+'0')end;
    '>':if(a>MaxLongInt)or(a<-MaxLongInt-1)then Err('OV Error')else
	  begin P:=BinCon(Trunc(a));a:=valB(Copy(P,1,Length(P)-1))end;
  end;{case}
  Print(a);
  P:='';
end;

procedure OP;
begin
 {Blinken '+':Z-16,P-8}
  if P>''then val(P,a,Code);
  Komma:=True;
  case Opz of
    '+':a:=b+a;
    '-':a:=b-a;
    '*':a:=b*a;
    '/':if a<>0then a:=b/a else Err('DIV/0 Error');
    '^':a:=hoch(b,a);
    '\':if(a>MaxLongInt)or(b>MaxLongInt)or
	  (a<-MaxLongInt-1)or(b<-MaxLongInt-1)then Err('OV Error')else
	   a:=Trunc(b)div Trunc(a);
    'o','O':if(a>MaxLongInt)or(b>MaxLongInt)or
	  (a<-MaxLongInt-1)or(b<-MaxLongInt-1)then Err('OV Error')else
	   a:=Trunc(b)or Trunc(a);
    '&':if(a>MaxLongInt)or(b>MaxLongInt)or
	  (a<-MaxLongInt-1)or(b<-MaxLongInt-1)then Err('OV Error')else
	   a:=Trunc(b)and Trunc(a);
    'x','X':if(a>MaxLongInt)or(b>MaxLongInt)or
	  (a<-MaxLongInt-1)or(b<-MaxLongInt-1)then Err('OV Error')else
	   a:=Trunc(b)xor Trunc(a);
    ';':if(a>MaxLongInt)or(b>MaxLongInt)or
	  (a<-MaxLongInt-1)or(b<-MaxLongInt-1)then Err('OV Error')else
	   a:=Trunc(b)mod Trunc(a);
  end;{case}
  Print(a);
  Opz:=Car;
  P:='';
  b:=a;
end;

procedure Direkt(Fkt:string);
var Char:array[1..255]of string[1];
begin{Commandline-Mode}
Writeln('Direktmode noch ohne Funktion!');
Halt;
  Val(Fkt,a,Code);
  {Val(ParamStr(1), I, Code);
  {Error during cnversion to integer?}
  if Code<>0then begin
    Writeln('Fehlerhafte Eingabe, Zahlenwert erwartet');
    Halt(1);
  end;
  if (a>1e-20)and(a<1e20)then
    Writeln('Wert = ',a:0:20)
{mehr als 18 Nachkomma werden nie angezeigt}
    else Writeln('Wert = ',a);
  Halt;
end;{Commandline-Mode}

begin{Kernel}
  if ParamStr(1)>''then Direkt(ParamStr(1));{terminiert mit Halt+Errorlevel}
  Init;{soll NICHT BS l�schen um vorige Eingaben zu sehen}
  Z:=WhereY-21;GotoXY(Pos1+62,Z);
  Bin:=False;Hex:=False;Time:=False;Point(9,0,18,27);
  Deg:=True;Grd:=False;Point(46,37,37,55);
  Write('0');
  repeat
    Car:=Readkey;
    if Car=#0then begin Car:=Readkey;
      case Car of
	#45:Exit;
	'k':Exit;{Alt+F4}
	#60:SaveAll;
	#62:begin Wandel(2);Bin:=True;Hex:=False;Time:=False;
	    Point(0,9,18,27)end;
	#63:begin Wandel(10);Bin:=False;Hex:=False;Time:=False;
	    Point(9,0,18,27)end;
	#64:begin Wandel(16);Hex:=True;Bin:=False;Time:=False;
	    Point(18,0,9,27)end;
	#65:begin Wandel(17);Time:=True;Hex:=False;Bin:=False;
	    Point(27,0,9,18)end;
	#66:begin Deg:=False;Grd:=False;Point(37,46,46,55)end;
	#67:begin Deg:=True;Grd:=False;Point(46,37,37,55)end;
	#68:begin Grd:=True;Deg:=False;Point(55,37,37,46)end;
	#83:{Delete}begin Car:='0';if Bin or Hex then FKB else FK;end;
      end;Car:=#0;end;{if}
    if Bin then
      case Car of
	'0'..'1':SetP(Car);
	#8:if Length(P)>0then ResetP;
	'm','M','h','q','Q','r','R','n','N','<','>':FKB;
	'+','-','*','/','\','o','O','&','x','X',';','=',#13:OPB;
	#27:begin P:='';SetP('0');h:=0;k:=0;end;
      end{case}else
      if Hex then
	case Car of
	  '0'..'9':SetP(Car);
	  'A'..'F','a'..'f':SetP(UpCase(Car));
	  #8:if Length(P)>0then ResetP;
	  'm','M','h','q','Q','r','R','n','N','<','>':FKB;
	  '+','-','*','/','\','o','O','&','x','X',';','=',#13:OPB;
	  #27:begin P:='';SetP('0');h:=0;k:=0;end;
	end{case}else
	 if Time then
	   case Car of
	     '0'..'9':SetP(Car);
	     '.',',',':',';':if Komma then TKomma;
	     #8:if Length(P)>0then ResetP;
	     #27:begin P:='';SetP('0');a:=0;b:=0;end;
	     '#':Sign;
	     'm','M':FKT;
	     '+','-','=',#13:OPT;
	   end{case}else
    case Car of
      '0'..'9':SetP(Car);
      '.',',':if Komma then SKomma;
      #8:if Length(P)>0then ResetP;
      #27:begin P:='';SetP('0');a:=0;b:=0;end;
      {Funktionen-wirken sofort}
      '#':Sign;
      '!','p','m','M','i','I','k','K','q','Q','r','R','h','H','e','E',
      'g','G','l','L','s','S','c','C','t','T','n','N','<','>','%':FK;
      {Operationen}
      '+','-','*','/','^','\',';','=',#13:OP;
      #17:Exit;{Ctrl+Q}
    end;{case}
  until Car=#3;
end.

CONT3   4  74   0   0  571200
pascal-Taschenrechner begonnen 21.8.08 5:36:14
-----------------------------------------------------------------------------
WriteLn('��������������������������������������������������������������������Ŀ');
WriteLn('�                                                                    �');
WriteLn('� ����������������������������������������������������������������Ŀ �');
WriteLn('� �Error, �berlauf, noch ohne Funktion                           0 � �');
WriteLn('� ������������������������������������������������������������������ �');
WriteLn('� ����������������������������������������������������������������ͻ �');
WriteLn('� � Bin<F2>� Okt<F4>��Dez<F5>� Hex<F6>��Grad<F8>� Deg<F9>� Rad<F10>� �');
WriteLn('� ����������������������������������������������������������������͹ �');
WriteLn('� ��Inv<F3>��Hyp<F7>��Time<U>�CE<ENTF>�C<ESC>�<R�cktaste>� (=n � M � �');
WriteLn('� ����������������������������������������������������������������ͼ �');
WriteLn('�                                          �����������������������ͻ �');
WriteLn('�   1/x<K>        dms<D>        OR<O>      � A � B � C � D � E � F � �');
WriteLn('�                 Exp<E>       AND<&>      �����������������������ĺ �');
WriteLn('�   x^2<Q>        log<L>       XOR<X>      � 7 � 8 � 9 � / � % � MX� �');
WriteLn('�                  ln<N>       NOT<N>      �����������������������ĺ �');
WriteLn('�   x^3<$>        F-E<Wiss>    LSH(<)      � 4 � 5 � 6 � * � n!� MR� �');
WriteLn('�                                          �����������������������ĺ �');
WriteLn('�   x^y<^>        sin<S>       INT<I>      � 1 � 2 � 3 � - � pi� MC� �');
WriteLn('�                 cos<C>       DIV<\>      �����������������������ĺ �');
WriteLn('�   SQR<R>        tan<T>       MOD<#>      � 0 � , �+/-� + � = � M+� �');
WriteLn('�                                          �����������������������ͼ �');
WriteLn('�                                          Der GERRiTsoft-Calculator �');
WriteLn('����������������������������������������������������������������������');

procedure BinDez;
var i,j:Longint;
begin
  a:=0;j:=1;
  for i:=Length(P)downto 1do
    begin
      if P[i]='1'then a:=a+j;
      j:=j+j;
    end;
end;

Zuerst Grundversion mit einfachen Rechenarten und DEZ-Hex

 Bin�r: Zweierkomplement=Not?
+/-=V (Vorzeichen bzw. -(-n)

 F1: Hilfe zu Tastenkombis
LSH�(wie MC!)
 Err200: /0 nicht definiert abfangen!
 M rot, wenn Speicher <0
 F-E wiss. Notation 5=5e+0 darum W statt V
 dms:wandelt Zahlen in Zeitangaben um: 1.50 = 1.30
 12:   23:14+8:16:12-23:1:0
 F2: Bin�r 1-0, nochmal F2: Bin�r L-O
 Punkt �Alt+250
 K�stchen �Alt+254

optischer Aufgeiler w�re Skin geb�rstetes Metall cyan auf grau Zeichen B2
Alt+178 �
TextAttr:=3*16+7;{cyan}
for i:=1to 2000do
  write(#178);
TextAttr:=7;write('':30);