home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / kolekce / d56 / DM2KVCL.ZIP / COMMON.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-11-05  |  11.2 KB  |  275 lines
  1. {****************************************************************************}
  2. {                            Data Master 2000                                }
  3. {****************************************************************************}
  4. unit Common;
  5. {$B-}
  6. interface
  7. uses SysUtils;
  8. const
  9.   MaxCols=26;         {max. number of values in string (= number of letters!)}
  10.   CRLF=#13#10; LFCR=#10#13; CR=#13; LF=#10;               {string terminators}
  11.  
  12. type
  13.  
  14.   TColIndex=1..MaxCols;                                {trealarray index type}
  15.   TReal=extended;                                             {basic realtype}
  16.   TComplex=record                                         {complex value type}
  17.     X,Y: TReal;
  18.   end;
  19.   TRealPoint=TComplex;
  20.   PRealArray=^TRealArray;                                    {string of TReal}
  21.   TRealArray=array [TColIndex] of TReal;
  22.   TFormat=packed record                                       {numeric format}
  23.     Width, Decimals: byte;
  24.     FType: TFloatFormat;
  25.   end;
  26.   TFormatArray=array [TColIndex] of TFormat;
  27.   PFormatArray=^TFormatArray;
  28.  
  29. {additional string processing}
  30. function Str2Real(S: string; var R: TRealArray): byte;   {string => realarray}
  31. function NumWords(S: string): integer;     {returns number of words in string}
  32. function WordStr(S: string; N: integer): string;     {returns N-th word or ''}
  33. function FindParameter(P: string): boolean;{scan CMD line for given parameter}
  34. {complex numbers support:}
  35. function StrC(Z: TComplex): string;                           {returns s=x+iy}
  36. function ModuleC(Z: TComplex): TReal;                            {returns |Z|}
  37. function ArgC(Z: TComplex): TReal;                            {returns arg(Z)}
  38. function MakeC(X,Y: TReal): TComplex;                           {returns X+iY}
  39. function CreateC(X,Y: TReal): TComplex;                     {returns Xexp(iY)}
  40. function OneC: TComplex;                                       {returns  1+i0}
  41. function AddC(X,Y: TComplex): TComplex;                          {returns X+Y}
  42. function SubC(X,Y: TComplex): TComplex;                          {returns X-Y}
  43. function MulC(X,Y: TComplex): TComplex;                          {returns X*Y}
  44. function DivC(X,Y: TComplex): TComplex;                          {returns X/Y}
  45. function ConjC(X: TComplex): TComplex;                   {returns conjugate X}
  46. function SinC(X: TComplex): TComplex;                         {returns sin(X)}
  47. function CosC(X: TComplex): TComplex;                         {returns cos(X)}
  48. function TanC(X: TComplex): TComplex;                         {returns tan(X)}
  49. function ExpC(X: TComplex): TComplex;                         {returns exp(X)}
  50. function LnC(X: TComplex): TComplex;                           {returns Ln(X)}
  51. function SqrC(X: TComplex): TComplex;                         {returns Sqr(X)}
  52. function SqrtC(X: TComplex): TComplex;                       {returns sqrt(X)}
  53. function ShC(X: TComplex): TComplex;                           {returns sh(X)}
  54. function ChC(X: TComplex): TComplex;                           {returns ch(X)}
  55. function ThC(X: TComplex): TComplex;                           {returns th(X)}
  56. function InvC(X: TComplex): TComplex;                            {returns 1/X}
  57. {special functions}
  58. function LineInterpolate(X1, X2, Y1, Y2, X: TReal): TReal;  {linear interpol.}
  59. function GCompensation(M,Fi,X,Y: TReal): TComplex;              {Gx,Gy->Zx,Zy}
  60. function OSCompensation(ZoX,ZoY,ZsX,ZsY,ZX,ZY: TReal): TComplex;  {open/short}
  61. function VDP(Ra,Rb: TReal): TReal;                     {return VDP formfactor}
  62.  
  63. implementation
  64.  
  65. {additional string processing}
  66. function Str2Real(S: string; var R: TRealArray): byte;    {converts string to}
  67. var Ss: string; I,J: byte; Flag: integer; Rr: TReal;     {TRealArray. returns}
  68. begin                                                          {size of array}
  69.   I:=1; J:=0;        {numbers may be delimited by spaces, tabstops and commas}
  70.   while(I<=length(S)) and (J<MaxCols) do
  71.   begin
  72.     if (S[I]=' ') or (S[I]=#9) or (S[I]=',') then Inc(I)
  73.     else
  74.     begin
  75.       SS:='';
  76.       while (I<=length(S)) and (S[I]<>#9) and (S[I]<>',') and (S[I]<>' ') do
  77.       begin Ss:=Ss+S[I]; Inc(I); end;
  78.       Val(Ss, Rr, Flag); Str2Real:=J; if Flag<>0 then Exit;
  79.       Inc(J); R[J]:=Rr;
  80.     end;
  81.   end;
  82.   Str2Real:=J;
  83. end;
  84.  
  85. function NumWords(S: string): integer;     {returns number of words in string}
  86. var I, J: integer;
  87. begin
  88.   I:=1; J:=0;                                {I-position in string, J-in word}
  89.   while I<=length(S) do
  90.   begin
  91.     case S[I] of      {all chars framed by | symbols treated as single word!!}
  92.     ' ', #9: Inc(I);                                         {omit separators}
  93.     '|' :begin
  94.            Inc(I);
  95.            while (I<=length(S)) and (S[I]<>'|') do Inc(I);
  96.            Inc(J);  Inc(I);
  97.          end;
  98.     else
  99.     begin
  100.       while (I<=length(S)) and (S[I]<>' ') and (S[I]<>#9) do Inc(I);
  101.       Inc(J);
  102.     end
  103.     end;  {case}
  104.   end;
  105.   NumWords:=J;
  106. end;
  107.  
  108. function WordStr(S: string; N: integer): string;     {returns N-th word or ''}
  109. var I, J: integer; Ss: string;
  110. begin
  111.   I:=1; J:=0; SS:='';                        {I-position in string, J-in word}
  112.   while I<=length(S) do
  113.   begin
  114.     SS:='';
  115.     case S[I] of
  116.     ' ', #9: Inc(I);
  117.     '|' : begin
  118.             Inc(I);                           {I to 1-st symbol of wordstring}
  119.             if I>length(S) then Break;                   {if it's last symbol}
  120.             SS:='';
  121.             while (I<=length(S)) and (S[I]<>'|') do
  122.             begin Ss:=Ss+S[I]; Inc(I); end;
  123.             Inc(J); Inc(I); if J=N then Break;
  124.           end;
  125.     else
  126.     begin                                              {in Ss-accumulate word}
  127.       while (I<=length(S)) and (S[I]<>' ') and (S[I]<>#9) do
  128.       begin Ss:=Ss+S[I]; Inc(I); end;
  129.       Inc(J); if J=N then Break;
  130.     end
  131.     end; {case}
  132.   end;
  133.   if J=N then WordStr:=SS else WordStr:='';
  134. end;
  135.  
  136. function FindParameter(P: string): boolean;            {returns true if found}
  137. var I: byte; S: string;
  138. begin
  139.   P:=UpperCase(P); Result:=false;                     {NOTE: case-insensitive}
  140.   for I:=1 to ParamCount do
  141.   begin
  142.     S:=UpperCase(ParamStr(I));
  143.     if ((S[1]='/') or (S[1]='-')) and (Copy(S,2,length(S)-1)=P)
  144.     then begin Result:=true; Exit; end;               {found!!! This all work}
  145.   end;
  146. end;
  147.  
  148. {--- complex: ---}
  149. function  StrC(Z: TComplex): string;                          {returns s=x+iy}
  150. var S, Ss: string;
  151. begin Str(Z.X, S); Str(Z.Y, Ss); StrC:=S+'+i'+Ss; end;
  152.  
  153. function  ModuleC(Z: TComplex): TReal;                           {returns |Z|}
  154. begin ModuleC:=Sqrt(Sqr(Z.X)+Sqr(Z.Y)); end;
  155.  
  156. function  ArgC(Z: TComplex): TReal;                           {returns arg(Z)}
  157. begin
  158.   if Z.X<>0 then ArgC:=Arctan(Z.Y/Z.X) else         {else-value is imaginary!}
  159.   begin
  160.     if Z.Y<0 then ArgC:=-Pi/2;
  161.     if Z.Y>0 then ArgC:=Pi/2; if Z.Y=0 then ArgC:=0;
  162.   end;
  163. end;
  164.  
  165. function MakeC(X,Y: TReal): TComplex;                                {Z:=X+iY}
  166. begin Result.X:=X; Result.Y:=Y; end;
  167.  
  168. function CreateC(X,Y: TReal): TComplex;                          {Z:=Xexp(iY)}
  169. begin Result.X:=X*cos(Y); Result.Y:=X*sin(Y); end;
  170.  
  171. function OneC: TComplex;                                       {returns  1+i0}
  172. begin Result.X:=1; Result.Y:=0; end;
  173.  
  174. function AddC(X,Y: TComplex): TComplex;                               {Z:=X+Y}
  175. begin Result.X:=X.X+Y.X; Result.Y:=X.Y+Y.Y; end;
  176.  
  177. function SubC(X,Y: TComplex): TComplex;                               {Z:=X-Y}
  178. begin Result.X:=X.X-Y.X; Result.Y:=X.Y-Y.Y; end;
  179.  
  180. function MulC(X,Y: TComplex): TComplex;                               {Z:=X*Y}
  181. begin Result.X:=X.X*Y.X-X.Y*Y.Y; Result.Y:=X.X*Y.Y+X.Y*Y.X; end;
  182.  
  183. function DivC(X,Y: TComplex): TComplex;                               {Z:=X/Y}
  184. begin                                                    {Z1/Z2=Z1*_Z2/|Z2|^2}
  185. {Result:=DivC(MulC(X,ConjC(Y)),MakeC(Sqr(Module(Y)),0)); may cause stack ovf!}
  186.   Result.X:=(X.X*Y.X+X.Y*Y.Y)/(sqr(Y.X)+sqr(Y.Y));
  187.   Result.Y:=(Y.X*X.Y-X.X*Y.Y)/(sqr(Y.X)+sqr(Y.Y));
  188. end;
  189.  
  190. function ConjC(X: TComplex): TComplex;                        {Y:=conjugate X}
  191. begin Result.X:=X.X; Result.Y:=-X.Y; end;
  192.  
  193. function SinC(X: TComplex): TComplex;                              {Y:=sin(X)}
  194. begin
  195.   Result.X:=sin(X.X)*(exp(X.Y)+exp(-X.Y))/2;
  196.   Result.Y:=cos(X.X)*(exp(X.Y)-exp(-X.Y))/2;
  197. end;
  198.  
  199. function CosC(X: TComplex): TComplex;                              {Y:=cos(X)}
  200. begin
  201.   Result.X:=cos(X.X)*(exp(X.Y)+exp(-X.Y))/2;
  202.   Result.Y:=sin(X.X)*(exp(-X.Y)-exp(X.Y))/2;
  203. end;
  204.  
  205. function TanC(X: TComplex): TComplex;                              {Y:=tan(X)}
  206. begin Result:=DivC(SinC(X), CosC(X)); end;
  207.  
  208. function ExpC(X: TComplex): TComplex;                              {Y:=exp(X)}
  209. begin Result.X:=exp(X.X)*cos(X.Y); Result.Y:=exp(X.X)*sin(X.Y); end;
  210.  
  211. function LnC(X: TComplex): TComplex;                                {Y:=Ln(X)}
  212. begin Result.X:=ln(Abs(ModuleC(X))); Result.Y:=ArgC(X); end;
  213.  
  214. function SqrC(X: TComplex): TComplex;                              {Y:=Sqr(X)}
  215. begin Result:=MulC(X,X); end;
  216.  
  217. function SqrtC(X: TComplex): TComplex;                            {Y:=sqrt(X)}
  218. begin Result:=CreateC(Sqrt(ModuleC(X)), ArgC(X)/2); end;
  219.  
  220. function ShC(X: TComplex): TComplex;                                {Y:=sh(X)}
  221. begin
  222.   Result:=MulC(MakeC(0,-1),SinC(MulC(X,MakeC(0,1))));       {sh(X)=-i*sin(iX)}
  223. end;
  224.  
  225. function ChC(X: TComplex): TComplex;                                {Y:=ch(X)}
  226. begin Result:=CosC(MulC(X,MakeC(0,1))); end;                   {ch(X)=cos(iX)}
  227.  
  228. function ThC(X: TComplex): TComplex;                                {Y:=th(X)}
  229. begin Result:=DivC(ShC(X),ChC(X)); end;
  230.  
  231. function InvC(X: TComplex): TComplex;                                 {Y:=1/X}
  232. begin Result:=DivC(OneC,X); end;
  233.  
  234. {from PROCESS.PAS:}
  235. {Interpolation, VDP and cable compensation routines: Gamma and Open/Short}
  236. function LineInterpolate(X1, X2, Y1, Y2, X: TReal): TReal;
  237. begin                 {linear interpolation: Y:=Yk+(X-Xk)/(Xk+1-Xk)*(Yk+1-Yk)}
  238.   if X1=X2 then LineInterpolate:=Y1+Y2/2         {NOTE! process zero interval}
  239.   else LineInterpolate:=Y1+(X-X1)/(X2-X1)*(Y2-Y1);
  240. end;
  241.  
  242. function VDP(Ra,Rb: TReal): TReal;                     {return VDP formfactor}
  243.   procedure Proc(r, y0: TReal; var d, f1:TReal);
  244.   var v, rv, a: TReal;
  245.   begin
  246.     rv:=r*y0; v:=y0; v:=exp(v); rv:=exp(rv); a:=rv+1/rv-v;
  247.     d:=r*(rv-1/rv)-v; f1:=a;
  248.   end;
  249. var r, y0, y1, d, f0, f1: TReal;
  250. begin
  251.   if ((Ra=0) or (Rb=0)) then begin Result:=1; Exit; end;  {superconducor: f=1}
  252.   r:=(Ra-Rb)/(Ra+Rb); if r<0 then r:=-r; {<-- no need do ABS!!!} y0:=1;
  253.   Proc(r, y0, d, f0);
  254.   repeat
  255.     y1:=y0-f0/d; Proc(r, y1, d, f1); y0:=y1; f0:=f1;
  256.   until (abs(f1)<1.e-6);
  257.   Result:=y1;
  258. end;
  259.  
  260. function GCompensation(M,Fi,X,Y: TReal): TComplex;              {Gx,Gy->Zx,Zy}
  261. var G,Z: TComplex;                                            {Gtrue=G*Gcable}
  262. begin                                                       {Z/Zi=(1+G)/(1-G)}
  263.   G:=MulC(CreateC(M,Fi),MakeC(X,Y)); Z:=DivC(AddC(OneC, G), SubC(OneC, G));
  264.   Z.X:=50*Z.X; Z.Y:=50*Z.Y; Result:=Z;
  265. end;
  266.  
  267. function OSCompensation(ZoX,ZoY,ZsX,ZsY,ZX,ZY: TReal): TComplex;
  268. begin                               {O/S comp. routine: Ztrue=(Zs-Z)/(Z/Zo-1)}
  269.   Result:=DivC(SubC(MakeC(ZsX, ZsY), MakeC(ZX, ZY)),
  270.                SubC(DivC(MakeC(ZX, ZY),MakeC(ZoX, ZoY)), OneC));
  271. end;
  272.  
  273. end.
  274.  
  275.