conversion de sistema de numeracion + delphi 7

[Nicolas_2011]

mil discuplas, no sabia

[ecfisa]

Hola Nicolas.

No hay problema, sos nuevo y es lógico pero si nadie te lo dice, no vas a usar las etiquetas...

Estuve corrigiendo un poco tu código y así parece funcionar bién:

Código Delphi [-]
...
implementation

uses Math;

function TForm1.sp (s:string ;bp:integer):string; // suma ponderada
var
  i:integer;
  m:Extended;
begin
  m:=0;
  For i:=1 to Length(s) do
    case s[i] Of
      'A' : m:= m + 10* Power(bp,Length(s) - i);
      'B' : m:= m + 11* Power(bp,Length(s) - i);
      'C' : m:= m + 12* Power(bp,Length(s) - i);
      'D' : m:= m + 13* Power(bp,Length(s) - i);
      'E' : m:= m + 14* Power(bp,Length(s) - i);
      'F' : m:= m + 15* Power(bp,Length(s) - i);
      else
       m:= m + StrToInt(s[i])*Power(bp,Length(s)-i);
    end;
  result:=FloatToStr(m);
end;

function TForm1.dr (s:string; bl:integer):string; // division reiterada
var
  num: integer;
  d:integer;
  resultado:string;
begin
  num:= StrToInt(s);
  resultado:=  '';
  while (num > 0) do
  begin
    d:= num mod bl;
    num:= num div bl;
    case d of
      10: resultado:= 'A' + resultado;
      11: resultado:= 'B' + resultado;
      12: resultado:= 'C' + resultado;
      13: resultado:= 'D' + resultado;
      14: resultado:= 'E' + resultado;
      15: resultado:= 'F' + resultado;
      else
        resultado:= IntToStr(d) + resultado;
    end;
  end;
  Result:= resultado;
end;

procedure TForm1.eKeyPress(Sender: TObject; var Key: Char);
begin
  case RgBase.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 ['A'..'F', '0'..'9', #8]) then key:= #0;
  end;
end;

procedure TForm1.rgBaseClickClick(Sender: TObject);
begin
  e.Enabled := true;
  e.SetFocus;
  if rgbase.ItemIndex <> 2 then   // Si es cualquier número excepto el 2
  begin
    case rgbase.ItemIndex of
       0: e.Text := dr(e.Text,2);
       1: e.Text := dr(e.Text,8);
       2: e.Text := dr(e.Text,10);
       3: e.Text := dr(e.Text,16)
    end;
  end
  else                             // Si no, es el 2
  begin
    case rgbase.ItemIndex of
      0 : e.Text := sp(e.Text,2);
      1 : e.Text:= sp(e.Text,8);
      2 : e.Text:= sp(e.Text,10);
      3 : e.text:= sp(e.Text,16);
    end;
  end;
end;
end.

Cualquier duda o problema avisame y te adjunto los fuentes de mi prueba.

Un saludo.

[Nicolas_2011]

Amigo estoy tiendiendo 2 problemas.
problema 1. Solo puedo seleccionar x primera vez el item 2 osea base 10. si selecciono por primera vez cualquier otro tira error.
problema 2. al seleccionar base 10(obligadamente) ingrso el numero, selecciono otra base (cualquiera) y convierte bien, pero luego no puedo seleccionar otra base para que convierta nuevamente da error.

[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.

[Nicolas_2011]

muchas gracias amigo ahora me pongo a interpretarlo, seguramente me sera de gran ayuda

[ecfisa]

Hola Nicolas.

Echando una segunda mirada al código que te puse, veo que se puede simplificar aún más... RGroupBasesClick puede quedar así:

Código Delphi [-]
{ RadioGroup OnClick }
procedure TForm1.RGroupBasesClick(Sender: TObject);
var
  Valor: string;
begin
  Valor:= Edit.Text;
  Edit.SetFocus;
  if RGroupBases.ItemIndex <> 2 then   // Binario, Octal, Hexadecimal
    DivisionReiterada(Valor, Integer(RGroupBases.Items.Objects[RGroupBases.ItemIndex]))
  else                                // Decimal
    SumaPonderada(Valor, Integer(RGroupBases.Items.Objects[RGroupBases.ItemIndex])); 
  FBasePrevia:= Integer(RGroupBases.Items.Objects[RGroupBases.ItemIndex]);  // Actualizar valor de la base
  Edit.Text:= Valor;
end;

Seguramente encuentres algunas partes más para optimizar.

Saludos.