PDA

Просмотр полной версии : Алгоритма перевода чисел: не могу найти ошибку



Drawn
17.11.2004, 00:28
Помогите пожалуйста исправить ошибки в данном алгоритме



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.

drmist
17.11.2004, 16:09
трудно сказать -))
а точнее - лень.
ошибок дохрена, и тот, кто писал этот код, не знает или знает очень плохо, ниже школьного уровня, Дельфи.
советую купить книжку по Дельфи и почитать ее, хотя бы 2 месяца. после этого, вероятно, вопрос пропадет.

AndreykA
18.11.2004, 14:59
да......
даже читать весь код не стал - не вижу смысла
это все равно что просто постучать в слепую по клавиатуре и сказать потом - народ, исправьте мне все ошибки...
поддерживаю drmist и не только советую, но и очень рекомендую: купи лит-ру по делфе и как говорил дедушка Ленин - учиться, учиться и еще раз учиться

Naeel Maqsudov
01.12.2004, 01:44
Drawn, два замечания:
1) корректно указывайте тему сообщения (тему я скорректировал)
2) для оформления текста используйте тег [ code]...[/ code], возможно Ваш вопрос имел бы больший успех....

PS
Алгоритм посмотрю после того как наведу порядок в этом форуме, нарушенный в течение моего отсутствия :)

Naeel Maqsudov
03.12.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;