conversion de sistema de numeracion + delphi 7

[ecfisa]

Hola Nicolas.

Hoy andaba con nostalgia de épocas de estudiante...

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Edit: TEdit;
    RGroupBases: TRadioGroup;
    procedure RGroupBasesClick(Sender: TObject);
    procedure EditKeyPress(Sender: TObject; var Key: Char);
    procedure FormShow(Sender: TObject);
  private
    FBasePrevia: Integer;
    procedure DivisionReiterada(var Numero:string; Base:integer);
    procedure SumaPonderada(var Numero:string; Base:integer);
  public
  end;

var
  Form1: TForm1;

implementation {$R *.dfm}

uses Math;

procedure TForm1.FormShow(Sender: TObject);
begin
  // Cargar Items + Valor de las bases
  with RGroupBases do
  begin
    Items.AddObject('Binario', TObject(2));
    Items.AddObject('Octal', TObject(8));
    Items.AddObject('Decimal', TObject(10));
    Items.AddObject('Hexadecimal', TObject(16));
  end;
  FBasePrevia:= 2;           // Binario
  RGroupBases.ItemIndex:= 0; // Primer Item
  // Previamente quitar evento RadioGroup.OnClick del Object Inspector
  RGroupBases.OnClick:= RGroupBasesClick;
end;

{ Funcion que pasa de base N a decimal }
function BaseNToDec(Numero : string; Base : byte): Integer;
const
  BHex = '0123456789ABCDEF';
var
  i : Byte;
begin
  Result:=0;
  for i:=1 to length(Numero) do
    Result:= Result * Base + Pos(Upcase(Numero[i]), BHex) - 1;
end;

{ Suma ponderada }
procedure TForm1.SumaPonderada (var Numero:string; Base:integer);
var
  i:integer;
  m:Extended;
begin
  m:=0;
  for i:= 1 to Length(Numero) do
  begin
    case Numero[i] Of
      'A': m:= m + 10 * Power(FBasePrevia, Length(Numero) - i);
      'B': m:= m + 11 * Power(FBasePrevia, Length(Numero) - i);
      'C': m:= m + 12 * Power(FBasePrevia, Length(Numero) - i);
      'D': m:= m + 13 * Power(FBasePrevia, Length(Numero) - i);
      'E': m:= m + 14 * Power(FBasePrevia, Length(Numero) - i);
      'F': m:= m + 15 * Power(FBasePrevia, Length(Numero) - i);
      else
       m:= m + StrToInt(Numero[i]) * Power(FBasePrevia, Length(Numero) - i);
    end;
  end;
  Numero:= FloatToStr(m);
end;

{ División reiterada }
procedure TForm1.DivisionReiterada(var Numero:string; Base:integer);
var
  num: integer;
  d:integer;
begin
  // Calcular en base a la base previa al click
  num:= BaseNToDec(Numero, FBasePrevia);  // Pasar a base 10
  Numero:=  '';
  while (num > 0) do
  begin
    d:= num mod Base;
    num:= num div Base;
    case d of
      10: Numero:= 'A' + Numero;
      11: Numero:= 'B' + Numero;
      12: Numero:= 'C' + Numero;
      13: Numero:= 'D' + Numero;
      14: Numero:= 'E' + Numero;
      15: Numero:= Numero + 'F';
      else
        Numero:= IntToStr(d) + Numero;
    end;
  end;
  Numero:= Numero;
end;

procedure TForm1.EditKeyPress(Sender: TObject; var Key: Char);
begin
  Key:= UpCase(Key);         // A mayúsculas
  case RGroupBases.ItemIndex Of
    0: If not (Key in ['1','0', #8]) then key:= #0;
    1: If not (Key in ['0'..'7', #8]) then key:= #0;
    2: If not (Key in ['0'..'9', #8]) then key:= #0;
    3: If not (Key in ['0'..'9', 'A'..'F', #8]) then key:= #0;
  end;
end;

{ RadioGroup OnClick }
procedure TForm1.RGroupBasesClick(Sender: TObject);
var
  Valor: string;
begin
  Valor:= Edit.Text;
  Edit.SetFocus;
  if RGroupBases.ItemIndex <> 2 then   // Binario, Octal, Hexadecimal
  begin
    case RGroupBases.ItemIndex of
       0: DivisionReiterada(Valor,2);
       1: DivisionReiterada(Valor,8);
       2: DivisionReiterada(Valor,10);
       3: DivisionReiterada(Valor,16)
    end;
  end
  else                                 // Decimal
  begin
    case RGroupBases.ItemIndex of
      0: SumaPonderada(Valor,2);
      1: SumaPonderada(Valor,8);
      2: SumaPonderada(Valor,10);
      3: SumaPonderada(Valor,16);
    end;
  end;
  // Actualizar valor de la base
  FBasePrevia:= Integer(RGroupBases.Items.Objects[RGroupBases.ItemIndex]);
  Edit.Text:= Valor;
end;

end.

Saludos.