home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1995 November / PCWK1195.iso / inne / podstawy / dos / format / fdform18.exe / BASECONV.PAS < prev    next >
Pascal/Delphi Source File  |  1991-07-21  |  2KB  |  98 lines
  1. {BASE Convert Unit for Turbo-Pascal 5.5}
  2. {Copyright (c) 1989 Christoph H. Hochstätter}
  3.  
  4.  
  5. {$A+,B-,D+,F-,I-,L+,R-,S-,V-}
  6. UNIT baseconv;
  7.  
  8. INTERFACE
  9.  
  10. TYPE basestr = String[32];
  11.  
  12. VAR BaseError: Byte;
  13.  
  14. FUNCTION base(x:LongInt;b:Byte):basestr;                                                {Convert x to base b}
  15. FUNCTION basef(x:LongInt;b,f:Byte):basestr;                                    {Convert x to base b length f}
  16. FUNCTION hex(x:LongInt):basestr;                                                       {Convert x to base 16}
  17. FUNCTION hexf(x:LongInt;f:Byte):basestr;                                      {Convert x to base 16 length f}
  18. FUNCTION dez(x:basestr;s:Byte):LongInt;                                    {Convert x from Base s to decimal}
  19. FUNCTION dezh(x:basestr):LongInt;                                          {Convert hexadecimal x to decimal}
  20.  
  21. IMPLEMENTATION
  22.  
  23. VAR   o: basestr;
  24. CONST h: String[36] = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  25. VAR   i: Byte;
  26. CONST n: String[31] = '0000000000000000000000000000000';
  27.  
  28.   FUNCTION base;
  29.  
  30.     PROCEDURE base1(x: LongInt);
  31.     BEGIN
  32.       IF x>Pred(b) THEN base1(x DIV b);
  33.       o:=o+h[Succ(x MOD b)];
  34.     END;
  35.  
  36.   BEGIN                                                                                                {base}
  37.     IF b>36 THEN BEGIN
  38.       BaseError:=1;
  39.       Exit;
  40.     END ELSE
  41.       BaseError:=0;
  42.     IF x<0 THEN
  43.       o:='-'
  44.     ELSE
  45.       o[0]:=Chr(0);
  46.     base1(Abs(x));
  47.     base:=o;
  48.   END;
  49.  
  50.   FUNCTION hex;
  51.   BEGIN
  52.     hex:=base(x,16);
  53.   END;
  54.  
  55.  
  56.   FUNCTION basef;
  57.   BEGIN
  58.     o:=base(x,b);
  59.     IF BaseError <> 0 THEN Exit;
  60.     IF Ord(o[0])>f THEN
  61.       BaseError:=2
  62.     ELSE BEGIN
  63.       n[0]:=Chr(f-Ord(o[0]));
  64.       IF x<0 THEN i:=2 ELSE i:=1;
  65.       Insert(n,o,i);
  66.     END;
  67.     basef:=o;
  68.   END;
  69.  
  70.   FUNCTION hexf;
  71.   BEGIN
  72.     hexf:=basef(x,16,f);
  73.   END;
  74.  
  75.   FUNCTION dez;
  76.   VAR a: Byte;
  77.     b,c: LongInt;
  78.   BEGIN
  79.     BaseError:=0;
  80.     c:=1;
  81.     b:=0;
  82.     FOR i:=Length(x) DOWNTO 1 DO
  83.       IF BaseError=0 THEN BEGIN
  84.         a:=Pred(pos(Upcase(x[i]),h));
  85.         IF (a=255) OR (a>=s) THEN BaseError:=1;
  86.         b:=b+c*a;
  87.         c:=s*c;
  88.       END;
  89.     dez:=b;
  90.   END;
  91.  
  92.   FUNCTION dezh;
  93.   BEGIN
  94.     dezh:=dez(x,16);
  95.   END;
  96.  
  97. END.
  98.