Ver Mensaje Individual
  #16  
Antiguo 21-07-2015
Avatar de nlsgarcia
[nlsgarcia] nlsgarcia is offline
Miembro Premium
 
Registrado: feb 2007
Ubicación: Caracas, Venezuela
Posts: 2.206
Reputación: 21
nlsgarcia Tiene un aura espectacularnlsgarcia Tiene un aura espectacular
Club Delphi,

Revisen el siguiente código:
Código Delphi [-]
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    rdgCentime: TRadioGroup;
    rdgCapital: TRadioGroup;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

// Convierte números a letras de forma recursiva
{
 Number : Número a convertir en letras, puede ser con o sin décimales
 Centime : 0 = Céntimos a Letras, 1 = Céntimos a Fracción, 2 = Sin Céntimos, valor por default 0
 Capital : 0 = Al inicio de cada Número, 1 = Solo el primer Número, 2 = Todo, valor por default 0
}
function NumbersToLetters(Number: Double; Centime : Byte = 0; Capital : Byte = 0) : String;
const
  Digit: Array[1..9] of String = ('Uno', 'Dos', 'Tres',
                                  'Cuatro', 'Cinco', 'Seis',
                                  'Siete', 'Ocho', 'Nueve');

  Numeral: Array[11..19] of String = ('Once', 'Doce', 'Trece',
                                      'Catorce', 'Quince', 'Diez y Seis',
                                      'Diez y Siete', 'Diez y Ocho', 'Diez y Nueve');

  Tenths: Array[1..9] of String = ('Diez', 'Veinte', 'Trienta',
                                   'Cuarenta', 'Cincuenta', 'Sesenta',
                                   'Setenta', 'Ochenta', 'Noventa');

  Hundreds : Array[1..9] of String = ('Cien ', 'Doscientos ', 'Trescientos ',
                                      'Cuatrocientos ', 'Quinientos ', 'Seiscientos ',
                                      'Setecientos ', 'Ochocientos ', 'Novecientos ');

  Min = 1;
  Max = 4294967295;

  function RecursiveNumber(N: LongWord): String;
  begin

    case N of

      1..9:
      begin
         Result := Digit[N];
      end;

      11..19:
      begin
         Result := Numeral[N]
      end;

      10,20..99:
      begin
         if (N Mod 10) = 0 then
            Result := Tenths[N div 10] + RecursiveNumber(N mod 10)
         else
            Result := Tenths[N div 10] + ' y '  + RecursiveNumber(N mod 10);
      end;

      100..999:
      begin
        if (N = 100) or (N >= 200) then Result := Hundreds[N div 100] + RecursiveNumber(N mod 100);
        if (N > 100) and (N < 200) then Result := 'Ciento ' + RecursiveNumber(N mod 100);
      end;

      1000..999999:
      begin
         if (Number >= 1000) and (Number < 2000) then
            Result := 'Un Mil ' + RecursiveNumber(N mod 1000)
         else
            Result := RecursiveNumber(N div 1000) + ' Mil ' + RecursiveNumber(N mod 1000);
      end;

      1000000..999999999:
      begin
         if (Number >= 1000000) and (Number < 2000000) then
            Result := 'Un Millón ' + RecursiveNumber(N mod 1000000)
         else
            Result := RecursiveNumber(N div 1000000) + ' Millones ' + RecursiveNumber(N mod 1000000);
      end;

      1000000000..4294967295:
      begin
         if (Number >= 1000000000) and (Number < 2000000000) then
            Result := 'Un Millardo ' + RecursiveNumber(N mod 1000000)
         else
            Result := RecursiveNumber(N div 1000000000) + ' Millardos ' + RecursiveNumber(N mod 1000000000);
      end;

    end;

  end;

var
   F : String;
   NumberStr : String;

begin

  if (Number >= Min) and (Number <= Max) then
  begin

     NumberStr := Trim(RecursiveNumber(Trunc(Number)));
     F := FormatFloat('00',Frac(Number) * 100);

     case Centime of
        0 : if F = '00' then
               NumberStr := NumberStr +  ' con ' + 'Cero Céntimos'
            else
               NumberStr := NumberStr +  ' con ' + RecursiveNumber(StrToInt(F)) + ' Céntimos';

        1 : NumberStr := NumberStr +  ' con ' + F + '/100';

        2 : F := EmptyStr;
     end;

     case Capital of
        0 : Result := NumberStr;

        1 : Result := Uppercase(Copy(NumberStr,1,1))+Lowercase(Copy(NumberStr,2,Length(NumberStr)));

        2 : begin
               NumberStr := StringReplace(NumberStr,'Millón','Millon',[]);
               NumberStr := StringReplace(NumberStr,'Céntimos','Centimos',[]);
               Result := Uppercase(NumberStr);
            end;
     end;

  end
  else
     Result := '-1';

end;

procedure TForm1.FormCreate(Sender: TObject);
var
   i : Integer;
begin
   rdgCentime.Font.Color := clBlue;
   rdgCapital.Font.Color := clBlue;
   for i := 0 to  rdgCentime.ControlCount -1 do
   begin
      TRadioButton(rdgCentime.Controls[i]).Font.Color := clBlack;
      TRadioButton(rdgCapital.Controls[i]).Font.Color := clBlack;
   end;
   rdgCentime.ItemIndex := 0;
   rdgCapital.ItemIndex := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
   Number : Double;
begin
   if TryStrToFloat(Edit1.Text,Number) then
      Memo1.Text := NumbersToLetters(Number,rdgCentime.ItemIndex, rdgCapital.ItemIndex)
   else
      MessageDlg('Error en formato de Número',mtError,[mbOK],0);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   Edit1.Text := EmptyStr;
   Memo1.Clear;
   rdgCentime.ItemIndex := 0;
   rdgCapital.ItemIndex := 0;
   Edit1.SetFocus;
end;

end.
El código anterior en Delphi 7 sobre Windows 7 Professional x32 es la Versión 2 del código propuesto en el Msg #1, el cual permite : Convertir números a letras por medio de una función recursiva y escoger entre tres opciones de céntimos y mayúsculas, como se muestra en la siguiente imagen:



El código del ejemplo esta disponible en : NumbersToLetters_v2.rar

Notas:

1- Esta versión es más adaptable a diferentes requerimientos.

2- La función mantiene la simplicidad de la original.

3- Se corrigieron algunas erratas y detalles menores.

Espero sea útil

Nelson.
Responder Con Cita