Код: Выделить всё
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
function stoi(s:string):byte;
var
alpha:string;
begin
alpha:='0123456789ABCDEF'
stoi:=pos(s,alpha)-1;
end;
function itos(s:byte):string;
var
alpha:string;
begin
alpha:='0123456789ABCDEF'
itos:=alpha[s+1];
end;
function to10(s:string;b:byte):string;
var
r,i:shortint;
all:extended;
begin
r:=pos('.',s)-2;
all:=0;
for i:=1 to length(s) do
if s[i]<>'.' then
begin
all:=all+stoi(s[i])*exp(r*ln(b));
r:=r-1;
end;
str(all:20:8,s);
while pos(' ',s)>0 do delete(s,pos(' ',s),1);
to10:=s;
end;
function toN(s:string;b:byte):string;
var
k:boolean;
i,r:byte;
c,d:string;
lc:longint;
begin
k:=true;
c:='';
d:='';
for i:=1 to length(s) do
if s[i]='.' then
k:=false
else if k then c:=c+s[i]
else if length(d)<7 then d:=d+s[i];
for i:=lenght(s);
lc:=0;
for i:=1 to length(c) do
lc:=lc+stoi(c[i])*round(exp((length(c)-i)*ln(10)));
c:='';
while lc>0 do begin
c:=c+itos(lc mod b);
lc:=lc div b;
end;
s:='';
for i:=length(c) downto 1 do s:=s+c[i];
s:=s+'.';
r:=length(d);
lc:=0;
for i:=1 to length(d) do
lc:=lc+stoi(d[i])*round(exp((length(d)-i)*ln(10)));
d:='';
for i:=1 to 8 do begin
lc:=lc*b;
d:=d+itos(lc div round(exp(r*ln(10))));
lc:=lc mod round(exp(r*ln(10)));
end;
s:=s+d;
if s[length(s)]='.' then s:=s+'0';
if lc<>0 then s:=s+'...';
toN:=s;
end;
var
s:string;
alpha:string;
b:byte;
code:integer;
go:integer;
i:integer;
begin
BEGIN
b:=StrToInt(Edit1.Text);
if (b<=16) and (b>=2) then
WRITE('Input Numer ->') else Halt;
s:=Edit2.Text;
for i:=1 to length(s) do
begin
val(s[i],go,code);
if (go>=b) then Halt;
end;
s:=to10(s,b);
WRITE('Input want base ->');
b:=StrToInt(Edit3.Text);
s:=toN(s,b);
WRITELN('Wanted Value is ->',s);
end;
end;
end.