UnitTools.pas

Top  Previous  Next

{*****************************************************************************}

{                                                                             }

{    Graph Package 1.0.1                                                      }

{    Date released : July 29, 2005                                            }

{    http://www.bk02.net/gpack                                                }

{    Copyright (c) 2004-2005 BK02 Team                                        }

{                                                                             }

{*****************************************************************************}

 

unit UnitTool;

 

interface

 

uses Graphics, SysUtils, UnitParsor ,Math;

 

const

   MaxShape = 100;

   RoundRate = 1;

   TruncRate = 0.001;

   Infinite=1000000;

   MaxResolutionX=1024;

   MaxResolutionY=768;

   LCount=1000;

var

   Dir : string;

 

type

   Float = Single;

   TStringDynArray       = array of string;

   {$EXTERNALSYM TStringDynArray}

 

   //Evaluate

   function Evaluate(Expression:string):float;overload;

   function Evaluate(Expression:string;Var1:char;Val1:float):float;overload;

   function Evaluate(Expression:string;var1,var2:char;val1,val2:float):float;overload;

   function Evaluate(Expression:string;var1,var2,var3:char;val1,val2,val3:float):float;overload;

   procedure Evaluate(Expression:string;var1:char;Count:integer;Val1:array of float;var Result:array of float);overload;

   procedure Evaluate(Expression:string;var1,var2:char;Count:integer;val1,val2:array of float;var Result:array of float);overload;

   procedure Evaluate(Expression:string;var1,var2,var3:char;Count:integer;val1,val2,val3:array of float;var Result:array of float);overload;

   //Swap

   procedure Swap(var a,b:integer);overload;

   procedure Swap(var a,b:float);overload;

   procedure Swap(var a,b:string);overload;

   //String

   function StrDelSpc(s:string):string;

   function StrReplace(s:string;olds,news:string):string;

   function StrUpper(s:string):string;

   function StrLower(s:string):string;

   function StrNormal(s:string):string;

   function StrSplit(S:string;ch:char):TStringDynArray;

   function StrConcat(ArrS:array of string;Space:string):string;

   procedure StrReplaceFirst(var S:string;olds,news:string);

   procedure StrReplaceLast(var S:string;OldS,NewS:string);

   //Other

   procedure ConvertV3ToS(X,Y,Z:float;var r,a,b:float);

   procedure ConvertSToV3(R,A,B:float;var X,Y,Z:float);

   procedure InterpolateColor(Color0,Color1:TColor;Count:integer;var TempColor:array of TColor);

 

implementation

 

var

   TempInteger:integer;

   TempFloat:Float;

   TempString:string;

   VarEval:TExpress;

 

//-----------------------------------SWAP-----------------------------------

 

procedure Swap(var a,b:integer);

begin

  TempInteger:=a;

  a:=b;

  b:=TempInteger;

end;

 

procedure Swap(var a,b:float);

begin

  Tempfloat:=a;

  a:=b;

  b:=Tempfloat;

end;

 

procedure Swap(var a,b:string);

begin

  TempString:=a;

  a:=b;

  b:=TempString;

end;

 

//-----------------------------------STRING-----------------------------------

 

function StrUpper(s:string):string;

begin

   Result:=uppercase(s);

end;

 

function StrLower(s:string):string;

begin

   Result:=lowercase(s);

end;

 

function StrNormal(s:string):string;

begin

   Result:=lowercase(s);

   if length(s)>0 then Result[1]:=upcase(S[1]);

end;

 

function StrDelSpc(s:string):string;

var i:integer;

begin

  i:=1;

  while(i<=length(s))do

     if(s[i]=' ')then delete(s,i,1)else inc(i);

  result:=uppercase(s);

end;

 

function StrReplace(s:string;olds,news:string):string;

begin

   Result:=StringReplace(s,olds,news,[rfReplaceAll, rfIgnoreCase]);

end;

 

function StrSplit(S:string;Ch:char):TStringDynArray;

var

   i,Count:integer;

   ArrS:TStringDynArray;

begin

   if (S = '') then

       begin Result := nil; exit; end;

   if (S[length(s)]<>Ch) then S:=S+Ch;

   //Count Ch

   Count:=0;

   for i:=1 to length(S)do

       if (s[i]=ch) then inc(Count);

   //Create New Array

   SetLength(ArrS,Count);

   //Fill up Array

   Count:=0;

   i:=Pos(Ch,S);

   while(i>0)do begin

       ArrS[Count]:=copy(S,1,i-1);

       inc(Count);

       //Find Next

       delete(s,1,i);

       i:=pos(Ch,S);

   end;

   Result:=ArrS;

end;

 

function StrConcat(ArrS:array of string;Space:string):string;

var

   i:integer;

   S:string;

begin

   S:=ArrS[0];

   for i:=1 to Length(ArrS)-1 do

       S:=S+Space+ArrS[i];

   Result:=S;

end;

 

procedure StrReplaceFirst(var S:string;Olds,News:string);

var k:integer;

begin

   k:=pos(olds,S);

   if (k>0) then begin

       delete(s,k,length(olds));

       insert(news,s,k);

   end;

end;

 

procedure StrReplaceLast(var S:string;OldS,NewS:string);

var k,l:integer;

begin

   l:=length(S)-length(OldS)+1;

   for k:=l downto 1 do

       if (S[k]=OldS[1]) then

           if copy(S,k,length(OldS))=OldS then break;

   if k>0 then begin

       delete(s,k,length(olds));

       insert(news,s,k);

   end;

end;

 

//-----------------------------------EVALUATE-----------------------------------

 

function Evaluate(Expression: string):float;

begin

   if(VarEval=nil)then VarEval:=TExpress.create;

   VarEval.Expression:=lowercase(Expression);

   Result:=VarEval.TheFunction(0,0,0);

end;

 

function Evaluate(Expression: string; Var1: char; Val1: float):float;

begin

   if(VarEval=nil)then VarEval:=TExpress.create;

   VarEval.VariableList:=lowercase(var1);

   VarEval.Expression:=lowercase(Expression);

   Result:=VarEval.TheFunction(Val1,0,0);

end;

 

function Evaluate(Expression: string; var1, var2: char; Val1,Val2:float):float;

begin

   if(VarEval=nil)then VarEval:=TExpress.create;

   VarEval.VariableList:=lowercase(var1+var2);

   VarEval.Expression:=lowercase(Expression);

   Result:=VarEval.TheFunction(val1,val2,0);

end;

 

function Evaluate(Expression: string; var1, var2, var3: char;val1, val2, val3: float):float;

begin

   if(VarEval=nil)then VarEval:=TExpress.create;

   VarEval.VariableList:=lowercase(var1+var2+var3);

   VarEval.Expression:=lowercase(Expression);

   Result:=VarEval.TheFunction(val1,val2,val3);

end;

 

procedure Evaluate(Expression: string; Var1: char;

Count: integer; Val1: array of float; var Result: array of float);

var i:integer;

begin

   if(VarEval=nil)then VarEval:=TExpress.create;

   VarEval.VariableList := lowercase(Var1);

   VarEval.Expression := lowercase(Expression);

   for i:=0 to Count-1 do

       Result[i]:=VarEval.TheFunction(val1[i],0,0);

end;

 

procedure Evaluate(Expression: string; var1, var2: char;

Count: integer; val1, val2: array of float; var Result: array of float);

var i:integer;

begin

   if(VarEval=nil)then VarEval:=TExpress.create;

   VarEval.VariableList:=lowercase(var1+var2);

   VarEval.Expression:=lowercase(Expression);

   for i:=0 to Count-1 do

       Result[i]:=VarEval.TheFunction(val1[i],val2[i],0);

end;

 

procedure Evaluate(Expression: string; var1, var2, var3: char;

Count: integer; val1, val2, val3: array of float;

var Result: array of float);

var i:integer;

begin

   if(VarEval=nil)then VarEval:=TExpress.create;

   VarEval.VariableList:=lowercase(var1+var2+var3);

   VarEval.Expression:=lowercase(Expression);

   for i:=0 to Count-1 do

       Result[i]:=VarEval.TheFunction(val1[i],val2[i],val3[i]);

end;

 

//-----------------------------------OTHER-----------------------------------

 

procedure InterpolateColor(Color0, Color1:TColor; Count:integer;var TempColor: array of TColor);

var

   R0,G0,B0,R1,G1,B1:byte;

   R,G,B:real;

   i:integer;

begin

   R0:=Color0 and $FF;

   G0:=(Color0 and $FF00)shr 8;

   B0:=(Color0 and $FF0000)shr 16;

   R1:=Color1 and $FF;

   G1:=(Color1 and $FF00)shr 8;

   B1:=(Color1 and $FF0000)shr 16;

   R:=(R1-R0)/(Count-1);G:=(G1-G0)/(Count-1);B:=(B1-B0)/(Count-1);

   for i:=0 to Count-1 do

   begin

       R1:=round(R0+i*R);

       G1:=round(G0+i*G);

       B1:=round(B0+i*B);

       TempColor[i]:=R1+(G1 shl 8)+(B1 shl 16);

   end;

end;

 

procedure ConvertV3ToS(X,Y,Z:float;var r,a,b:float);

begin

   if(X=0)and(Y=0)and(Z=0)then exit;

   R:=Sqrt(X*X+Y*Y+Z*Z);

   if(Y=0)then

       begin

           if(X>0)then a:=pi/2 else a:=-PI/2;

       end

   else

       begin

           a:=Arctan(X/Y);

           if(a*X<0)then a:=a+PI;

       end;

   b:=Arccos(Z/r);

end;

 

procedure ConvertSToV3(R,A,B:float;var X,Y,Z:float);

begin

   Y:=r*Sin(b)*Cos(a);

       X:=r*Sin(b)*Sin(a);

       Z:=r*Cos(b);

end;

 

end.