neue Dateien: matheunit.pas, mlockunit.pas, mystringlistunit.pas,

pseudohadamard.pas, randomunit.pas, systemunit.pas

1 files changed, 222 insertions, 0 deletions

diff --git a/matheunit.pas b/matheunit.pas
new file mode 100644
index 0000000..93d99d5
--- /dev/null
+++ b/matheunit.pas
@@ -0,0 +1,222 @@
+unit matheunit;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Gmp, Math;
+
+type
+  tExtPoint = record
+    x,y: extended;
+  end;
+  tExtPointArray = array of tExtPoint;
+  pTExtPointArray = ^tExtPointArray;
+  tLongintArray = array of longint;
+  pTLongintArray = ^tLongintArray;
+  tExtendedArray = array of extended;
+
+function plus(a,b: tExtPoint): tExtPoint;
+function durch(a: tExtPoint; b: extended): tExtPoint;
+function myFrac(x: extended): extended;
+function mpfToStr(f: mpf_t): string;
+function signSqr(x: extended): extended; inline;
+function mpfMyRoot(rad: mpf_t; wzlExp: int64): extended;
+function myTimeToStr(t: extended): string;
+function cmpStr(s1,s2: string): longint;
+function mitte(s1,s2: string): string;
+function myFloatToStr(x: extended): string;
+function myStrToFloat(s: string): extended;
+
+implementation
+
+function plus(a,b: tExtPoint): tExtPoint;
+begin
+  result.x:=a.x+b.x;
+  result.y:=a.y+b.y;
+end;
+
+function durch(a: tExtPoint; b: extended): tExtPoint;
+begin
+  result.x:=a.x/b;
+  result.y:=a.y/b;
+end;
+
+function myFrac(x: extended): extended;
+begin
+  result:=frac(x);
+  while result<0 do
+    result:=result+1;
+end;
+
+function mpfToStr(f: mpf_t): string;
+var
+  ex:  int64;
+  off: byte;
+begin
+ result:=mpf_get_str(nil,ex,10,0,f);
+ off:=1+byte(pos('-',result)=1);
+ if result='' then
+   result:='0'
+ else if ex=1 then
+   result:=copy(result,1,off)+','+copy(result,off+1,length(result)-off)
+ else
+   result:=copy(result,1,off)+','+copy(result,off+1,length(result)-off)+' * 10^'+inttostr(ex-1);
+end;
+
+function signSqr(x: extended): extended;
+begin
+ result:=sign(x)*sqr(x);
+end;
+
+function mpfMyRoot(rad: mpf_t; wzlExp: int64): extended;
+var
+  ex: int64;
+begin
+  result:=power(mpf_get_d_2exp(ex,rad),1/wzlExp);
+  result:=result*power(2,ex/wzlExp);
+end;
+
+function myTimeToStr(t: extended): string;
+var
+  tim: int64;
+begin
+ tim:=floor(t*24*60*60);
+ result:=inttostr(tim mod 10)+'s';
+ tim:=tim div 10;
+ if tim=0 then exit;
+ result:=inttostr(tim mod 6)+result;
+ tim:=tim div 6;
+ if tim=0 then exit;
+ result:=inttostr(tim mod 10)+'min '+result;
+ tim:=tim div 10;
+ if tim=0 then exit;
+ result:=inttostr(tim mod 6)+result;
+ tim:=tim div 6;
+ if tim=0 then exit;
+ result:=inttostr(tim mod 24)+'h '+result;
+ tim:=tim div 24;
+ if tim=0 then exit;
+ result:=' '+result;
+ if (tim mod 7)<>1 then
+   result:='e'+result;
+ result:=inttostr(tim mod 7)+'Tag'+result;
+ tim:=tim div 7;
+ if tim=0 then exit;
+ result:=' '+result;
+ if tim<>1 then
+   result:='n'+result;
+ result:=inttostr(tim)+'Woche'+result;
+end;
+
+function cmpStr(s1,s2: string): longint;
+var
+  i: longint;
+begin
+ for i:=1 to min(length(s1),length(s2)) do
+   if s1[i]<>s2[i] then begin
+     result:=2*byte(s1[i]>s2[i])-1;
+     exit;
+   end;
+ if length(s1)<>length(s2) then begin
+   result:=2*byte(length(s1)>length(s2))-1;
+   exit;
+ end;
+ result:=0;
+end;
+
+function mitte(s1,s2: string): string;
+var
+  i:    longint;
+  w,nw: word;
+begin
+ setlength(result,max(length(s1),length(s2)));
+ w:=0;
+ for i:=length(result) downto 1 do begin // result:= "s1+s2";
+   if i<=length(s1) then
+     w:=w+byte(s1[i]);
+   if i<=length(s2) then
+     w:=w+byte(s2[i]);
+   result[i]:=char(w and $ff);
+   w:=w shr 8;
+ end;
+ result:=char(w)+result;
+ w:=0;
+ for i:=1 to length(result) do begin
+   nw:=byte(odd(byte(result[i])+w));
+   result[i]:=char((byte(result[i])+w) div 2);
+   w:=nw shl 8;
+ end;
+ if w<>0 then
+   result:=result+char(w div 2);
+ if result[1]<>#0 then begin
+   writeln('Fehler bei der Mittenfindeung!');
+   halt;
+ end;
+ delete(result,1,1);
+end;
+
+function myFloatToStr(x: extended): string;
+var
+  i,e: longint;
+begin
+ e:=0;
+ if x<0 then begin
+   result:='-';
+   x:=-x;
+ end
+ else
+   result:='';
+ if x=0 then begin
+   result:='0';
+   exit;
+ end;
+ while x<1 do begin
+   dec(e);
+   x:=x*10;
+ end;
+ while x>=10 do begin
+   inc(e);
+   x:=x/10;
+ end;
+ result:=result+char(ord('0')+floor(x))+'.';
+ for i:=0 to 20 do begin
+   x:=(x-floor(x))*10;
+   result:=result+char(ord('0')+floor(x));
+ end;
+ if e<>0 then
+   result:=result+'E'+inttostr(e);
+end;
+
+function myStrToFloat(s: string): extended;
+var
+  i,e: longint;
+  neg: boolean;
+begin
+ if pos('E',s)>0 then begin
+   e:=strtoint(rightStr(s,length(s)-pos('E',s)));
+   delete(s,pos('E',s),length(s));
+ end
+ else e:=0;
+ if pos('.',s)=0 then begin
+   result:=strtoint(s)*power(10,e);
+   exit;
+ end;
+ neg:=leftStr(s,1)='-';
+ if neg then
+   delete(s,1,1);
+ if pos('.',s)=2 then begin
+   result:=0;
+   for i:=length(s) downto 3 do
+     result:=result/10 + ord(s[i])-ord('0');
+   result:=result/10 + ord(s[1])-ord('0');
+ end
+ else result:=strtofloat(s);
+ result:=result*power(10,e);
+ if neg then
+   result:=-result;
+end;
+
+end.
+