home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / JSAGE / ZSUS / PROGPACK / NZ-TOOL4.LBR / RAD.PZS / RAD.PAS
Pascal/Delphi Source File  |  2000-06-30  |  2KB  |  79 lines
  1.  
  2. Program RAD;
  3. {$I nz-tool.box}
  4. {$I paramstr.pas}
  5. {
  6. Added the non-builtin function (in Turbo Pascal Version 2) ParamStr. Lee 
  7. Bradley, Sysop, Z-Node #12, 203 665-1100 5 Sep 90. Compiled with an End 
  8. Address of 3500 hex.
  9. }
  10.  
  11. Function EVAL(RAD:Integer; NUM:str21):Real;
  12. { Evaluate a String variable of a given radix 2..16 to decimal Real.}
  13. Const T = '0123456789ABCDEF';
  14. Var   N : Real;
  15. Begin
  16.   n := 0;
  17.   If (1<rad) And (rad<17) Then
  18.   While Length(num)<>0 Do
  19.     Begin
  20.       n := n * rad + Pos(num[1],t)-1;
  21.       Delete(num,1,1)
  22.     End;
  23.   eval := n;
  24. End;
  25.  
  26. Function CNVRT(R:Integer; V:Real):str21;
  27. { Convert a decimal Real number to a string of radix 2..16 }
  28. Const  D = '0123456789ABCDEF';
  29. Var S : str21;
  30. Begin
  31. s := '0';
  32. If (v>0) And (1<r) And (r<17) Then
  33.   Begin
  34.     s[0] := #0;  { Clear the string }
  35.     Repeat
  36.       v := v / r;
  37.       s := Copy(d,Round(Frac(v)*r+1),1) + s;
  38.       v := v - Frac(v);
  39.     Until v = 0;
  40.   End;
  41. cnvrt := s;
  42. End;
  43.  
  44. Function RAD(S:str21):Integer;
  45. Var r, c : Integer;
  46. Begin
  47.   Case s[1] of
  48.     'B','b'  : r := 2;
  49.     'O','o'  : r := 8;
  50.     'D','d'  : r := 10;
  51.     'H','h'  : r := 16;
  52.   Else
  53.     Val(s,r,c)
  54.   End;
  55. rad := r;
  56. End;
  57.  
  58. Var r1, r2 : Integer;
  59.     value  : Real;
  60.  
  61. Begin
  62. If (ParamStr(1)='') Or (Pos('/',ParamStr(1))<>0) Then Begin
  63.     WriteLn(ParamStr(0),' Number conversion program');
  64.     WriteLn('  Syntax:  ',ParamStr(0),' nnnn [r1] [r2]');
  65.     WriteLn('    where r1 is the input radix, r2 the output');
  66.     WriteLn('    radix, any of 2..16, H, D, O or B')
  67.   End
  68. Else
  69.   Begin
  70.     r1 := 16;
  71.     r2 := 10;
  72.     If Length(ParamStr(3))<>0 Then r2 := rad(ParamStr(3));
  73.     If Length(ParamStr(2))<>0 Then r1 := rad(ParamStr(2));
  74.     value := eval(r1,ParamStr(1));
  75.     Write('Base ',r1,':',r2,'  ',cnvrt(r2,value))
  76.   End
  77. End.
  78.  
  79.