PDA

Просмотр полной версии : перевод из 16-ой в 2-ую системы исчеления


Тарифы: МТС, Билайн, МегаФон
Выгодные непубличные тарифы МТС, Билайн, МегаФон, Безлимитный интернет ✅
falloff
15-06-2010, 10:32
Собственно надо прогу на delphi, вроде ничего сложного но язык совсем не помню((

chuk7
15-06-2010, 12:52
скачай книгу по дельфи да напиши

Kolos
15-06-2010, 12:59
а че там помнить то? одна функция HexToBin

rulezzz
15-06-2010, 13:03
Text:='0ff'#0;
HexToBin(Text,Buffer,16)

rulezzz
15-06-2010, 13:05
для паскаля

uses
crt;
var
cs1,cs2,res,change:integer;
TD:string;
{функция перевода Dec числа в любую сс}
function FromDec(n,r:longint):string;
var
s:String;
const
digit:string[16]='0123456789ABCDEF';
begin
s:='';
repeat
s:=digit[(n mod r)+1]+s;
n:=n div r;
until n=0;
FromDec:=s;
end;
{фунция перевода любой сс в Dec}
function ToDec(n:string;r:longint):longint;
var
m,i:longint;
const
digit:string[16]='0123456789ABCDEF';
begin
m:=0;
while n[1]='0' do
delete(n,1,1);
for i:=1 to length(n) do
m:=m*r+pos(n[i],digit)-1;
ToDec:=m;
end;
{осоновная программы}
begin
writeln('Введите из какой CC:');
repeat
readln(cs1);
until
(cs1>=2) and (cs1<=36);
writeln('Введите число в соответствии с CC:');
readln(TD);
writeln('Введите в какую CC:');
repeat
readln(cs2);
until
(cs2>=2) and (cs2<=36);
writeln('Перевод из ',cs1,' CC --> ',cs2,' CC:');
writeln(FromDec(ToDec(TD,cs1),cs2));
end.

rulezzz
15-06-2010, 13:08
дельфи

unit BaseConvertUnit;

interface
function BaseConvert(NumIn: string; BaseIn: byte; BaseOut: byte): string;

const
Convert_Error = 'Error';

implementation

uses
SysUtils, Math;

function BaseConvert(NumIn: string; BaseIn, BaseOut: Byte): string;

function TruncStr(S: string): string;
var
P: Integer;
begin
Result := S;
P := Pos(DecimalSeparator, S);
if P = 0 then Exit;
SetLength(Result, P-1);
end;

function FracStr(S: string): string;
var
P: Integer;
begin
Result := '';
P := Pos(DecimalSeparator, S);
if P = 0 then Exit;
Result := Copy(S, P+1, Length(S)-P);
end;

function InDec(NumIn: string; BaseIn: Byte): string;
var
IntPart, FracPart: string;
CurrentChar: Char;
TruncResult, FracResult: Double;
PlaceVal: Integer;
CharVal: Integer;
I: Integer;
begin
Result := Convert_Error;
if (NumIn = '') or (BaseIn < 2) or (BaseIn > 36) then
Exit;

// обработаем целую часть числа
IntPart := TruncStr(NumIn);
TruncResult := 0;
PlaceVal := Length(IntPart);
for I := 1 to Length(IntPart) do
begin
Dec(PlaceVal);
CurrentChar := IntPart[I];
case Ord(CurrentChar) of
65..90: CharVal := Ord(CurrentChar) - 55; // буква
48..57: CharVal := Ord(CurrentChar) - 48; // цифра
else
Exit;
end;
if (CharVal < 0) or (CharVal > BaseIn - 1) then
Exit;
TruncResult := TruncResult + CharVal * (Power(BaseIn, PlaceVal));
end;

// теперь обработаем дробную часть числа
FracPart := FracStr(NumIn);
FracResult := 0;
PlaceVal := 0;
for I := 1 to Length(FracPart) do
begin
Dec(PlaceVal);
CurrentChar := FracPart[I];
case Ord(CurrentChar) of
65..90: CharVal := Ord(CurrentChar) - 55;
48..57: CharVal := Ord(CurrentChar) - 48;
else
Exit;
end;
if (CharVal < 0) or (CharVal > BaseIn - 1) then
Exit;
FracResult := FracResult + CharVal * (Power(BaseIn, PlaceVal));
end;
// результат
Result := FloatToStr(TruncResult + FracResult);
end;

function FromDec(NumIn: Double; BaseOut: Byte): string;
var
TruncResult, FracResult: string;
TruncNumIn, FracNumIn: Double;
Remainder: Double;
CurrentChar: Char;
CurrentVal: Integer;
S: string;
begin
if (BaseOut < 2) or (BaseOut > 36) then
begin
Result := Convert_Error;
Exit;
end;
if NumIn = 0 then
begin
Result := '0';
Exit;
end;

// обработать целую часть числа
TruncResult := '';
TruncNumIn := Trunc(NumIn);
while TruncNumIn > 0 do
begin
Remainder := TruncNumIn - (Int(TruncNumIn / BaseOut) * BaseOut);
TruncNumIn := (TruncNumIn - Remainder) / BaseOut;
if Remainder >= 10 then
CurrentChar := Chr(Trunc(Remainder + 55))
else
begin
S := IntToStr(Trunc(Remainder));
CurrentChar := S[Length(S)];
end;
TruncResult := CurrentChar + TruncResult;
end;
if TruncResult = '' then TruncResult := '0';

// обработать дробную часть числа
FracNumIn := Frac(NumIn);
FracResult := '0' + DecimalSeparator;
while (FracNumIn > 0) and (Length(FracResult)-2 < 18) do // макс. точность - 18 знаков
// while (NumIn > 0) do
begin
FracNumIn := FracNumIn * BaseOut;
CurrentVal := Trunc(FracNumIn);
if CurrentVal >= 10 then
CurrentChar := Chr(CurrentVal + 55)
else begin
S := IntToStr(CurrentVal);
CurrentChar := S[Length(S)];
end;
FracResult := FracResult + CurrentChar;
FracNumIn := Frac(FracNumIn);
end;
FracResult := FracStr(FracResult);

// результат
if FracResult <> '' then
Result := TruncResult + DecimalSeparator + FracResult
else
Result := TruncResult;
end;

var
Dec: string;
Negative: boolean;
begin
// парочка проверок
if BaseIn = BaseOut then
begin
Result := NumIn;
Exit;
end;
if NumIn = '' then
begin
Result := Convert_Error;
Exit;
end;

// обработать отрицательное число
if NumIn[1] = '-' then
begin
Negative := True;
Delete(NumIn, 1, 1);
end else
Negative := False;

// собственно конвертирование
Dec := InDec(NumIn, BaseIn);
if Dec = Convert_Error then
begin
Result := Convert_Error;
Exit;
end;
if Negative then
Result := '-' + FromDec(StrToFloat(Dec), BaseOut)
else
Result := FromDec(StrToFloat(Dec), BaseOut);
end;


end.

Hursh
15-06-2010, 14:00
я бы поюзал свойство кратности этих систем счисления и сделал так

P.S.
  • можно еще добавить в конце функции удаление первых незначащих нулей (while с функцией delete)
  • можно еще добавить детектинг неверных входных данных (else в конструкции case)

falloff
15-06-2010, 16:28
всем спасибо все работает на ура!