Naeel Maqsudov » 03 дек 2004, 03:53
В алгоритме, вобщем ошибок-то нет.
Очень много синтаксических ошибок... да еще виден результат неправильной переделки кода с Pascal на Delphi...
Я функцию to10 переделал так, чтобы там не использовались LOG и EXP. Сделайте то же с функцией toN.
Код: Выделить всё
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
r1,r2,i:integer;
all:extended;
begin
r1:=b;r2:=1;
all:=0;
for i:=1 to length(s) do
if s[i]<>'.' then
begin
all:=all*r1+stoi(s[i])/r2;
if r2<>1 then r2:=r2*b;
end
else begin
r2:=b; r1:=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];
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;
b:byte;
code:integer;
go:integer;
i:integer;
begin
b:=StrToInt(Edit1.Text);
if (b<=16) and (b>=2) then
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);
b:=StrToInt(Edit3.Text);
s:=toN(s,b);
label1.Caption:=s;
end;
В алгоритме, вобщем ошибок-то нет.
Очень много синтаксических ошибок... да еще виден результат неправильной переделки кода с Pascal на Delphi...
Я функцию to10 переделал так, чтобы там не использовались LOG и EXP. Сделайте то же с функцией toN.
[code]
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
r1,r2,i:integer;
all:extended;
begin
r1:=b;r2:=1;
all:=0;
for i:=1 to length(s) do
if s[i]<>'.' then
begin
all:=all*r1+stoi(s[i])/r2;
if r2<>1 then r2:=r2*b;
end
else begin
r2:=b; r1:=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];
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;
b:byte;
code:integer;
go:integer;
i:integer;
begin
b:=StrToInt(Edit1.Text);
if (b<=16) and (b>=2) then
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);
b:=StrToInt(Edit3.Text);
s:=toN(s,b);
label1.Caption:=s;
end;
[/code]