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

Материал из DRKB



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