Как представить число в другой системе счисления?

function BaseConvert(NumIn: string; BaseIn: Byte; BaseOut: Byte): string;
var
 i: Integer;
 currentCharacter: Char;
 CharacterValue: Integer;
 PlaceValue: Integer;
 RunningTotal: Double;
 Remainder: Double;
 BaseOutDouble: Double;
 NumInCaps: string;
 s: string;
begin
 if (NumIn = ) or (BaseIn < 2) or (BaseIn > 36) or (BaseOut < 1) or (BaseOut > 36) then
 begin
 Result := 'Error';
 Exit;
 end;
 NumInCaps := UpperCase(NumIn);
 PlaceValue := Length(NumInCaps);
 RunningTotal := 0;
 for i := 1 to Length(NumInCaps) do
 begin
 PlaceValue := PlaceValue - 1;
 CurrentCharacter := NumInCaps[i];
 CharacterValue := 0;
 if (Ord(CurrentCharacter) > 64) and (Ord(CurrentCharacter) < 91) then
 CharacterValue := Ord(CurrentCharacter) - 55;
 if CharacterValue = 0 then
 if (Ord(CurrentCharacter) < 48) or (Ord(CurrentCharacter) > 57) then
 begin
 BaseConvert := 'Error';
 Exit;
 end
 else
 CharacterValue := Ord(CurrentCharacter);
 if (CharacterValue < 0) or (CharacterValue > BaseIn - 1) then
 begin
 BaseConvert := 'Error';
 Exit;
 end;
 RunningTotal := RunningTotal + CharacterValue * (Power(BaseIn, PlaceValue));
 end;
 while RunningTotal > 0 do
 begin
 BaseOutDouble := BaseOut;
 Remainder := RunningTotal - (int(RunningTotal / BaseOutDouble) * BaseOutDouble);
 RunningTotal := (RunningTotal - Remainder) / BaseOut;
 if Remainder >= 10 then
 CurrentCharacter := Chr(Trunc(Remainder + 55))
 else
 begin
 s := IntToStr(trunc(remainder));
 CurrentCharacter := s[Length(s)];
 end;
 Result := CurrentCharacter + Result;
 end;
end;
// Example, Beispiel
procedure TForm1.Button1Click(Sender: TObject);
begin
 BaseConvert('FFFF', 16, 10);
 // returns, ergibt '65535'.
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 04056
----
== Решение от Borland ==
Функция перевода числа из одной системы счисления в другую:
procedure RadixStr(NumStr: PChar;
 Radix: LongInt;
 ResultStr: PChar;
 NewRadix: LongInt;
 var ErrorCode: LongInt);
Функция RadixStr() принимает указатель на строку с завершающим нулем, содержащую число в одной системе счисления, и заполняет буфер строкой с завершающим нулем, содержащей число, преобразованное в другую систему счисления.
Параметры:
* NumStr - Указатель на строку с завершающим нулем, содержащую текстовое представление числа для преобразования;
* Radix - Система счисления числа, содержащегося в параметре NumStr. Должна быть от 2 до 36;
* ResultStr - Указатель на буфер строки с завершающим нулем для размещения результата. Буфер должен быть достаточного размера, чтобы вместить текст результата.
* NewRadix - Система счисления для результата. Должна быть от 2 до 36;
* ErrorCode: При завершении содержит код 0 при успехе, или номер ошибочного символа в NumStr.
Примеры использования функции RadixStr():
{ Convert Hex to Decimal }
RadixStr('FF', 16, lpBuffer, 10, Code); // Вернет строку '255' в lpbuffer^.
{ Convert Decimal to Binary }
RadixStr('255', 10, lpBuffer, 2, Code); // Вернет строку '11111111' в lpbuffer^.
{ Convert Hex to Octal }
RadixStr('FF', 16, lpBuffer, 8, Code); // Вернет строку '377' в lpbuffer^.
Исходный код функции:
{ Function code }
procedure RadixStr(NumStr: PChar; Radix: LongInt; ResultStr: PChar;
 NewRadix: LongInt; var ErrorCode: LongInt);
var
 RadixChar: array[0..35] of Char;
 v: LongInt;
 i: LongInt;
 p: LongInt;
 c: Integer;
begin
 if ((Abs(Radix) < 2) or (Abs(Radix) > 36)) then
 begin
 ErrorCode := p;
 Exit;
 end;
 StrLCopy(ResultStr, NumStr, StrLen(NumStr));
 for i := 0 to 35 do
 begin
 if i <= 9 then
 RadixChar[i] := Char(48 + (i))
 else
 RadixChar[i] := Char(64 + (i - 9))
 end;
 v := 0;
 for i := 0 to (StrLen(ResultStr) - 1) do
 begin
 ResultStr[i] := UpCase(ResultStr[i]);
 p := Pos(ResultStr[i], PChar(@RadixChar)) - 1;
 if ((p < 0) or (p >= Abs(Radix))) then
 begin
 ErrorCode := i;
 Exit;
 end;
 v := v * Abs(Radix) + p;
 end;
 if v = 0 then
 begin
 ResultStr := '0';
 ErrorCode := 0;
 exit;
 end
 else
 begin
 i := 0;
 repeat
 ResultStr[i] := RadixChar[v mod NewRadix];
 v := v div NewRadix;
 Inc(i)
 until v = 0;
 if Radix < 0 then
 begin
 ResultStr[i] := '-';
 ResultStr[i + 1] := #0
 end
 else
 ResultStr[i] := #0;
 p := StrLen(ResultStr);
 for i := 0 to ((p div 2) - 1) do
 begin
 ResultStr[i] := Char(Byte(ResultStr[i]) xor
 Byte(ResultStr[(p - i) - 1]));
 ResultStr[(p - i) - 1] := Char(Byte(ResultStr[(p - i) - 1]) xor
 Byte(ResultStr[i]));
 ResultStr[i] := Char(Byte(ResultStr[i]) xor
 Byte(ResultStr[(p - i) - 1]))
 end;
 ResultStr[p] := #0;
 ErrorCode := 0;
 end;
end;
ID: 04057
Category:Алгоритмы
Category:Математика