¿Existe alguna rutina o código para convertir números a texto?

Alguien sabe de una rutina o código para convertir números a texto

1 Respuesta

Respuesta
1
Declara esta función en tu forma donde la vayas a utilizar, generalmente en las llamadas a esta función vas a utilizar
function NumLetra(numero,1, 1)
(**************************************)
(* Conversión Número -> Letra *)
(* *)
(* Parámetros: *)
(* *)
(* mNum: Número a convertir *)
(* iIdioma: Idioma de conversión *)
(* 1 -> Castellano *)
(* 2 -> Catalán *)
(* iModo: Modo de conversión *)
(* 1 -> Masculino *)
(* 2 -> Femenino *)
(* *)
(* Restricciones: *)
(* *)
(* - Redondeo a dos decimales *)
(* - Rango: 0,00 a 999.999.999.999,99 *)
(* *)
(**************************************)
function NumLetra(const mNum: Currency; const iIdioma, iModo: Smallint): String;
const
iTopFil: Smallint = 6;
iTopCol: Smallint = 10;
aCastellano: array[0..5, 0..9] of PChar =
( ('UNA ','DOS ','TRES ','CUATRO ','CINCO ',
'SEIS ','SIETE ','OCHO ','NUEVE ','UN '),
('ONCE ','DOCE ','TRECE ','CATORCE ','QUINCE ',
'dieciséis ','diecisiete ','dieciocho ','diecinueve ',''),
('diez ','veinte ','treinta ','cuarenta ','cincuenta ',
'sesenta ','setenta ','ochenta ','noventa ','veinti'),
('cien ','doscientas ','trescientas ','cuatrocientas ','quinientas ',
'seiscientas ','setecientas ','ochocientas ','novecientas ','ciento '),
('cien ','doscientos ','trescientos ','cuatrocientos ','quinientos ',
'seiscientos ','setecientos ','ochocientos ','novecientos ','ciento '),
('MIL ','MILLÓN ','MILLONES ','CERO ','Y ',
'UN ','DOS ','CON ','','') );
aCatalan: array[0..5, 0..9] of PChar =
( ( 'UNA ','DUES ','TRES ','QUATRE ','CINC ',
'SIS ','SET ','VUIT ','NOU ','UN '),
( 'ONZE ','DOTZE ','TRETZE ','CATORZE ','QUINCE ',
'SETZE ','DISSET ','DIVUIT ','DINOU ',''),
( 'DEU ','VINT ','TREINTA ','QUARANTA ','CINQUANTA ',
'seixanta ','setanta ','vuitanta ','noranta ','vint-i-'),
( 'CENT ','DOS-CENTES ','TRES-CENTES ','QUATRE-CENTES ','CINC-CENTES ',
'SIS-CENTES ','SET-CENTES ','VUIT-CENTES ','NOU-CENTES ','CENT '),
( 'CENT ','DOS-CENTS ','TRES-CENTS ','QUATRE-CENTS ','CINC-CENTS ',
'SIS-CENTS ','SET-CENTS ','VUIT-CENTS ','NOU-CENTS ','CENT '),
( 'MIL ','MILIO ','MILIONS ','ZERO ','-',
'UN ','DOS ','AMB ','','') );
var
aTexto: array[0..5, 0..9] of PChar;
cTexto, cNumero: String;
iCentimos, iPos: Smallint;
bHayCentimos, bHaySigni: Boolean;
(*************************************)
(* Cargar Textos según Idioma / Modo *)
(*************************************)
procedure NumLetra_CarTxt;
var
i, j: Smallint;
begin
(* Asignación según Idioma *)
for i := 0 to iTopFil - 1 do
for j := 0 to iTopCol - 1 do
case iIdioma of
1: aTexto[i, j] := aCastellano[i, j];
2: aTexto[i, j] := aCatalan[i, j];
else
aTexto[i, j] := aCastellano[i, j];
end;
(* Asignación si Modo Masculino *)
if (iModo = 1) then
begin
for j := 0 to 1 do
aTexto[0, j] := aTexto[5, j + 5];
for j := 0 to 9 do
aTexto[3, j] := aTexto[4, j];
end;
end;
(****************************)
(* Traducir Dígito -Unidad- *)
(****************************)
procedure NumLetra_Unidad;
begin
if not( (cNumero[iPos] = '0') or (cNumero[iPos - 1] = '1')
or ((Copy(cNumero, iPos - 2, 3) = '001') and ((iPos = 3) or (iPos = 9))) ) then
if (cNumero[iPos] = '1') and (iPos <= 6) then
cTexto := cTexto + aTexto[0, 9]
else
cTexto := cTexto
¿Copio exactamente así como esta el código?
Falto un pedazo de código aquí esta el resto
El código lo copias tal cual luego declaras la función y ya te había escrito como llamar esta función
(****************************)
(* Traducir Dígito -Unidad- *)
(****************************)
procedure NumLetra_Unidad;
begin
if not( (cNumero[iPos] = '0') or (cNumero[iPos - 1] = '1')
or ((Copy(cNumero, iPos - 2, 3) = '001') and ((iPos = 3) or (iPos = 9))) ) then
if (cNumero[iPos] = '1') and (iPos <= 6) then
cTexto := cTexto + aTexto[0, 9]
else
cTexto := cTexto + aTexto[0, StrToInt(cNumero[iPos]) - 1];
if ((iPos = 3) or (iPos = 9)) and (Copy(cNumero, iPos - 2, 3) <> '000') then
cTexto := cTexto + aTexto[5, 0];
if (iPos = 6) then
if (Copy(cNumero, 1, 6) = '000001') then
cTexto := cTexto + aTexto[5, 1]
else
cTexto := cTexto + aTexto[5, 2];
end;
(****************************)
(* Traducir Dígito -Decena- *)
(****************************)
procedure NumLetra_Decena;
begin
if (cNumero[iPos] = '0') then
Exit
else if (cNumero[iPos + 1] = '0') then
cTexto := cTexto + aTexto[2, StrToInt(cNumero[iPos]) - 1]
else if (cNumero[iPos] = '1') then
cTexto := cTexto + aTexto[1, StrToInt(cNumero[iPos + 1]) - 1]
else if (cNumero[iPos] = '2') then
cTexto := cTexto + aTexto[2, 9]
else
cTexto := cTexto + aTexto[2, StrToInt(cNumero[iPos]) - 1]
+ aTexto[5, 4];
end;
(*****************************)
(* Traducir Dígito -Centena- *)
(*****************************)
procedure NumLetra_Centena;
var
iPos2: Smallint;
begin
if (cNumero[iPos] = '0') then
Exit;
iPos2 := 4 - Ord(iPos > 6);
if (cNumero[iPos] = '1') and (Copy(cNumero, iPos + 1, 2) <> '00') then
cTexto := cTexto + aTexto[iPos2, 9]
else
cTexto := cTexto + aTexto[iPos2, StrToInt(cNumero[iPos]) - 1];
end;
(**************************************)
(* Eliminar Blancos previos a guiones *)
(**************************************)
procedure NumLetra_BorBla;
var
i: Smallint;
begin
i := Pos(' -', cTexto);
while (i > 0) do
begin
Delete(cTexto, i, 1);
i := Pos(' -', cTexto);
end;
end;
begin
(* Control de Argumentos *)
if (mNum < 0.00) or (mNum > 999999999999.99) or (iIdioma < 1) or (iIdioma > 2)
or (iModo < 1) or (iModo > 2) then
begin
Result := 'ERROR EN ARGUMENTOS';
Abort;
end;
(* Cargar Textos según Idioma / Modo *)
NumLetra_CarTxt;
(* Bucle Exterior -Tratamiento Céntimos- *)
(* NOTA: Se redondea a dos dígitos decimales *)
cNumero := Trim(Format('%12.0f', [Int(mNum)]));
cNumero := StringOfChar('0', 12 - Length(cNumero)) + cNumero;
iCentimos := Trunc((Frac(mNum) * 100) + 0.5);
repeat
(* Detectar existencia de Céntimos *)
if (iCentimos <> 0) then
bHayCentimos := True
else
bHayCentimos := False;
(* Bucle Interior -Traducción- *)
bHaySigni := False;
for iPos := 1 to 12 do
begin
(* Control existencia Dígito significativo *)
if not(bHaySigni) and (cNumero[iPos] = '0') then
Continue
else
bHaySigni := True;
(* Detectar Tipo de Dígito *)
case ((iPos - 1) mod 3) of
0: NumLetra_Centena;
1: NumLetra_Decena;
2: NumLetra_Unidad;
end;
end;
(* Detectar caso 0 *)
if (cTexto = '') then
cTexto := aTexto[5, 3];
(* Traducir Céntimos -si procede- *)
if (iCentimos <> 0) then
begin
cTexto := cTexto + aTexto[5, 7];
cNumero := Trim(Format('%.12d', [iCentimos]));
iCentimos := 0;
end;
until not (bHayCentimos);
(* Eliminar Blancos innecesarios -sólo Catalán- *)
if (iIdioma = 2) then
NumLetra_BorBla;
(* Retornar Resultado *)
Result := Trim(cTexto);
end;

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Numerico a string

Estoy realizando un programa, y necesito convertir números a letras, por ejemplo 1234 a mil doscientos treinta y cuatro.
1 respuesta

¿Alguien me podría ayudar con pascal?

Tengo un problema con un ejercicio de pascal, no lo entiendo y no se como sacar lo que me pide. Desearía un poco de ayuda por parte de los expertos, en fin el ejercicio dice así: ""Diseñar un algoritmo que lea un arreglo bidimensional de datos...
1 respuesta

Parte del codigo de la Batalla Naval, Pascal

Estoy hace unos dias haciendo la batalla naval, el tema es que ya pude cargar las matrices con los barcos y todo, lo unico q no me anda es el tema de "tocado" y "hundido" quiero que me digas por q no me esta andando esta condicion: if (j2[f,c] = 's')...
1 respuesta

Eliminar repetidos secuenciales en un array

Quería saber como podría solucionar el siguiente programita: Como eliminar de un arreglo de enteros los elementos que aparezcan repetidos secuencialmente, dejando solo los primeros de la secuencia A1=111 2 1 5 66 Aresultante = 1 2 1 5 6 Me gustaría...
1 respuesta

Ayuda en pascal para hacer pila

Mi problema trata de hacer una pila la cual deberá de ser de un limite máximo de 10 espacios en los cuales se podrán depositar algunas cifras, las cifras se integraran de abajo hacia arriba. Todo esto debe de llevar un menu en el cual debe de...
1 respuesta

Convertir entero o decimal a letras

Necesito convertir un valor entero o decimal a letras Ej: 57->Cincuenta y siete 14.57 -> Catorce punto cincuenta y siete 2.06 -> Dos punto cero seis 4.80 -> Cuatro punto ochenta ...
1 respuesta

Una duda con las matrices en pascal

Mi problema esta en como puedo hacer para que un usuario me pida una matriz NxM y el programa me la llene automáticamente... También puede ser que el usuario la llene pero me interesa más que la llene el programa por si solo Osea cual es la...
2 respuestas

Aplicación de subred local.

Soy de cuba y tengo problemas con una aplicación que intento desarrollar, visito este sitio porque la verdad que estoy lleno de dudas en como emprender el trabajo, la problemática planteada esl a siguiente: ? Construir una aplicación que permita...
1 respuesta

De números a letras + decimales

Estoy realizando un sistema que imprima un cheque determinado lo que necesito es que cuando ingrese por ejemplo un monto 1,200.25 me muestre en otro static text pero en letras UN MIL DOSCIENTOS CON 25/100 pero AUTOMÁTICAMENTE gracias hasta ahora he...
2 respuestas

Sumar binarios

Quería saber si me puedes dar una idea con esto: Tengo un vector que guara un numero binario (componentes con 1 y 0) y le quiero sumar 1 para pasarlo a complemento a 2. Y ademas si sabes como puedo sumar vectores de números binarios o si hay una...
1 respuesta