matheunit.pas und mystringlistunit.pas können jetzt auch Formeln auswerten

1 files changed, 89 insertions, 11 deletions

diff --git a/matheunit.pas b/matheunit.pas
index c62f3fd..431345c 100644
--- a/matheunit.pas
+++ b/matheunit.pas
@@ -39,12 +39,15 @@ function cmpStr(s1,s2: string): longint;
 function mitte(s1,s2: string): string;
 function myFloatToStr(x: extended): string;
 function myStrToFloat(s: string): extended;
+function intToFixpoint(x,stellen: longint): string;
+function floatToFixpoint(x: extended; vk,nk: longint): string;
 function istGanzZahl(s: string): boolean;
 procedure copyArray(i: tExtPointArray; out o: tExtPointArray); overload;
 procedure copyArray(i: tLongintArray; out o: tLongintArray); overload;
 procedure copyArray(i: tExtendedArray; out o: tExtendedArray); overload;
 function nullfunktion(x: extended): extended;
 function exprtofloat(st: boolean; s: string; kvs: tKnownValues; cbgv: tCallBackGetValue): extended;
+function formelnAuswerten(s: string; kvs: tKnownValues; cbgv: tCallBackGetValue): string;
 function knownValue(nam: string; val: extended): tKnownValue;
 procedure fft(var res,ims: tExtendedArray; inv: boolean); inline;
 
@@ -322,6 +325,26 @@ begin
    result:=-result;
 end;
 
+function intToFixpoint(x,stellen: longint): string;
+var
+  neg: boolean;
+begin
+  neg:=x<0;
+  if neg then
+    x:=-x;
+  result:=inttostr(x);
+  while length(result)+byte(neg)<stellen do
+    result:='0'+result;
+  if neg then
+    result:='-'+result;
+end;
+
+function floatToFixpoint(x: extended; vk,nk: longint): string;
+begin
+  result:=intToFixpoint(round(x*power(10,nk)),vk+nk);
+  result:=leftStr(result,length(result)-nk)+'.'+rightStr(result,nk);
+end;
+
 function istGanzZahl(s: string): boolean;
 var
   i:              longint;
@@ -494,21 +517,76 @@ begin
       halt(1);
     end;
   end;
-(*   if s='np' then result:=params.np
-  else if s='maxw' then result:=params.maxW
-  else if s='minw' then result:=params.minW
-  else if s='beta' then result:=params.beta
-  else if s='xstart' then result:=params.xstart
-  else if s='xstop' then result:=params.xstop
-  else if s='tstart' then result:=params.tstart
-  else if s='tstop' then result:=params.tstop
-  else if st then result:=1
-  else if assigned(cbgv) then result:=cbgv(s)
-  else result:=nan; *)
 
   result:=result*(2*byte(not neg)-1);
 end;
 
+function formelnAuswerten(s: string; kvs: tKnownValues; cbgv: tCallBackGetValue): string;
+var
+  i,start,mitte,
+    vk,nk:       longint;
+  t:             string;
+  ok:            boolean;
+  wert:          extended;
+begin
+  ok:=false;
+  i:=1;
+  mitte:=0;
+  start:=0;
+  while i<=length(s) do begin
+    if copy(s,i,2)='$[' then begin
+      ok:=true;
+      i:=i+2;
+      start:=i;
+      continue;
+    end;
+    if ok then
+      case s[i] of
+        ';':
+          mitte:=i;
+        ']': begin
+          if mitte<=start then
+            mitte:=i;
+          t:=trim(copy(s,start,mitte-start));
+          try
+            wert:=exprtofloat(false,t,kvs,cbgv);
+          except
+            ok:=false;
+            inc(i);
+            continue;
+          end;
+          if mitte<>i then begin
+            t:=trim(copy(s,mitte+1,i-mitte-1));
+            if pos('.',t)=0 then
+              t:=t+'.0';
+            try
+              vk:=strtoint(erstesArgument(t,'.'));
+              nk:=strtoint(t);
+            except
+              ok:=false;
+              inc(i);
+              continue;
+            end;
+            if nk=0 then
+              t:=intToFixpoint(round(wert),vk)
+            else
+              t:=floatToFixpoint(wert,vk,nk);
+          end
+          else // keine Formatierung => generisch als float umwandeln
+            t:=floattostr(wert);
+
+          s:=
+            leftStr(s,start-3) + t + rightStr(s,length(s)-i);
+          i:=start-3 + length(t);
+          continue;
+        end;
+        '$': ok:=false;
+      end{of case};
+    inc(i);
+  end;
+  result:=s;
+end;
+
 function knownValue(nam: string; val: extended): tKnownValue;
 begin
   result.name:=nam;