home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ECO30603.ZIP / ECO30603.LZH / ECOLIBII / ECO_BCNV.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-06-08  |  3.5 KB  |  119 lines
  1. {
  2.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  3.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  4.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  5.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  6.     ▓▓▓▓▓▓▓▓·──                                              ──·▓▓▓▓▓▓▓▓▓▓▓
  7.     ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
  8.     ▓▓▓▓▓▓▓▓   Unit was conceived, designed and written         ░░▓▓▓▓▓▓▓▓▓
  9.     ▓▓▓▓▓▓▓▓   by Floor A.C. Naaijkens for                      ░░▓▓▓▓▓▓▓▓▓
  10.     ▓▓▓▓▓▓▓▓   UltiHouse Software / The ECO Group.              ░░▓▓▓▓▓▓▓▓▓
  11.     ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
  12.     ▓▓▓▓▓▓▓▓   (C) MCMXCII by EUROCON PANATIONAL CORPORATION.   ░░▓▓▓▓▓▓▓▓▓
  13.     ▓▓▓▓▓▓▓▓   All Rights Reserved for The ECO Group.           ░░▓▓▓▓▓▓▓▓▓
  14.     ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
  15.     ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
  16.     ▓▓▓▓▓▓▓▓·──                                              ──·░░▓▓▓▓▓▓▓▓▓
  17.     ▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓
  18.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  19.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  20.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  21. }
  22. {base convert unit for turbo-pascal 5.5}
  23. {copyright (c) 1989 christoph h. hochstätter}
  24.  
  25.  
  26. {$A+,B-,D+,F-,I-,L+,R-,S-,V-}
  27. unit eco_bcnv;
  28.  
  29. interface
  30.  
  31. type basestr = string[32];
  32.  
  33. var baseerror: byte;
  34.  
  35. function base(x:longint;b:byte):basestr;                  {convert x to base b}
  36. function basef(x:longint;b,f:byte):basestr;      {convert x to base b length f}
  37. function hex(x:longint):basestr;                         {convert x to base 16}
  38. function hexf(x:longint;f:byte):basestr;        {convert x to base 16 length f}
  39. function dez(x:basestr;s:byte):longint;      {convert x from base s to decimal}
  40. function dezh(x:basestr):longint;            {convert hexadecimal x to decimal}
  41.  
  42. implementation
  43.  
  44. var   o: basestr;
  45. const h: string[36] = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  46. var   i: byte;
  47. const n: string[31] = '0000000000000000000000000000000';
  48.  
  49.   function base;
  50.  
  51.     procedure base1(x: longint);
  52.     begin
  53.       if x>pred(b) then base1(x div b);
  54.       o:=o+h[succ(x mod b)];
  55.     end;
  56.  
  57.   begin                                                                                                {base}
  58.     if b>36 then begin
  59.       baseerror:=1;
  60.       exit;
  61.     end else
  62.       baseerror:=0;
  63.     if x<0 then
  64.       o:='-'
  65.     else
  66.       o[0]:=chr(0);
  67.     base1(abs(x));
  68.     base:=o;
  69.   end;
  70.  
  71.   function hex;
  72.   begin
  73.     hex:=base(x,16);
  74.   end;
  75.  
  76.  
  77.   function basef;
  78.   begin
  79.     o:=base(x,b);
  80.     if baseerror <> 0 then exit;
  81.     if ord(o[0])>f then
  82.       baseerror:=2
  83.     else begin
  84.       n[0]:=chr(f-ord(o[0]));
  85.       if x<0 then i:=2 else i:=1;
  86.       insert(n,o,i);
  87.     end;
  88.     basef:=o;
  89.   end;
  90.  
  91.   function hexf;
  92.   begin
  93.     hexf:=basef(x,16,f);
  94.   end;
  95.  
  96.   function dez;
  97.   var a: byte;
  98.     b,c: longint;
  99.   begin
  100.     baseerror:=0;
  101.     c:=1;
  102.     b:=0;
  103.     for i:=length(x) downto 1 do
  104.       if baseerror=0 then begin
  105.         a:=pred(pos(upcase(x[i]),h));
  106.         if (a=255) or (a>=s) then baseerror:=1;
  107.         b:=b+c*a;
  108.         c:=s*c;
  109.       end;
  110.     dez:=b;
  111.   end;
  112.  
  113.   function dezh;
  114.   begin
  115.     dezh:=dez(x,16);
  116.   end;
  117.  
  118. end.
  119.