Delphiマンセー

このエントリーをはてなブックマークに追加
51四則演算
function FourNum(s:string):double ;
var num:double;
var sym:char;
 procedure addsub;forward;
 procedure next;
 var i,j:integer;
 const sep='^+-/*()<>';
 begin
  if s='' then begin sym:=#0;exit;end;
  for j:=1 to length(sep) do
  if s[1]=sep[j] then begin sym:=s[1]; delete(s,1,1);s:=trim(s); exit;end ;
  sym:=#1;
  for i:=2 to length(s) do
  for j:=1 to length(sep) do
  if s[i]=sep[j] then begin
    num:=StrToFloat(copy(s,1,i-1)); delete(s,1,i-1); exit;end;
  num:=StrToFloat(s);s:='';
 end;
  procedure factor;
  begin
  if(sym = #1) then next
  else if(sym = '(') then
   begin next; addsub;
     if(sym <> ')') then raise Exception.Create(' )がない');
     next;
   end
   else raise Exception.Create('数があるべき');
  end;
  procedure muldiv;
  var savenum:double;  var oldsym:char;
  begin
  factor;
  while (sym in ['*','/','^'] ) do begin
   savenum:=num;oldsym:=sym; next;
  factor;
   case oldsym of
      '*': num:=savenum*num;
      '/': num:=savenum/num;
      '^': num:=power(savenum,num);
   end;
  end;
  end;
 procedure addsub;
 var savenum:double; var oldsym:char;
 begin
   case sym of
    '+': begin next; muldiv;  end;
    '-': begin next; muldiv; num:=-num; end;
     else    muldiv;
   end;
  while (sym in [ '+','-'] ) do
   begin savenum:=num;oldsym:=sym; next; muldiv;
    case oldsym of
    '+': num:=savenum+num;
    '-': num:=savenum-num;
    end;
   end;
 end;
begin  next;  addsub;  Result:=num;
end;