[Tronix]

Ну конечно не оптимальны, но зато принцип понятен. Понятен принцип - не проблема соптимизить.
А вот я в школе так забавлялся над системами счислений:

Function Dec2Bin(N: Word): String;
Var
   b : Byte;
   S : String;
   T : Byte;
Begin
     S := '';
     T := 0;
     For b := 15 downto 0 do
         Begin
              If N and (1 shl b) = 0 then S := S+'0' else S := S+'1';
              Inc(T);
              If (T Mod 4 = 0) and (t < 14) then S := S+'.';
         End;
     Dec2Bin := S;
End;

Function Dec2Hex(N: Word): String;
Const
     HD : Array [0..15] of Char = ('0','1','2','3','4','5','6','7',
                                   '8','9','A','B','C','D','E','F');
Begin
     Dec2Hex := (HD[Hi(N) shr 4]+HD[Hi(N) and $F])+
                (HD[Lo(N) shr 4]+HD[Lo(N) and $F])+'h';
End;

Function Dec2Oct(N: Word): String;
Var
   Mas : String;
   B,BB: Word;
   I   : Byte;
   C   : Char;
Begin
     I := 1;
     B := N;
     Repeat
           BB := B div 8;
           Mas[i] := Chr((B - (8 * BB))+48);
           B := BB;
           Inc(I);
     Until B < 8;
     Mas[i] := Chr(B+48);
     Mas[0] := Chr(I);
     For I := 1 to Ord(Mas[0]) shr 1 do
         Begin
              C := Mas[i];
              Mas[i] := Mas[Length(Mas)-I+1];
              Mas[Length(Mas)-I+1] := C;
         End;
     Dec2Oct := Mas;
End;

Function BinAndOct2Dec(N: String; Os: Byte): String;
Function Stepen(B,D: Byte): Word;
Var
   P : Word;
   II : Byte;
Begin
     P := 1;
     If D <> 0 then For II := 1 to D do P := P*B else P := 1;
     Stepen := P;
End;

Var
   S    : Word;
   I    : Byte;
   T    : String;
Begin
     S := 0;
     For I := 1 to Length(N) do
         Begin
              S := S+((Ord(N[i])-48)*Stepen(Os,Length(N)-I));
         End;
     Str(S,T);
     BinAndOct2Dec := T;
End;

Function Hex2Dec(N : String): String;
Const
  HexDigit   : Array [0..15] of Char = '0123456789ABCDEF';
  BinNibbles : Array [0..15] of String[4] = (
    '0000', '0001', '0010', '0011',
    '0100', '0101', '0110', '0111',
    '1000', '1001', '1010', '1011',
    '1100', '1101', '1110', '1111');

Var
   I,J  : Byte;
   S    : String;
Begin
     S := '';
     For I := 1 to Length(N) do
         Begin
              For J := 0 to 15 do If UpCase(N[i]) = HexDigit[J] then
                  S := S+BinNibbles[J];
         End;
     Hex2Dec := BinAndOct2Dec(S,2);
End;