formulaf.pas

ArtFormula package contains two nonvisual Delphi component for symbolic expression parsing and evalu

begin
 cnt := 1;
 Calc.Parent.StartGetVars(trunc(Calc.TopN));
 res := Calc.Parent.GetNextVar(x,true);
 s := getn(x);
 s2 := sqr(s);
 while res do
 begin
  res := Calc.Parent.GetNextVar(x,true);
  s := s + getn(x);
  s2 := s2 + sqr(getn(x));
  inc(cnt);
 end;
 setN(result, (cnt*s2-sqr(s))/(cnt*cnt));
end;

function mystddev(var Calc : TFormulaCalc):TCalcItem;
var x : TCalcItem;
    res : boolean;
var cnt:integer;
    s,s2:double;
begin
 cnt := 1;
 Calc.Parent.StartGetVars(trunc(Calc.TopN));
 res := Calc.Parent.GetNextVar(x,true);
 s := getn(x);
 s2 := sqr(s);
 while res do
 begin
  res := Calc.Parent.GetNextVar(x,true);
  s := s + getn(x);
  s2 := s2 + sqr(getn(x));
  inc(cnt);
 end;
 setN(result, sqrt((cnt*s2-sqr(s))/(cnt*(cnt-1))));
end;

function mystddevp(var Calc : TFormulaCalc):TCalcItem;
var x : TCalcItem;
    res : boolean;
var cnt:integer;
    s,s2:double;
begin
 cnt := 1;
 Calc.Parent.StartGetVars(trunc(Calc.TopN));
 res := Calc.Parent.GetNextVar(x,true);
 s := getn(x);
 s2 := sqr(s);
 while res do
 begin
  res := Calc.Parent.GetNextVar(x,true);
  s := s + getn(x);
  s2 := s2 + sqr(getn(x));
  inc(cnt);
 end;
 setN(result, sqrt(cnt*s2-sqr(s))/cnt);
end;

function myiff(var Calc : TFormulaCalc):TCalcItem;
begin
 //setN(result, ifthen(Calc.ItemN(2)<>0,Calc.ItemN(1),Calc.TopN));
 if Calc.ItemN(2)<>0 then result := Calc.Item(1)^ else
  result := Calc.Item(0)^;
end;

function mysign(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result, sign(Calc.TopN));
end;

function myrnd(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result, random);
end;

function myrandomize(var Calc : TFormulaCalc):TCalcItem;
begin
 randomize;
 setN(result, 0);
end;

function mychr(var Calc : TFormulaCalc):TCalcItem;
begin
 setS(result, chr(trunc(Calc.TopN)));
end;

function myinput(var Calc : TFormulaCalc):TCalcItem;
var s:string;
begin
 s := Calc.TopS;
 if not inputquery(Calc.ItemS(2),Calc.ItemS(1),s) then s := '';
 setS(result, s);
end;

function mylength(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result, length(Calc.TopS));
end;

function mytrim(var Calc : TFormulaCalc):TCalcItem;
begin
 setS(result, trim(Calc.TopS));
end;

function mytrimleft(var Calc : TFormulaCalc):TCalcItem;
begin
 setS(result, trimleft(Calc.TopS));
end;

function mytrimright(var Calc : TFormulaCalc):TCalcItem;
begin
 setS(result, trimright(Calc.TopS));
end;

function myuppercase(var Calc : TFormulaCalc):TCalcItem;
begin
 setS(result, AnsiUpperCase(Calc.TopS));
end;

function mylowercase(var Calc : TFormulaCalc):TCalcItem;
begin
 setS(result, AnsiLowerCase(Calc.TopS));
end;

function mymidstr(var Calc : TFormulaCalc):TCalcItem;
begin
 setS(result, copy(Calc.ItemS(2),trunc(Calc.ItemN(1)),trunc(Calc.TopN)));
end;

function myleftstr(var Calc : TFormulaCalc):TCalcItem;
begin
 setS(result, copy(Calc.ItemS(1),1,trunc(Calc.TopN)));
end;

function myrightstr(var Calc : TFormulaCalc):TCalcItem;
var s: string;
    len : integer;
begin
 s := Calc.ItemS(1);
 len := trunc(Calc.TopN);
 setS(result, copy(s,length(s) - len + 1,len));
end;

function mypos(var Calc : TFormulaCalc):TCalcItem;
begin
 if Calc.Parent.CaseSensitiveString then
  setN(result, pos(Calc.ItemS(1),Calc.TopS))
 else
  setN(result, pos(AnsiUppercase(Calc.ItemS(1)),AnsiUpperCase(Calc.TopS)))
end;

function mydate(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result, strtodatetime(Calc.TopS));
end;

function mynow(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result, Now);
end;

function myweek(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result, DayOfTheWeek(Calc.TopN));
end;

function myencodedate(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result, Encodedate(trunc(Calc.ItemN(2)),trunc(Calc.ItemN(1)),
                         trunc(Calc.TopN)));
end;

function myyear(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result, YearOf(Calc.TopN));
end;

function mymonth(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result, MonthOf(Calc.TopN));
end;

function myday(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result, DayOf(Calc.TopN));
end;

function myhour(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result, HourOf(Calc.TopN));
end;

function myminute(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result, MinuteOf(Calc.TopN));
end;

function mysecond(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result, SecondOf(Calc.TopN));
end;

function mymillisecond(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result, MillisecondOf(Calc.TopN));
end;

function myleapyear(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result, ifthen(IsLeapYear(trunc(Calc.TopN)),1,0));
end;

function myformat(var Calc : TFormulaCalc):TCalcItem;
begin
 setS(result, formatfloat(Calc.ItemS(1), Calc.TopN));
end;

function myformatf(var Calc : TFormulaCalc):TCalcItem;
begin
 setS(result, format(Calc.ItemS(1), [Calc.TopN]));
end;

function myformatdate(var Calc : TFormulaCalc):TCalcItem;
begin
 setS(result, formatdatetime(Calc.ItemS(1), Calc.TopN));
end;

function myisnumber(var Calc : TFormulaCalc):TCalcItem;
var yes : integer;
begin
 yes := 1;
 try
  Calc.TopN;
 except
  yes := 0;
 end;
 setN(result, yes);
end;

function mymsg(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result, Application.MessageBox(pchar(Calc.ItemS(2)),pchar(Calc.ItemS(1)),trunc(Calc.TopN)));
end;

function mycode(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result, ord(Calc.TopS[1]));
end;

function mystring(var Calc : TFormulaCalc):TCalcItem;
begin
 setS(result, stringofchar(Calc.ItemS(1)[1],trunc(Calc.TopN)));
end;

function myset(var Calc : TFormulaCalc):TCalcItem;
begin
 Calc.Parent.SetVar(Calc.ItemS(1),Calc.Item(0));
 result := Calc.Item(0)^;
end;

function myvar(var Calc : TFormulaCalc):TCalcItem;
begin
 Calc.Parent.AddVar(Calc.ItemS(1),Calc.Item(0));
 result := Calc.Item(0)^;
end;

function myval(var Calc : TFormulaCalc):TCalcItem;
begin
 result := Calc.Parent.GetVar(Calc.Tops)^;
end;

function myinc(var Calc : TFormulaCalc):TCalcItem;
begin
 result := Calc.Parent.IncVar(Calc.Tops)^;
end;

function mydec(var Calc : TFormulaCalc):TCalcItem;
begin
 result := Calc.Parent.DecVar(Calc.Tops)^;
end;

function myblock(var Calc : TFormulaCalc):TCalcItem;
begin
 if Calc.TopN > 0 then
  result := Calc.Item(1)^
 else setN(result,0);
end;

function myvars(var Calc : TFormulaCalc):TCalcItem;
var i,cnt:integer;
    x : TCalcItem;
begin
 cnt := trunc(Calc.TopN);
 x.data := 0;
 x.typ := fdtnumber;
 for i := 1 to cnt do Calc.Parent.AddVar(Calc.ItemS(i),@x);
 setN(result,cnt);
end;

end.