2 funciones / procedures
Hola, necesitaría que me pasen el código fuente para resolver:
1. Conversión de números a letras (con posibilidad de decimales)
2. Utilizar la tecla <enter> igual que <tab>, es decir, que al presionar <enter> el cursor se ubique en el próximo text box. Gracias
1. Conversión de números a letras (con posibilidad de decimales)
2. Utilizar la tecla <enter> igual que <tab>, es decir, que al presionar <enter> el cursor se ubique en el próximo text box. Gracias
Respuesta de jarvher
1
1
jarvher, PREMIO DE LA SUPERACION CIUDADANA 1991 TECNICO PROGRAMADOR NIVEL...
Esta función lo hace en dos idiomas y en dos géneros pero para tu llamada a función generalmente usas function NumLetra(mNumero, 1,1):
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 + 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]
Els
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 + 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]
Els
Desde ya, gracias por tu respuesta. Me parece que en última parte del código no está completa, parece cortado:
(*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]
els //<- AQUI SE CORTO
¿Faltaría algo?. Gracias
(*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]
els //<- AQUI SE CORTO
¿Faltaría algo?. Gracias
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;
Para lo del enter como tab, pone el siguiente código en el evento onkeypress de cada edit:
if key = #13 then
Edit2. Setfocus
Es decir el código van en el edit 1 y el edit2 es el siguiente, solo recuerda que no puedes poner setfocus en un edit no habilitado
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;
Para lo del enter como tab, pone el siguiente código en el evento onkeypress de cada edit:
if key = #13 then
Edit2. Setfocus
Es decir el código van en el edit 1 y el edit2 es el siguiente, solo recuerda que no puedes poner setfocus en un edit no habilitado
- Compartir respuesta
- Anónimo
ahora mismo