home bbs files messages ]

Forums before death by AOL, social media and spammers... "We can't have nice things"

   comp.lang.pascal.borland      Borland Pascal was actually pretty neat      2,978 messages   

[   << oldest   |   < older   |   list   |   newer >   |   newest >>   ]

   Message 1,417 of 2,978   
   Heinrich Wolf to Heinrich Wolf   
   Re: Numbers of Different Base   
   22 Feb 05 07:13:55   
   
   From: invalid@invalid.invalid   
      
   "Heinrich Wolf"  schrieb im Newsbeitrag   
   news:37s9vvF5ia8b6U1@individual.net...   
   > program Bases;   
   >   
   > uses   
   >  WinCRT;   
   >   
   > var Number    : LongInt;   
   >    ErrorPos,   
   >    Base      : Integer;   
   >    s         : String;   
   >   
   > function strtol(s : String; var ErrorPos : Integer; Base : Integer) :   
   > LongInt;   
   >  var    l : LongInt;   
   >         c : char;   
   >  begin   
   >    l := 0;   
   >    ErrorPos := 0;   
      
   { for empty s here was missing }   
         c := #0;   
      
   >    while s > '' do   
   >      begin   
   >        inc(ErrorPos);   
   >        c := upcase(s[1]);   
   >        s := Copy(s, 2, length(s));   
   >        if ('0' <= c) and (c <= '9') and (c < chr(Base + ord('0'))) then   
   >          begin   
   >            l := l * Base + ord(c) - ord('0');   
   >            c := #0;   
   >          end   
   >        else   
   >          if ('A' <= c) and (c < chr(Base - 10 + ord('A'))) then   
   >            begin   
   >              l := l * Base + ord(c) - ord('A') + 10;   
   >              c := #0;   
   >            end   
   >          else   
   >            s := '';   
   >      end;   
   >    if c = #0 then   
   >      begin   
   >        strtol   := l;   
   >        ErrorPos := 0;   
   >      end   
   >    else   
   >      strtol := 0;   
   >  end;   
   >   
   > function ltoa(Number : LongInt; Base : Integer) : String;   
   >  var    s     : String;   
   >         Digit : Integer;   
   >  begin   
   >    s := '';   
      
   { for handling the sign bit on 32 Bit Numbers you can add: }   
       if Number < 0 then   
         begin   
           {   
           positive Number = $100000000 + Number.   
           $100000000 = $80000000 + $40000000 + $40000000.   
           Number and $7FFFFFFF = Number + $80000000 avoiding overflow.   
           }   
           Number := Number and $7FFFFFFF;   
           Digit  := Number mod Base;   
           Number := Number div Base;   
           Number := Number + ($40000000 + Digit) div Base;   
           Digit  := ($40000000 + Digit) mod Base;   
           Number := Number + ($40000000 + Digit) div Base;   
           Digit  := ($40000000 + Digit) mod Base;   
           if Digit < 10 then   
             s := chr(Digit + ord('0')) + s   
           else   
             s := chr(Digit - 10 + ord('a')) + s;   
         end;   
      
   >    while Number <> 0 do   
   >      begin   
   >        Digit  := Number mod Base;   
   >        Number := Number div Base;   
   >        if Digit < 10 then   
   >          s := chr(Digit + ord('0')) + s   
   >        else   
   >          s := chr(Digit - 10 + ord('a')) + s;   
   >      end;   
   >    ltoa := s;   
   >  end;   
   >   
   > begin   
   >  repeat   
   >    write('Number? ');   
   >    Readln(s);   
   >    write('Base? ');   
   >    Readln(Base);   
   >    if Base >= 2 then   
   >      begin   
   >        writeln(s, ' Base ', Base, ' is ', strtol(s, ErrorPos, Base),   
   >                    ' Base 10');   
   >        writeln('ErrorPos is ', ErrorPos);   
   >      end;   
   >  until Base < 2;   
   >  repeat   
   >    write('Number Base 10? ');   
   >    Readln(Number);   
   >    write('Base? ');   
   >    readln(Base);   
   >    if Base >= 2 then   
   >      writeln(Number, ' Base 10 is ', ltoa(Number, Base), ' Base ', Base);   
   >  until Base < 2;   
   > end.   
      
   --- SoupGate-Win32 v1.05   
    * Origin: you cannot sedate... all the things you hate (1:229/2)   

[   << oldest   |   < older   |   list   |   newer >   |   newest >>   ]


(c) 1994,  bbs@darkrealms.ca