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

2 files changed, 115 insertions, 13 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;
diff --git a/mystringlistunit.pas b/mystringlistunit.pas
index cdc0933..af2ce33 100644
--- a/mystringlistunit.pas
+++ b/mystringlistunit.pas
@@ -5,7 +5,7 @@ unit mystringlistunit;
 interface
 
 uses
-  Classes, SysUtils, RegExpr, Process, protokollunit;
+  Classes, SysUtils, RegExpr, Process, protokollunit, matheunit;
 
 type
   tMyStringList = class (tStringList)
@@ -31,7 +31,8 @@ type
     function stillNeed(bez: string): boolean;
     function needInLine(bez: string; lin: longint): boolean;
     procedure insert(index: longint; const s: ansistring); override;
-    function unfoldMacros: boolean;
+    function unfoldMacros: boolean; overload; inline;
+    function unfoldMacros(kvs: tKnownValues; cbgv: tCallBackGetValue): boolean; overload;
     procedure subst(regex,ersatz: string);
     procedure dump(pro: tProtokollant; prefix: string);
     procedure nichtInSubRoutine(s: string);
@@ -245,6 +246,11 @@ begin
 end;
 
 function tMyStringlist.unfoldMacros: boolean;
+begin
+  result:=unfoldMacros(nil,nil);
+end;
+
+function tMyStringlist.unfoldMacros(kvs: tKnownValues; cbgv: tCallBackGetValue): boolean;
 var
   i,j,k,l,Ebene:                longint;
   s,t,u,v:                      string;
@@ -268,9 +274,27 @@ begin
     inc(i);
   end;
 
+  i:=0;
+  while i<count-1 do // "\Zeilenumbruch" löschen
+    if rightStr(self[i],1)='\' then begin
+      s:=self[i];
+      self[i]:=trim(leftStr(s,length(s)-1))+' '+self[i+1];
+      delete(i+1);
+    end
+    else inc(i);
+
   repeat
     wasGefunden:=false;
 
+    for i:=0 to count-1 do begin   // Gleichungen auswerten
+      s:=formelnAuswerten(self[i],kvs,cbgv);
+      if s<>self[i] then begin
+        wasGefunden:=true;
+        self[i]:=s;
+      end;
+    end;
+    if wasGefunden then continue;
+
     i:=0;
     while i<count do begin  // Übersprünge überspringen, alles nach 'Dateiende' löschen
       s:=self[i];