home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d6 / FRCLX.ZIP / SOURCE / FR_Pars.pas < prev    next >
Pascal/Delphi Source File  |  2001-07-01  |  20KB  |  760 lines
  1.  
  2. {******************************************}
  3. {                                          }
  4. {           FastReport CLX v2.4            }
  5. {            Expression parser             }
  6. {                                          }
  7. { Copyright (c) 1998-2001 by Tzyganenko A. }
  8. {                                          }
  9. {******************************************}
  10.  
  11. unit FR_Pars;
  12.  
  13. interface
  14.  
  15. {$I FR.inc}
  16.  
  17. uses SysUtils, Classes, Variants;
  18.  
  19. type
  20.   TGetPValueEvent = procedure(const s: String; var v: Variant) of object;
  21.   TFunctionEvent = procedure(const Name: String; p1, p2, p3: Variant;
  22.                              var Val: Variant) of object;
  23.  
  24. // TfrParser is intended for calculating expressions passed as string
  25. // parameter like '1 + 2 * (a + b)'. Expression can contain variables and
  26. // functions. There is two events in TfrParser: OnGetValue and OnFunction
  27. // intended for substitute var/func value instead of var/func name.
  28. // Call TfrParser.Calc(Expression) to get expression value.
  29.  
  30.   TfrParser = class
  31.   private
  32.     FOnGetValue: TGetPValueEvent;
  33.     FOnFunction: TFunctionEvent;
  34.     function GetIdentify(const s: String; var i: Integer): String;
  35.     function GetString(const s: String; var i: Integer):String;
  36.     procedure Get3Parameters(const s: String; var i: Integer;
  37.       var s1, s2, s3: String);
  38.   public
  39.     function Str2OPZ(s: String): String;
  40.     function CalcOPZ(const s: String): Variant;
  41.     function Calc(const s: String): Variant;
  42.     property OnGetValue: TGetPValueEvent read FOnGetValue write FOnGetValue;
  43.     property OnFunction: TFunctionEvent read FOnFunction write FOnFunction;
  44.   end;
  45.  
  46.  
  47. // TfrVariables is tool class intended for storing variable name and its
  48. // value. Value is of type Variant.
  49. // Call TfrVariables['VarName'] := VarValue to set variable value and
  50. // VarValue := TfrVariables['VarName'] to retrieve it.
  51.  
  52.   TfrVariables = class(TObject)
  53.   private
  54.     FList: TStringList;
  55.     procedure SetVariable(const Name: String; Value: Variant);
  56.     function GetVariable(const Name: String): Variant;
  57.     procedure SetValue(Index: Integer; Value: Variant);
  58.     function GetValue(Index: Integer): Variant;
  59.     procedure SetName(Index: Integer; Value: String);
  60.     function GetName(Index: Integer): String;
  61.     function GetCount: Integer;
  62.     procedure SetSorted(Value: Boolean);
  63.     function GetSorted: Boolean;
  64.   public
  65.     constructor Create;
  66.     destructor Destroy; override;
  67.     procedure Assign(Value: TfrVariables);
  68.     procedure Clear;
  69.     procedure Delete(Index: Integer);
  70.     function IndexOf(const Name: String): Integer;
  71.     procedure Insert(Position: Integer; const Name: String);
  72.     property Variable[const Name: String]: Variant
  73.       read GetVariable write SetVariable; default;
  74.     property Value[Index: Integer]: Variant read GetValue write SetValue;
  75.     property Name[Index: Integer]: String read GetName write SetName;
  76.     property Count: Integer read GetCount;
  77.     property Sorted: Boolean read GetSorted write SetSorted;
  78.   end;
  79.  
  80.  
  81. // TfrFunctionSplitter is internal class, you typically don't need to use it.
  82. // It intended for splitting expression onto several parts and checking
  83. // if it contains some specified functions.
  84. // TfrFunctionSplitter used when checking if objects has aggregate functions
  85. // inside.
  86.  
  87.   TfrFunctionSplitter = class
  88.   protected
  89.     FMatchFuncs, FSplitTo: TStrings;
  90.     FParser: TfrParser;
  91.     FVariables: TfrVariables;
  92.   public
  93.     constructor Create(MatchFuncs, SplitTo: TStrings; Variables: TfrVariables);
  94.     destructor Destroy; override;
  95.     procedure Split(s: String);
  96.   end;
  97.  
  98.  
  99. function GetBrackedVariable(const s: String; var i, j: Integer): String;
  100.  
  101. implementation
  102.  
  103.  
  104. type
  105.   PVariable = ^TVariable;
  106.   TVariable = record
  107.     Value: Variant;
  108.   end;
  109.  
  110. const
  111.   ttGe = #1; ttLe = #2;
  112.   ttNe = #3; ttOr = #4; ttAnd = #5;
  113.   ttInt = #6;  ttFrac = #7;
  114.   ttUnMinus = #9; ttUnPlus = #10; ttStr = #11;
  115.   ttNot = #12; ttMod = #13; ttRound = #14;
  116.  
  117.  
  118. function GetBrackedVariable(const s: String; var i, j: Integer): String;
  119. var
  120.   c: Integer;
  121.   fl1, fl2: Boolean;
  122. begin
  123.   j := i; fl1 := True; fl2 := True; c := 0;
  124.   Result := '';
  125.   if s = '' then Exit;
  126.   Dec(j);
  127.   repeat
  128.     Inc(j);
  129.     if fl1 and fl2 then
  130.       if s[j] = '[' then
  131.       begin
  132.         if c = 0 then i := j;
  133.         Inc(c);
  134.       end
  135.       else if s[j] = ']' then Dec(c);
  136.     if fl1 then
  137.       if s[j] = '"' then fl2 := not fl2;
  138.     if fl2 then
  139.       if s[j] = '''' then fl1 := not fl1;
  140.   until (c = 0) or (j >= Length(s));
  141.   Result := Copy(s, i + 1, j - i - 1);
  142. end;
  143.  
  144.  
  145. { TfrVariables }
  146.  
  147. constructor TfrVariables.Create;
  148. begin
  149.   inherited Create;
  150.   FList := TStringList.Create;
  151.   FList.Duplicates := dupIgnore;
  152. end;
  153.  
  154. destructor TfrVariables.Destroy;
  155. begin
  156.   Clear;
  157.   FList.Free;
  158.   inherited Destroy;
  159. end;
  160.  
  161. procedure TfrVariables.Assign(Value: TfrVariables);
  162. var
  163.   i: Integer;
  164. begin
  165.   Clear;
  166.   for i := 0 to Value.Count - 1 do
  167.     SetVariable(Value.Name[i], Value.Value[i]);
  168. end;
  169.  
  170. procedure TfrVariables.Clear;
  171. begin
  172.   while FList.Count > 0 do
  173.     Delete(0);
  174. end;
  175.  
  176. procedure TfrVariables.SetVariable(const Name: String; Value: Variant);
  177. var
  178.   i: Integer;
  179.   p: PVariable;
  180. begin
  181.   i := IndexOf(Name);
  182.   if i <> -1 then
  183.     PVariable(FList.Objects[i]).Value := Value
  184.   else
  185.   begin
  186.     New(p);
  187.     p^.Value := Value;
  188.     FList.AddObject(Name, TObject(p));
  189.   end;
  190. end;
  191.  
  192. function TfrVariables.GetVariable(const Name: String): Variant;
  193. var
  194.   i: Integer;
  195. begin
  196.   Result := Null;
  197.   i := IndexOf(Name);
  198.   if i <> -1 then
  199.     Result := PVariable(FList.Objects[i]).Value;
  200. end;
  201.  
  202. procedure TfrVariables.SetValue(Index: Integer; Value: Variant);
  203. begin
  204.   if (Index < 0) or (Index >= FList.Count) then Exit;
  205.   PVariable(FList.Objects[Index])^.Value := Value;
  206. end;
  207.  
  208. function TfrVariables.GetValue(Index: Integer): Variant;
  209. begin
  210.   Result := 0;
  211.   if (Index < 0) or (Index >= FList.Count) then Exit;
  212.   Result := PVariable(FList.Objects[Index])^.Value;
  213. end;
  214.  
  215. function TfrVariables.IndexOf(const Name: String): Integer;
  216. begin
  217.   Result := FList.IndexOf(Name);
  218. end;
  219.  
  220. procedure TfrVariables.Insert(Position: Integer; const Name: String);
  221. begin
  222.   SetVariable(Name, 0);
  223.   FList.Move(FList.IndexOf(Name), Position);
  224. end;
  225.  
  226. function TfrVariables.GetCount: Integer;
  227. begin
  228.   Result := FList.Count;
  229. end;
  230.  
  231. procedure TfrVariables.SetName(Index: Integer; Value: String);
  232. begin
  233.   if (Index < 0) or (Index >= FList.Count) then Exit;
  234.   FList[Index] := Value;
  235. end;
  236.  
  237. function TfrVariables.GetName(Index: Integer): String;
  238. begin
  239.   Result := '';
  240.   if (Index < 0) or (Index >= FList.Count) then Exit;
  241.   Result := FList[Index];
  242. end;
  243.  
  244. procedure TfrVariables.Delete(Index: Integer);
  245. var
  246.   p: PVariable;
  247. begin
  248.   if (Index < 0) or (Index >= FList.Count) then Exit;
  249.   p := PVariable(FList.Objects[Index]);
  250.   Dispose(p);
  251.   FList.Delete(Index);
  252. end;
  253.  
  254. procedure TfrVariables.SetSorted(Value: Boolean);
  255. begin
  256.   FList.Sorted := Value;
  257. end;
  258.  
  259. function TfrVariables.GetSorted: Boolean;
  260. begin
  261.   Result := FList.Sorted;
  262. end;
  263.  
  264.  
  265. { TfrParser }
  266.  
  267. function TfrParser.CalcOPZ(const s: String): Variant;
  268. var
  269.   i, j, k, i1, st, ci, cn: Integer;
  270.   s1, s2, s3, s4: String;
  271.   nm: Array[1..8] of Variant;
  272.   v: Double;
  273. begin
  274.   st := 1;
  275.   i := 1;
  276.   nm[1] := 0;
  277.   while i <= Length(s) do
  278.   begin
  279.     j := i;
  280.     case s[i] of
  281.       '+', ttOr:
  282.         nm[st - 2] := nm[st - 2] + nm[st - 1];
  283.       '-':
  284.         nm[st - 2] := nm[st - 2] - nm[st - 1];
  285.       '*', ttAnd:
  286.         nm[st - 2] := nm[st - 2] * nm[st - 1];
  287.       '/':
  288.         if nm[st - 1] <> 0 then
  289.           nm[st - 2] := nm[st - 2] / nm[st - 1] else
  290.           nm[st - 2] := 0;
  291.       '>':
  292.         if nm[st - 2] > nm[st - 1] then nm[st - 2] := 1
  293.         else nm[st - 2] := 0;
  294.       '<':
  295.         if nm[st - 2] < nm[st - 1] then nm[st - 2] := 1
  296.         else nm[st - 2] := 0;
  297.       '=':
  298.         if nm[st - 2] = nm[st - 1] then nm[st - 2] := 1
  299.         else nm[st - 2] := 0;
  300.       ttNe:
  301.         if nm[st - 2] <> nm[st - 1] then nm[st - 2] := 1
  302.         else nm[st - 2] := 0;
  303.       ttGe:
  304.         if nm[st - 2] >= nm[st - 1] then nm[st - 2] := 1
  305.         else nm[st - 2] := 0;
  306.       ttLe:
  307.         if nm[st - 2] <= nm[st - 1] then nm[st - 2] := 1
  308.         else nm[st - 2] := 0;
  309.       ttInt:
  310.         begin
  311.           v := nm[st - 1];
  312.           if Abs(Round(v) - v) < 1e-10 then
  313.             v := Round(v) else
  314.             v := Int(v);
  315.  
  316.           nm[st - 1] := v;
  317.         end;
  318.       ttFrac:
  319.         begin
  320.           v := nm[st - 1];
  321.           if Abs(Round(v) - v) < 1e-10 then
  322.             v := Round(v);
  323.  
  324.           nm[st - 1] := Frac(v);
  325.         end;
  326.       ttRound:
  327.         nm[st - 1] := Integer(Round(nm[st - 1]));
  328.       ttUnMinus:
  329.         nm[st - 1] := -nm[st - 1];
  330.       ttUnPlus:;
  331.       ttStr:
  332.         begin
  333.           if nm[st - 1] <> Null then
  334.             s1 := nm[st - 1] else
  335.             s1 := '';
  336.           nm[st - 1] := s1;
  337.         end;
  338.       ttNot:
  339.         if nm[st - 1] = 0 then nm[st - 1] := 1 else nm[st - 1] := 0;
  340.       ttMod:
  341.         nm[st - 2] := nm[st - 2] mod nm[st - 1];
  342.       ' ': ;
  343.       '[':
  344.         begin
  345.           k := i;
  346.           s1 := GetBrackedVariable(s, k, i);
  347.           if Assigned(FOnGetValue) then
  348.             FOnGetValue(s1, nm[st]);
  349.           Inc(st);
  350.         end
  351.       else
  352.         begin
  353.           if s[i] = '''' then
  354.           begin
  355.             s1 := GetString(s, i);
  356.             s1 := Copy(s1, 2, Length(s1) - 2);
  357.             while Pos('''' + '''', s1) <> 0 do
  358.               Delete(s1, Pos('''' + '''', s1), 1);
  359.             nm[st] := s1;
  360.             k := i;
  361.           end
  362.           else
  363.           begin
  364.             k := i;
  365.             s1 := GetIdentify(s, k);
  366.             if (s1 <> '') and (s1[1] in ['0'..'9', '.', ',']) then
  367.             begin
  368.               for i1 := 1 to Length(s1) do
  369.                 if s1[i1] in ['.', ','] then s1[i1] := DecimalSeparator;
  370.               nm[st] := StrToFloat(s1);
  371.             end
  372.             else if AnsiCompareText(s1, 'TRUE') = 0 then
  373.               nm[st] := True
  374.             else if AnsiCompareText(s1, 'FALSE') = 0 then
  375.               nm[st] := False
  376.             else if s[k] = '[' then
  377.             begin
  378.               s1 := 'GETARRAY(' + s1 + ', ' + GetBrackedVariable(s, k, i) + ')';
  379.               nm[st] := Calc(s1);
  380.               k := i;
  381.             end
  382.             else if s[k] = '(' then
  383.             begin
  384.               s1 := AnsiUpperCase(s1);
  385.               Get3Parameters(s, k, s2, s3, s4);
  386.               if s1 = 'COPY' then
  387.               begin
  388.                 ci := StrToInt(Calc(s3));
  389.                 cn := StrToInt(Calc(s4));
  390.                 nm[st] := Copy(Calc(s2), ci, cn);
  391.               end
  392.               else if s1 = 'IF' then
  393.               begin
  394.                 if Int(StrToFloat(Calc(s2))) > 0 then
  395.                   s1 := s3 else
  396.                   s1 := s4;
  397.                 nm[st] := Calc(s1);
  398.               end
  399.               else if s1 = 'STRTODATE' then
  400.                 nm[st] := StrToDate(Calc(s2))
  401.               else if s1 = 'STRTOTIME' then
  402.                 nm[st] := StrToTime(Calc(s2))
  403.               else if Assigned(FOnFunction) then
  404.                 FOnFunction(s1, s2, s3, s4, nm[st]);
  405.               Dec(k);
  406.             end
  407.             else
  408.               if Assigned(FOnGetValue) then
  409.                 FOnGetValue(AnsiUpperCase(s1), nm[st]);
  410.           end;
  411.           i := k;
  412.           Inc(st);
  413.         end;
  414.     end;
  415.     if s[j] in ['+', '-', '*', '/', '>', '<', '=', ttGe, ttLe, ttNe,
  416.       ttOr, ttAnd, ttMod] then
  417.       Dec(st);
  418.     Inc(i);
  419.   end;
  420.   Result := nm[1];
  421. end;
  422.  
  423. function TfrParser.GetIdentify(const s: String; var i: Integer): String;
  424. var
  425.   k, n: Integer;
  426. begin
  427.   n := 0;
  428.   while (i <= Length(s)) and (s[i] <= ' ') do
  429.     Inc(i);
  430.   k := i; Dec(i);
  431.   repeat
  432.     Inc(i);
  433.     while (i <= Length(s)) and
  434.       not (s[i] in [' ', #13, '+', '-', '*', '/', '>', '<', '=', '(', ')', '[']) do
  435.     begin
  436.       if s[i] = '"' then Inc(n);
  437.       Inc(i);
  438.     end;
  439.   until (n mod 2 = 0) or (i >= Length(s));
  440.   Result := Copy(s, k, i - k);
  441. end;
  442.  
  443. function TfrParser.GetString(const s: String; var i: Integer): String;
  444. var
  445.   k: Integer;
  446.   f: Boolean;
  447. begin
  448.   k := i; Inc(i);
  449.   repeat
  450.     while (i <= Length(s)) and (s[i] <> '''') do
  451.       Inc(i);
  452.     f := True;
  453.     if (i < Length(s)) and (s[i + 1] = '''') then
  454.     begin
  455.       f := False;
  456.       Inc(i, 2);
  457.     end;
  458.   until f;
  459.   Result := Copy(s, k, i - k + 1);
  460.   Inc(i);
  461. end;
  462.  
  463. procedure TfrParser.Get3Parameters(const s: String; var i: Integer;
  464.   var s1, s2, s3: String);
  465. var
  466.   c, d, oi, ci: Integer;
  467. begin
  468.   s1 := ''; s2 := ''; s3 := '';
  469.   c := 1; d := 1; oi := i + 1; ci := 1;
  470.   repeat
  471.     Inc(i);
  472.     if s[i] = '''' then
  473.       if d = 1 then Inc(d) else d := 1;
  474.     if d = 1 then
  475.     begin
  476.       if s[i] = '(' then
  477.         Inc(c) else
  478.       if s[i] = ')' then Dec(c);
  479.       if (s[i] = ',') and (c = 1) then
  480.       begin
  481.         if ci = 1 then
  482.           s1 := Copy(s, oi, i - oi) else
  483.           s2 := Copy(s, oi, i - oi);
  484.         oi := i + 1; Inc(ci);
  485.       end;
  486.     end;
  487.   until (c = 0) or (i >= Length(s));
  488.   case ci of
  489.     1: s1 := Copy(s, oi, i - oi);
  490.     2: s2 := Copy(s, oi, i - oi);
  491.     3: s3 := Copy(s, oi, i - oi);
  492.   end;
  493.   if c <> 0 then
  494.     raise Exception.Create('');
  495.   Inc(i);
  496. end;
  497.  
  498. function TfrParser.Str2OPZ(s: String): String;
  499. label 1;
  500. var
  501.   i, i1, j, p: Integer;
  502.   stack: String;
  503.   res, s1, s2, s3, s4: String;
  504.   vr: Boolean;
  505.   c: Char;
  506.  
  507.   function Priority(c: Char): Integer;
  508.   begin
  509.     case c of
  510.       '(': Priority := 5;
  511.       ')': Priority := 4;
  512.       '=', '>', '<', ttGe, ttLe, ttNe: Priority := 3;
  513.       '+', '-', ttUnMinus, ttUnPlus: Priority := 2;
  514.       '*', '/', ttOr, ttAnd, ttNot, ttMod: Priority := 1;
  515.       ttInt, ttFrac, ttRound, ttStr: Priority := 0;
  516.       else Priority := 0;
  517.     end;
  518.   end;
  519.  
  520.   procedure ProcessQuotes(var s: String);
  521.   var
  522.     i: Integer;
  523.   begin
  524.     if (Length(s) = 0) or (s[1] <> '''') then Exit;
  525.     i := 2;
  526.     if Length(s) > 2 then
  527.       while i <= Length(s) do
  528.       begin
  529.         if (s[i] = '''') and (i < Length(s)) then
  530.         begin
  531.           Insert('''', s, i);
  532.           Inc(i);
  533.         end;
  534.         Inc(i);
  535.       end;
  536.   end;
  537.  
  538. begin
  539.   res := '';
  540.   stack := '';
  541.   i := 1; vr := False;
  542.   while i <= Length(s) do
  543.   begin
  544.     case s[i] of
  545.       '(':
  546.         begin
  547.           stack := '(' + stack;
  548.           vr := False;
  549.         end;
  550.       ')':
  551.         begin
  552.           p := Pos('(', stack);
  553.           res := res + Copy(stack, 1, p - 1);
  554.           stack := Copy(stack, p + 1, Length(stack) - p);
  555.         end;
  556.       '+', '-', '*', '/', '>', '<', '=':
  557.         begin
  558.           if (s[i] = '<') and (s[i + 1] = '>') then
  559.           begin
  560.             Inc(i);
  561.             s[i] := ttNe;
  562.           end else
  563.           if (s[i] = '>') and (s[i + 1] = '=') then
  564.           begin
  565.             Inc(i);
  566.             s[i] := ttGe;
  567.           end else
  568.           if (s[i] = '<') and (s[i + 1] = '=') then
  569.           begin
  570.             Inc(i);
  571.             s[i] := ttLe;
  572.           end;
  573.  
  574. 1:        if not vr then
  575.           begin
  576.             if s[i] = '-' then s[i] := ttUnMinus;
  577.             if s[i] = '+' then s[i] := ttUnPlus;
  578.           end;
  579.           vr := False;
  580.           if stack = '' then stack := s[i] + stack
  581.           else
  582.             if Priority(s[i]) < Priority(stack[1]) then
  583.               stack := s[i] + stack
  584.             else
  585.             begin
  586.               repeat
  587.                 res := res + stack[1];
  588.                 stack := Copy(stack, 2, Length(stack) - 1);
  589.               until (stack = '') or (Priority(stack[1]) > Priority(s[i]));
  590.               stack := s[i] + stack;
  591.             end;
  592.         end;
  593.       ';': break;
  594.       ' ', #13: ;
  595.       else
  596.       begin
  597.         vr := True;
  598.         s2 := '';
  599.         i1 := i;
  600.         if s[i] = '%' then
  601.         begin
  602.           s2 := '%' + s[i + 1];
  603.           Inc(i, 2);
  604.         end;
  605.         if s[i] = '''' then
  606.           s2 := s2 + GetString(s, i)
  607.         else if s[i] = '[' then
  608.         begin
  609.           s2 := s2 + '[' + GetBrackedVariable(s, i, j) + ']';
  610.           i := j + 1;
  611.         end
  612.         else
  613.         begin
  614.           s2 := s2 + GetIdentify(s, i);
  615.           if s[i] = '[' then
  616.           begin
  617.             s2 := s2 + '[' + GetBrackedVariable(s, i, j) + ']';
  618.             i := j + 1;
  619.           end;
  620.         end;
  621.         c := s[i];
  622.         if (Length(s2) > 0) and (s2[1] in ['0'..'9', '.', ',']) then
  623.           res := res + s2 + ' '
  624.         else
  625.         begin
  626.           s1 := AnsiUpperCase(s2);
  627.           if s1 = 'INT' then
  628.           begin
  629.             s[i - 1] := ttInt;
  630.             Dec(i);
  631.             goto 1;
  632.           end
  633.           else if s1 = 'FRAC' then
  634.           begin
  635.             s[i - 1] := ttFrac;
  636.             Dec(i);
  637.             goto 1;
  638.           end
  639.           else if s1 = 'ROUND' then
  640.           begin
  641.             s[i - 1] := ttRound;
  642.             Dec(i);
  643.             goto 1;
  644.           end
  645.           else if s1 = 'OR' then
  646.           begin
  647.             s[i - 1] := ttOr;
  648.             Dec(i);
  649.             goto 1;
  650.           end
  651.           else if s1 = 'AND' then
  652.           begin
  653.             s[i - 1] := ttAnd;
  654.             Dec(i);
  655.             goto 1;
  656.           end
  657.           else if s1 = 'NOT' then
  658.           begin
  659.             s[i - 1] := ttNot;
  660.             Dec(i);
  661.             goto 1;
  662.           end
  663.           else if s1 = 'STR' then
  664.           begin
  665.             s[i - 1] := ttStr;
  666.             Dec(i);
  667.             goto 1;
  668.           end
  669.           else if s1 = 'MOD' then
  670.           begin
  671.             s[i - 1] := ttMod;
  672.             Dec(i);
  673.             goto 1;
  674.           end
  675.           else if c = '(' then
  676.           begin
  677.             Get3Parameters(s, i, s2, s3, s4);
  678.             res := res + Copy(s, i1, i - i1);
  679.           end
  680.           else res := res + s2 + ' ';
  681.         end;
  682.         Dec(i);
  683.       end;
  684.     end;
  685.     Inc(i);
  686.   end;
  687.   if stack <> '' then res := res + stack;
  688.   Result := res;
  689. end;
  690.  
  691. function TfrParser.Calc(const s: String): Variant;
  692. begin
  693.   Result := CalcOPZ(Str2OPZ(s));
  694. end;
  695.  
  696.  
  697. { TfrFunctionSplitter }
  698.  
  699. constructor TfrFunctionSplitter.Create(MatchFuncs, SplitTo: TStrings;
  700.   Variables: TfrVariables);
  701. begin
  702.   inherited Create;
  703.   FParser := TfrParser.Create;
  704.   FMatchFuncs := MatchFuncs;
  705.   FSplitTo := SplitTo;
  706.   FVariables := Variables;
  707. end;
  708.  
  709. destructor TfrFunctionSplitter.Destroy;
  710. begin
  711.   FParser.Free;
  712.   inherited Destroy;
  713. end;
  714.  
  715. procedure TfrFunctionSplitter.Split(s: String);
  716. var
  717.   i, k: Integer;
  718.   s1, s2, s3, s4: String;
  719. begin
  720.   i := 1;
  721.   s := Trim(s);
  722.   while i <= Length(s) do
  723.   begin
  724.     k := i;
  725.     if s[1] = '[' then
  726.     begin
  727.       s1 := GetBrackedVariable(s, k, i);
  728.       if FVariables.IndexOf(s1) <> -1 then
  729.         s1 := FVariables[s1];
  730.       Split(s1);
  731.       k := i + 1;
  732.     end
  733.     else
  734.     begin
  735.       s1 := FParser.GetIdentify(s, k);
  736.       if s[k] = '(' then
  737.       begin
  738.         FParser.Get3Parameters(s, k, s2, s3, s4);
  739.         Split(s2);
  740.         Split(s3);
  741.         Split(s4);
  742.         if FMatchFuncs.IndexOf(s1) <> -1 then
  743.           FSplitTo.Add(Copy(s, i, k - i));
  744.       end
  745.       else if FVariables.IndexOf(s1) <> -1 then
  746.       begin
  747.         s1 := FVariables[s1];
  748.         Split(s1);
  749.       end
  750.       else if s1 = '' then
  751.         break;
  752.     end;
  753.     i := k;
  754.   end;
  755. end;
  756.  
  757.  
  758. end.
  759.  
  760.