[PhoeniX]

Накидал модуль, для преобразования чисел между системами счисления с основаниями 2 и 10.

Работает хорошо, но очень медленно... Как можно его оптимизировать?
И ещё, если я что-то упустил, поправьте места, где могут возникать ошибки...

Код:

unit uDecBinConvert;

interface

type
  TBit = 0..1;
  TDecimal = 0..9;
  TBitArray = array of TBit;
  TDecArray = array of TDecimal;

function Dec2Bin (dec: string): string;
function Bin2Dec (bin: string): string;

implementation

uses Classes, SysUtils;

procedure StrToBinArr(s: string; var bar: TBitArray);
  function CharToBit (c: char): TBit;
  begin
    if c = '0' then Result:=0 else
    if c = '1' then Result:=1 else
    raise (Exception.Create('Invalid character: '''+c+''''));
  end;
var
  i:integer;
begin
  while (Length(s)>0)and(s[1] in [#10,#13,#32,#9]) do Delete(s,1,1);
  while (Length(s)>0)and(s[Length(s)] in [#10,#13,#32,#9]) do Delete(s,Length(s),1);
  SetLength(bar,Length(s));
  for i:=1 to Length(s) do
    bar[Length(s)-i]:=CharToBit(s[i]);
end;

procedure StrToDecArr(s: string; var bar: TDecArray);
  function CharToDec (c: char): TDecimal;
  begin
    if (c>=#48) and (c<=#58) then
      Result:=ord(c)-48
    else
      raise (Exception.Create('Invalid character: '''+c+''''));
  end;
var
  i:integer;
begin
  while (Length(s)>0)and(s[1] in [#10,#13,#32,#9]) do Delete(s,1,1);
  while (Length(s)>0)and(s[Length(s)] in [#10,#13,#32,#9]) do Delete(s,Length(s),1);
  SetLength(bar,Length(s));
  for i:=1 to Length(s) do
    bar[Length(s)-i]:=CharToDec(s[i]);
end;

procedure DecArrToStr(dar: TDecArray; var s: string);
  function DecToChar (d: TDecimal): char;
  begin
    Result:=chr(48+d);
  end;
var
  i:integer;
begin
  s:='';
  for i:=1 to Length(dar) do
    s:=s+DecToChar(dar[Length(dar)-i]);
end;

procedure BinArrToStr(bar: TBitArray; var s: string);
  function BinToChar (d: TBit): char;
  begin
    Result:=chr(48+d);
  end;
var
  i:integer;
begin
  s:='';
  for i:=1 to Length(bar) do
    s:=s+BinToChar(bar[Length(bar)-i]);
end;

procedure IncDecimal(var d: TDecArray);
var
  flag: boolean;
  index: integer;
begin
  flag:=false;
  index:=0;
  while not flag do begin
    if Length(d)<index+1 then begin
      SetLength(d,Length(d)+1);
      d[index]:=0;
    end;
    if d[index]=9 then begin
      d[index]:=0;
      inc(index)
    end else begin
      inc(d[index]);
      flag:=true;
    end;
  end;
end;

procedure DecDecimal(var d: TDecArray);
var
  flag: boolean;
  index: integer;
begin
  flag:=false;
  index:=0;
  while not flag do begin
    if d[index]=0 then begin
      d[index]:=9;
      inc(index)
    end else begin
      dec(d[index]);
      flag:=true;
    end;
  end;
  while (Length(d)>0)and(d[Length(d)-1]=0) do SetLength(d,Length(d)-1);
end;

procedure IncBinary(var b: TBitArray);
var
  flag: boolean;
  index: integer;
begin
  flag:=false;
  index:=0;
  while not flag do begin
    if Length(b)<index+1 then begin
      SetLength(b,Length(b)+1);
      b[index]:=0;
    end;
    if b[index]=0 then begin
      b[index]:=1;
      flag:=true;
    end else begin
      b[index]:=0;
      inc(index);
    end;
  end;
end;

procedure DecBinary(var b: TBitArray);
var
  flag: boolean;
  index: integer;
begin
  flag:=false;
  index:=0;
  while not flag do begin
    if b[index]=1 then begin
      b[index]:=0;
      flag:=true;
    end else begin
      b[index]:=1;
      inc(index);
    end;
  end;
  while (Length(b)>0)and(b[Length(b)-1]=0) do SetLength(b,Length(b)-1);
end;

function Dec2Bin (dec: string): string;
var
  BinArr: TBitArray;
  DecArr: TDecArray;
begin
  SetLength(BinArr,0);
  SetLength(DecArr,0);
  StrToDecArr(dec,DecArr);
  while Length(DecArr)>0 do begin
    DecDecimal(DecArr);
    IncBinary(BinArr);
  end;
  BinArrToStr(BinArr,Result);
end;

function Bin2Dec (bin: string): string;
var
  BinArr: TBitArray;
  DecArr: TDecArray;
begin
  SetLength(BinArr,0);
  SetLength(DecArr,0);
  StrToBinArr(bin,BinArr);
  while Length(BinArr)>0 do begin
    IncDecimal(DecArr);
    DecBinary(BinArr);
  end;
  DecArrToStr(DecArr,Result);
end;

end.

Прилагаю исходник, и пример пользования...