Delphi相談室その２

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); 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;
　 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 //ここがFourNum関数の根っこ
　next; 　addsub; 　Result:=num;
end;