home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d56 / TDSOFT.ZIP / EvaluationClass.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-01-30  |  4.3 KB  |  205 lines
  1. unit EvaluationClass;
  2.  
  3. interface
  4.  
  5. type TTDEvaluation = class(TObject)
  6.  
  7.   private
  8.     procedure PrimaOperazione(Espressione: String;
  9.                               var Operatore: Char;
  10.                               var Posizione: Integer);
  11.  
  12.     procedure RecuperaOperandi(Expression: String;
  13.                                 Op:Char;
  14.                                 Posizione: Cardinal;
  15.                                 var PrimoOperando,SecondoOperando: Extended);
  16.     procedure EseguiCalcolo(var strEx: String;
  17.                             Op: Char;
  18.                             POp,SOp: Extended);
  19.  
  20.   public
  21.     Expressions: String;
  22.     function Calculate: Extended;
  23.  
  24.  
  25. end;
  26.  
  27.  
  28. implementation
  29.  
  30. { TTDEvaluation }
  31.  
  32. uses SysUtils;
  33.  
  34. function TTDEvaluation.Calculate: Extended;
  35. var
  36.   Op: Char;
  37.   Posizione: Integer;
  38.   Expression, strEx: String;
  39.   PrimoOperando, SecondoOperando: Extended;
  40. begin
  41.   strEx:=StringReplace(Expressions,' ','',[rfReplaceAll]);     //Tolgo gli spazi
  42.   strEx:=StringReplace(Expressions,'.',',',[rfReplaceAll]);    //Punti in virgole
  43.  
  44.  
  45.  
  46.   while true do
  47.   begin
  48.     Op:=' ';
  49.     PrimaOperazione(strEx,Op,Posizione);
  50.     if Posizione<=1 then Break; //Condizione di uscita
  51.     RecuperaOperandi(strEx,Op,Posizione,PrimoOperando,SecondoOperando);
  52.     EseguiCalcolo(strEx,Op,PrimoOperando,SecondoOperando);
  53.   end;
  54.  
  55.   Result:=StrToFloat(strEx);
  56. end;
  57.  
  58. procedure TTDEvaluation.EseguiCalcolo(var strEx: String; Op: Char; POp,
  59.   SOp: Extended);
  60. var
  61.   Risultato: Extended;
  62. begin
  63.   case Op of
  64.  
  65.     '+':
  66.       Risultato:=POp + SOp;
  67.  
  68.     '-':
  69.       Risultato:=POp - SOp;
  70.  
  71.     '*':
  72.       Risultato:=POp * SOp;
  73.  
  74.     '/':
  75.       Risultato:=POp / SOp;
  76.  
  77.   end;
  78.  
  79.   strEx:=StringReplace(strEx,FloatToStr(POp) + Op + FloatToStr(SOp),FloatToStr(Risultato),[rfReplaceAll]);
  80.  
  81. end;
  82.  
  83. procedure TTDEvaluation.PrimaOperazione(Espressione: String;
  84.   var Operatore: Char; var Posizione: Integer);
  85. var
  86.   intPiu, intMeno, intPer, intDiviso: Integer;
  87. begin
  88.  
  89.  
  90.   if Espressione[1]<>'+' then
  91.     intPiu:= Pos('+',Espressione)
  92.   else
  93.     intPiu:=Pos('+',Copy(Espressione,2,Length(Espressione)));
  94.  
  95.  
  96.   if Espressione[1]<>'-' then
  97.     intMeno:= Pos('-',Espressione)
  98.   else
  99.     intMeno:=Pos('-',Copy(Espressione,2,Length(Espressione)));
  100.  
  101.   intPer:= Pos('*',Espressione);
  102.   intDiviso:= Pos('/',Espressione);
  103.   Operatore:=' ';
  104.   Posizione:=0;
  105. {******************** SIA * CHE / ***********************}
  106.   if (intPer<>0) and (intDiviso<>0) then
  107.   begin
  108.     if intPer<intDiviso then
  109.     begin
  110.       Operatore:='*';
  111.       Posizione:=intPer;
  112.     end
  113.     else
  114.     begin
  115.       Operatore:='/';
  116.       Posizione:=intDiviso;
  117.     end
  118.   end;
  119.  
  120.     if (intPer<>0) and (intDiviso=0) then
  121.     begin
  122.       Operatore:='*';
  123.       Posizione:=intPer;
  124.     end;
  125.  
  126.     if (intPer=0) and (intDiviso<>0) then
  127.     begin
  128.       Operatore:='/';
  129.       Posizione:=intDiviso;
  130.     end;
  131.  
  132.  
  133.  
  134.     {Se non ci sono più Moltiplicazioni o Divisioni...}
  135.     if Operatore=' ' then
  136.     begin
  137. {******************** SIA + CHE - ***********************}
  138.     if (intPiu<>0) and (intMeno<>0) then
  139.     begin
  140.       if intPiu<intMeno then
  141.       begin
  142.         Operatore:='+';
  143.         Posizione:=intPiu;
  144.       end
  145.       else
  146.       begin
  147.         Operatore:='-';
  148.         Posizione:=intMeno;
  149.       end
  150.     end
  151.     else
  152.     begin
  153.       if (intPiu<>0) and (intMeno=0) then
  154.       begin
  155.         Operatore:='+';
  156.         Posizione:=intPiu;
  157.       end;
  158.       if (intPiu=0) and (intMeno<>0) then
  159.       begin
  160.         Operatore:='-';
  161.         Posizione:=intMeno;
  162.       end;
  163.     end;
  164.   end;
  165.  
  166. end;
  167.  
  168. procedure TTDEvaluation.RecuperaOperandi(Expression: String; Op: Char;
  169.   Posizione: Cardinal; var PrimoOperando, SecondoOperando: Extended);
  170. var
  171.   I:Cardinal;
  172.   strOp1,strOp2: String;
  173. begin
  174.   if Posizione=1 then Exit;
  175.  
  176.   I:=Posizione;
  177.   //Recupero primo operando
  178.   Dec(I);
  179.   while Expression[I] in ['0'..'9',','] do
  180.   begin
  181.     strOp1:=Expression[I] + strOp1;
  182.     Dec(I);
  183.   end;
  184.   if (I=1) and ((Expression[1]='+') or (Expression[1]='-')) then
  185.     strOp1:=Expression[1] + strOp1;
  186.  
  187.   PrimoOperando:=StrToFloat(strOp1);
  188.  
  189.  
  190.  
  191.   I:=Posizione;
  192.   //Recupero secondo operando
  193.   Inc(I);
  194.   while Expression[I] in ['0'..'9',','] do
  195.   begin
  196.     strOp2:=strOp2 + Expression[I];
  197.     Inc(I);
  198.   end;
  199.   SecondoOperando:=StrToFloat(strOp2);
  200.  
  201.  
  202. end;
  203.  
  204. end.
  205.