diff options
-rw-r--r-- | matheunit.pas | 100 | ||||
-rw-r--r-- | mystringlistunit.pas | 28 |
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]; |