Cambiar numeros a cantidad con letra

[odrack]

Saludos.

Quiza ya se haya hablado varias veces de este tema pero tengo un pequeño problema que me esta dando dolor de cabeza, tengo este codigo (mostrado en la parte de abajo) el cual esta funcionando correctamente hasta 999,999.99, tengo la necesidad de ampliarlo hasta 9 millones lo cual he tenido algunos problemas para esto. Cuando lo ejecuto marca el siguiente error "EconvertError with message".
Alguien me puede ayudar con esto, se los agradeceria mucho.

Tal y como esta hasta el momento funciona hasta 999,999.99, cuando quito la parte comentada en el codigo produce el error.

Código Delphi [-]
unit Extens;
interface
function extenso (valor: real): string;
implementation
uses
  SysUtils,  Dialogs;
function extenso (valor: real): string;
var
 Centavos, Centena, Millar, Millon,Texto, msg: string;
 const
  Unidades: array[1..9] of string = ('Un','Dos', 'Tres', 'Cuatro', 'Cinco',
                                    'Seis', 'Siete', 'Ocho', 'Nueve');
  Diez: array[1..9] of string = ('Once', 'Doce', 'Trece', 'Catorce', 'Quince',
                               'Dieciseis', 'Diecisiete', 'Dieciocho', 'Diecinueve');
  Decenas: array[1..9] of string = ('Diez', 'Veinte', 'Treinta', 'Cuarenta',
                                   'Cincuenta', 'Sesenta', 'Setenta',
                                   'Ochenta', 'Noventa');
  Centenas: array[1..9] of string = ('Ciento', 'Doscientos', 'Trescientos',
                                    'Cuatrocientos', 'Quinientos', 'Seiscientos',
                                    'Setecientos', 'Ochocientos', 'Novecientos');
  Millones: array[1..9] of string = ('Un ','Dos ', 'Tres ', 'Cuatro ', 'Cinco ',
                                    'Seis ', 'Siete ', 'Ocho ', 'Nueve ');
function ifs(Expresado: Boolean; CasoVerdadero, CasoFalso: String): String;
  begin
    if Expresado then
      Result:=CasoVerdadero
    else
      Result:=CasoFalso;
  end;
 function MiniExtenso (tres: string): string;
  var
    Unidad, Decena, Centena, Millones: string;
  begin
    Unidad:='';
    Decena:='';
    Centena:='';
    Millones:='';
   if (tres[2]='1') and (tres[3]<>'0') then
    begin
      Unidad:=Diez[strtoint(tres[3])];
      Decena:='';
    end
    else
    begin
      if tres[2]<>'0' then Decena:=Decenas[strtoint(tres[2])];
      if tres[3]<>'0' then Unidad:=Unidades[strtoint(tres[3])];
//      if tres[4]<>'0' then Unidad:=Unidades[strtoint(tres[4])];
    end;
    if (tres[1]='1') and (Unidad='') and (Decena='') and (Millones='') then
      Centena:='Cien'
    else
      if tres[1]<>'0' then
        Centena:=Centenas[strtoint(tres[1])]
      else
        Centena:='';
        Result:=
//         Millones + ifs((Millones<>'') and ((Centena<>'') or (Decena<>'')), ' ', '')
         Centena + ifs((Centena<>'')  and ((Decena<>'')  or (Unidad<>'')), ' ', '')
         + Decena + ifs((Decena<>'')   and (Unidad<>''),' y ', '') + Unidad;
    end;
begin
  if (valor>9999999.99) or (valor<0) then
   begin
    msg:='El Valor esta fuera del rango permitido';
    msg:=msg+'El numero debe ser menor que: 9.999.999.99';
    showmessage(msg);
    Result:='';
    exit;
   end;
 if valor=0 then
  begin
    Result:='';
    Exit;
  end;
   Texto:=formatfloat('0000000.00',valor);
   Millon:=MiniExtenso(copy(Texto, 1,3));
   Millar:=MiniExtenso(Copy(Texto,2,3));
   Centena:=MiniExtenso(Copy(Texto,5,3));
   Centavos:=MiniExtenso('0'+Copy(Texto,9,2));
   Result:=Millar;
 if Millon<>'' then
   if copy(texto,1,3)='1' then
     Result:=Result+' Un Millon'
   else
     Result:=Result+' Millones ';
 if Millar<>'' then
   if copy(texto,4,3)='000' then
     Result:=Result+' Mil pesos'
   else
     Result:=Result+' Mil ';
 if (Millar+Centena <>'') then
     Result:=Result+Centena;
 if (Millar='') and (copy(texto,4,3)='001') then
     Result:=Result+' Peso'
   else
    if (copy(texto,4,3)<>'000') then
      Result:=Result+' Pesos ';
 
{ if Centavos='' then
    begin
      Result:=Result+'.';
      Exit;
    end
    else
    begin
      if Millar+Centena='' then
        Result:=Centavos
      else
        Result:=Result+' con '+Centavos;
    if (copy(texto,8,2)='01') and (Centavos<>'') then
      Result:=Result+' Centavos.'
    else
    Result:=Result+' Centavos.';
  end;}
end;
end.

[[maeyanes]]

Hola...

Te recomiendo que cheques los enlaces que se muestran en la parte inferior de este hilo, ahí donde dice: Temas Similares.

También si haces una búsqueda por ATexto podrás encontrar información que te sirva...


Saludos...

[[enecumene]]

Hola, el componente ATexto se encuentra en el FTP del club,

http://www.terawiki.clubdelphi.com/a...tes/ATexto.zip

Y Concordando con maeyanes, con una pequeña busqueda por el foro lo hubieses encontrado.

Saludos.

[odrack]

Gracias por responder, anteriormente lo habia buscado en el foro y encontre varios temas similares interesantes, descargue Atexto pero no he logrado instalarlo, me podrian explicar de forma rapida como cargar el archivo??

Saludos

[[enecumene]]

Pues es tan facil instalar como cualquier otro componente común, a traves de la solapa components/install component, luego buscas el .PAS y lo instalas.

Saludos.

[ContraVeneno]

http://www.clubdelphi.com/trucos/ind...ll=0&scrollb=0

http://www.clubdelphi.com/foros/show...5&postcount=15