old/PAS/STRINGANALYZE/strcalc.PAS

Unit strcalc;
Interface
   Function StrFunc(f:string;va:real):real;
   Function Simply(a:string):real;
Implementation
const
 deyst: set of char = ['+','-','*','/','(',')','^','s','c','t','g','û','|'];

function calc(var sum : real; num:real;dey:char) : boolean;
var i : byte;
    res : real;
begin
  case dey of
       '^': begin
              if num = 0 then sum:=1;
              res:=sum;
              for i := 2 to round(num) do sum:=res*sum;
            end;
       's': sum := sin(num);
       'c': sum := cos(num);
       't': if cos(num) <> 0 then sum := sin(num)/cos(num)
            else sum := sin(num)/0.00001;
       'g': if sin(num) <> 0 then sum := cos(num)/sin(num)
            else sum := cos(num)/0.00001;
       '+': sum := sum + num;
       '-': sum := sum - num;
       '*': sum := sum * num;
       'û': sum := sqrt(abs(num));
       '|': sum := abs(num);
       '/': if num <> 0 then sum := sum / num
            else sum := sum / 0.00001;
  end;
  calc := true;
end;

function Findnum(var res:real;a:string;pos,dir:byte):byte;
var
  st    :string;
  code  :integer;
  old,ad:byte;
begin
 st:='';
 ad:=0;
 old:=pos;
 if dir = 1 then inc(pos) else dec(pos);
  if dir = 1 then
   while (not (a[pos] in deyst))and(pos<>length(a)+1) do
    begin
      st := st + a[pos];
      inc(pos);
    end
  else
   while (not (a[pos] in deyst)) and (pos<>0) do
    begin
      insert(a[pos],st,1);
      dec(pos);
    end;
 if (pos=1)and(a[pos]='-') then begin insert(a[pos],st,1);ad:=1 end;
 if st[1] = '_' then st[1] :='-';
 Val(st,res,code);
 FindNum:=abs(old-pos)-1+ad;
end;{FindNum}

Function Calculate(a:string):string;
var
  res       : real;
  j,i       : byte;
  code      : integer;
  ch        : byte;
  num1,num2 : real;
  len1,len2 : byte;
  tmp1,tmp2 : string;
  trig      : array [1..5] of byte;

begin
  if a[1] = '-' then a[1] := '_';
  while pos(' ',a) <> 0 do delete(a,pos(' ',a),1);

  while (pos('(',a)<>0) or (pos(')',a)<>0) do
   begin
     j:=pos('(',a);
     if j = 0 then exit;
     i := 1;
     ch := j+1;
     while (i <> 0)and(ch<>length(a)+1) do
      begin
       if a[ch] = '(' then inc(i);
       if a[ch] = ')' then dec(i);
       inc(ch);
      end;
     if (ch = length(a)+1) and (a[ch-1]<>')') then exit;
     tmp1:=copy(a,j+1,ch-j-2);
     tmp1:=calculate(tmp1);
     delete(a,j,ch-j);
     insert(tmp1,a,j);
   end;

  while pos('|',a)<>0 do
    begin
      i := pos('|',a);
      len1 := findnum(num1,a,i,0);
      str(num1:0:5,tmp1);
      len2 := findnum(num2,a,i,1);
      str(num2:0:5,tmp2);
      calc(num1,num2,a[i]);
      delete(a,i-len1,len1+1+len2);
      str(num1:0:5,tmp2);
      insert(tmp2,a,i-len1)
    end;

  while (pos('^',a)<>0)or(pos('û',a)<>0) do
    begin
      i := pos('^',a);
      j := pos('û',a);
      if ((j<i) or (i=0)) and (j<>0) then i:=j;
      len1 := findnum(num1,a,i,0);
      str(num1:0:5,tmp1);
      len2 := findnum(num2,a,i,1);
      str(num2:0:5,tmp2);
      calc(num1,num2,a[i]);
      delete(a,i-len1,len1+1+len2);
      str(num1:0:5,tmp2);
      if tmp2[1] = '-' then tmp2[1]:='_';
      insert(tmp2,a,i-len1)
    end;

  while (pos('s',a)<>0)or(pos('c',a)<>0)or(pos('t',a)<>0)or(pos('g',a)<>0) do
  begin
    trig[1]:=pos('s',a);
    trig[2]:=pos('c',a);
    trig[3]:=pos('t',a);
    trig[4]:=pos('g',a);
    trig[5]:=255;
    i:=5;
    for j := 1 to 4 do
      if (trig[j] < trig[i]) and (trig[j]<>0) then
        i := j;
    j := trig[i];
    len1 := findnum(num1,a,j,0);
    str(num1:0:5,tmp1);
    len2 := findnum(num2,a,j,1);
    str(num2:0:5,tmp2);
    calc(num1,num2,a[j]);
    delete(a,j-len1,len1+1+len2);
    str(num1:0:5,tmp2);
    if tmp2[1] = '-' then tmp2[1]:='_';
    insert(tmp2,a,j-len1)
  end;

  while (pos('*',a)<>0)or(pos('/',a)<>0) do
    begin
      i := pos('*',a);
      j := pos('/',a);
      if ((i<j) or (j=0)) and (i<>0) then j:=i;
      len1 := findnum(num1,a,j,0);
      str(num1:0:5,tmp1);
      len2 := findnum(num2,a,j,1);
      str(num2:0:5,tmp2);
      calc(num1,num2,a[j]);
      delete(a,j-len1,len1+1+len2);
      str(num1:0:5,tmp2);
      if tmp2[1] = '-' then tmp2[1]:='_';
      insert(tmp2,a,j-len1)
  end;

  while (pos('+',a)<>0)or(pos('-',a)<>0) do
  begin
      i := pos('+',a);
      j := pos('-',a);
      if ((i<j) or (j=0)) and (i<>0) then j := i;
      len1 := findnum(num1,a,j,0);
      str(num1:0:5,tmp1);
      len2 := findnum(num2,a,j,1);
      str(num2:0:5,tmp2);
      calc(num1,num2,a[j]);
      delete(a,j-len1,len1+1+len2);
      str(num1:0:5,tmp2);
      if tmp2[1] = '-' then tmp2[1]:='_';
      insert(tmp2,a,j-len1)
  end;
  calculate:=a;
end;

Function Simply(a:string):real;
var
 res:real;
 code:integer;
 i : byte;
begin
 while pos('sin',a) <> 0 do
  begin
    i:=pos('sin',a);
    delete(a,i,3);
    Insert('1s',a,i);
  end;
 while pos('cos',a) <> 0 do
  begin
    i:=pos('cos',a);
    delete(a,i,3);
    Insert('1c',a,i);
  end;
  while pos('tg',a) <> 0 do
  begin
    i:=pos('tg',a);
    delete(a,i,2);
    Insert('1t',a,i);
  end;
 while pos('ctg',a) <> 0 do
  begin
    i:=pos('ctg',a);
    delete(a,i,3);
    Insert('1g',a,i);
  end;

 while pos('sqrt',a) <> 0 do
  begin
    i:=pos('sqrt',a);
    delete(a,i,4);
    Insert('1û',a,i);
  end;

 while pos('abs',a) <> 0 do
  begin
    i:=pos('abs',a);
    delete(a,i,3);
    Insert('1|',a,i);
  end;

 a:=Calculate(a);
 if a[1] = '_' then a[1] :='-';
 val(a,res,code);
 Simply:=res;
end;
{----------------------------------}
Function StrFunc(f:string;va:real):real;
var p:byte;
    sva:string;
begin
  str(va:0:5,sva);
  if sva[1]='-' then sva[1]:='_';
  while pos('x',f)<>0 do
    begin
      p:=pos('x',f);
      delete(f,p,1);
      insert(sva,f,p);
    end;
  strfunc:=simply(f);
end;
end.