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

Drawn · 17 ноя 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 ноя 2004, 16:09

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

AndreykA · 18 ноя 2004, 14:59

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

Naeel Maqsudov · 01 дек 2004, 01:44

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

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

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;

Developing.ru

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

Вход • Регистрация