一个新算法的表达式求值的函数

我经过思考，自已做了一个表达式求值的函数，与标准算法不同，这是我闭门造车而成的，目的在于求简单。我这个函数有两个BUG，我目前已懒得改，当然是可以改的，一个是小数点0.999999999。。。。。未自动消除为1，二是本来乘法与除法是同级的，我这是成了乘法高级过除法。时间匆忙，来不及多说，让读者看了再说吧。另辟溪径也许有利于开拓新思路吧。我的邮箱是myvbvc@tom.com

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,StrUtils, Spin;

type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Button2: TButton;
SpinEdit1: TSpinEdit;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
function nospace(s:string):string;
begin
result:= stringreplace(s,'''' '''','''''''',[rfReplaceAll]);
end;
function is123(c:char):boolean;
begin
if c in [''''0''''..''''9'''',''''.'''']
then result:=true
else result:=false;

end;
function isminus(s:string;i:integer):boolean ;
var
t:integer;
begin

for t:=i-1 downto 1 do
begin
if s[t]='''')'''' then
begin
result:=false;
break;
end;
if (s[t]=''''('''') and (s[t 1]=''''-'''') then
begin
result:=true;
break;
end;
if (not is123(s[t])) and ( not ((s[t]=''''-'''') and(s[t-1]=''''(''''))) then
begin
result:=false;
break;
end;
end;
end;

function firstJ(s:string):integer ;
var
i,L:integer;
begin
result:=0;
L:=length(s);
for i:=1 to L do
begin
if (s[i]='''')'''') and (not isminus(s,i)) then
begin
result:=i;
break;
end;

end;
end;
function firstC(s:string;firstJ:integer):integer ;
var
t:integer;
begin
for t:=firstJ downto 1 do
begin
if (s[t]=''''('''') and (s[t 1]<>''''-'''') then
begin
result:=t;
break;
end;

end;
end;
function firstsign(s:string):integer ;
var
i:integer;
begin
result:=0;
for i:=1 to length(s) do
if s[i] in ['''' '''',''''-'''',''''*'''',''''/''''] then
begin
result:=i;
exit;
end;
end;
function firstsignEX(s:string;sigh:char):integer ;
var
i:integer;
begin
result:=0;
for i:=1 to length(s) do
if s[i]=sigh then
begin
result:=i;
exit;
end;
end;
function firstMinussignEX(s:string):integer ;
var
i:integer;
begin
result:=0;
for i:=1 to length(s) do
if (s[i]=''''-'''') and (s[i-1]<>''''('''') then
begin
result:=i;
exit;
end;
end;
function secondsign(s:string):integer ;
var
i,j:integer;
begin
j:=firstsign(s);

for i:=j 1 to length(s) do
if s[i] in ['''' '''',''''-'''',''''*'''',''''/''''] then
begin
result:=i;
exit;
end;
result:=length(s);
end;
function secondsignEX(s:string;sigh:char):integer ;
var
i,j:integer;
begin
j:=firstsignex(s,sigh);

for i:=j 1 to length(s) do
if s[i] in ['''' '''',''''-'''',''''*'''',''''/''''] then
begin
result:=i;
exit;
end;
result:=length(s);
end;
function leftnum(s:string;i:integer):double ;
var
t,L:integer;
begin
L:=length(s);
if s[i-1]='''')'''' then
begin
for t:=i-1 downto 1 do
if s[t]=''''('''' then
begin
result:=strtofloat(copy(s,t 1,i-2-t));
exit;
end;
end
else
begin
for t:=i-1 downto 1 do
begin
if not is123(s[t]) then
begin
result:=strtofloat(copy(s,t 1,i-1-t));
exit;
end;
if t=1 then result:=strtofloat(leftstr(s,i-1));
end;
end;

end;
function rightnum(s:string;i:integer):double ;
var
t,L:integer;
begin
L:=length(s);
if s[i 1]=''''('''' then
begin
for t:=i 2 to L do
if s[t]='''')'''' then
begin
result:=strtofloat(copy(s,i 2,t-i-2));
exit;
end;
end
else
begin
for t:=i 1 to L do
begin
if not is123(s[t]) then
begin
result:=strtofloat(copy(s,i 1,t-i-1));
exit;
end;
if t=L then result:=strtofloat(rightstr(s,L-i));
end;
end;
end;
/////////////////////////////////
function leftsigh(s:string;i:integer):integer ;
var
t,L:integer;
begin
L:=length(s);
if s[i-1]='''')'''' then
begin
for t:=i-1 downto 1 do
if s[t]=''''('''' then
begin
result:=t;
exit;
end;
end
else
begin
for t:=i-1 downto 1 do
begin
if not is123(s[t]) then

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有