|
Usuários |
|
270 Usuários Online
|
|
[Artigos]
Conversor Geral de Números (extenso, cardinal, ordinal, romano, ...) |
Publicado por mayco.rolbuche : Quarta, Dezembro 19, 2012 - 01:42 GMT-3 (503 leituras)
 comentar  Enviar para um amigo  Versão para impressão
|
Funções que converte qualquer número em seu extenso, cardinal, romano, moeda, ordinal e muitos outros. Nesta rotina contém as seguintes funções:
NUM_EXTENSO(NUMERO,TIPO)
---------------------
EX.: NUM_EXTENSO(121,'C')
RETORNO: cento e vinte e um
EX.: NUM_EXTENSO(121,'O')
RETORNO: centésimo vigésimo primeiro
EX.: NUM_EXTENSO(121,'R')
RETORNO: CXXI
Escreve por extenso os números.
Os tipos podem ser:
'C' = Cardinais por extenso
'O' = Ordinais por extenso
'R' = Converte em algarismo romano
ROMANO_CARDINAL(NUMERO)
-----------------------
EX.: ROMANO_CARDINAL('XVII')
RETORNO: 17
Converte número romano para número cardinal.
CARDINAL_ROMANO(NUMERO)
-----------------------
EX.: CARDINAL_ROMANO(17)
RETORNO: XVII
Converte número cardinal para número romano.
MOEDA_EXTENSO(VALOR)
-----------------------
EX.: MOEDA_EXTENSO(1.50)
RETORNO: um real e cinquenta centavos
Converte número para moeda brasileira (Real e centavos).
ESCOLHEMOEDA_EXTENSO(VALOR,MOEDA SINGULAR,MOEDA PLURAL,MOEDA2 SINGULAR,MOEDA2 PLURAL)
-----------------------
EX.: MOEDA_EXTENSO(1.50,'dólar','dólares','cent','cents')
RETORNO: um dólar e cinquenta cents
Converte número para moeda estipulada pelo usuário.
Basta colocar o valor e o tipo de moeda, no singular e no plural.
--------------------------------------------
Declare a biblioteca "math" em uses.
Em type, coloque as seguintes funções, em seguida, pressione "CTRL + SHIFT + C":
function MOEDA_EXTENSO(NUM: real):string;
function ESCOLHEMOEDA_EXTENSO(NUM: real; UNS, UNP, CNS, CNP: string):string;
function NUM_EXTENSO(NUM: real;TP: string):string;
function ROMANO_CARDINAL(NUM: string):string;
function CARDINAL_ROMANO(NUM: real):string;
function UNI(NUM: integer):string;
function DEZ(NUM: integer):string;
function CEN(NUM: integer):string;
function MIL(NUM: real):string;
function ORD(NUM: real):string;
function MILHARES(NUM: real;NIVEL: integer):string;
function ROM(NUM: real):string;
Agora, dentro de cada função, coloque o conteúdo abaixo:
function TForm1.MOEDA_EXTENSO(NUM: real): string;
begin
result := ESCOLHEMOEDA_EXTENSO(NUM,'real','reais','centavo','centavos');
end;
function TForm1.ESCOLHEMOEDA_EXTENSO(NUM: real; UNS, UNP, CNS, CNP: string):string;
var
N,EXT,NEG: string;
VL,CN: real;
begin
if copy(floattostr(NUM),1,1) = '-' then
begin
NEG := ' negativo';
NUM := strtoint(stringreplace(floattostr(NUM),'-','',[]));
end
else
NEG := '';
N := Stringreplace(floattostr(NUM),'.','',[]);
EXT := '';
if pos(',',N) = 0 then
begin
VL := strtofloat(N);
CN := 0;
end
else
begin
VL := strtofloat(copy(N,1,pos(',',N)));
if copy(N,pos(',',N)+2,2) = '' then
CN := strtofloat(copy(N,pos(',',N)+1,2))*10
else
CN := strtofloat(copy(N,pos(',',N)+1,2));
end;
if (VL = 0) and (CN = 0) then
EXT := EXT + NUM_EXTENSO(VL,'C') + ' ' + UNP
else if VL = 1 then
EXT := EXT + NUM_EXTENSO(VL,'C') + ' ' + UNS
else if VL > 1 then
EXT := EXT + NUM_EXTENSO(VL,'C') + ' ' + UNP;
if (VL = 0) and (CN = 1) then
EXT := EXT + NUM_EXTENSO(CN,'C') + ' ' + CNS
else if (VL = 0) and (CN > 0) then
EXT := EXT + NUM_EXTENSO(CN,'C') + ' ' + CNP
else if CN = 1 then
EXT := EXT + ' e ' + NUM_EXTENSO(CN,'C') + ' ' + CNS
else if CN > 0 then
EXT := EXT + ' e ' + NUM_EXTENSO(CN,'C') + ' ' + CNP;
result := EXT + NEG;
end;
function TForm1.NUM_EXTENSO(NUM: real;TP: string):string;
var
EXT: string;
NEG: string;
begin
if TP = 'C' then//CARDINAIS
begin
if copy(floattostr(NUM),1,1) = '-' then
begin
NEG := ' negativo';
NUM := strtoint(stringreplace(floattostr(NUM),'-','',[rfIgnoreCase, rfReplaceAll]));
end
else
NEG := '';
if NUM = 0 then
EXT := 'zero'
else if (NUM > 0) and (NUM < 10) then
EXT := UNI(strtoint(floattostr(NUM)))
else if (NUM >= 10) and (NUM < 100) then
EXT := DEZ(strtoint(floattostr(NUM)))
else if (NUM >= 100) and (NUM < 1000) then
EXT := CEN(strtoint(floattostr(NUM)))
else if (NUM >= 1000) and (NUM < 1000000) then
EXT := MIL(NUM)
else if (NUM >= power(10,6)) and (NUM < power(10,9)) then
EXT := MILHARES(NUM,1)
else if (NUM >= power(10,9)) and (NUM < power(10,12)) then
EXT := MILHARES(NUM,2)
else if (NUM >= power(10,12)) and (NUM < power(10,15)) then
EXT := MILHARES(NUM,3)
else if (NUM >= power(10,15)) and (NUM < power(10,18)) then
EXT := 'valor muito alto ! (aprox. '+floattostr(NUM)+' quatrilhões)'
else if (NUM >= power(10,18)) and (NUM < power(10,21)) then
EXT := 'valor muito alto ! (aprox. '+floattostr(NUM)+' quintilhões)'
else if (NUM >= power(10,21)) and (NUM < power(10,24)) then
EXT := 'valor muito alto ! (aprox. '+floattostr(NUM)+' sextilhões)'
else if (NUM >= power(10,24)) and (NUM < power(10,27)) then
EXT := 'valor muito alto ! (aprox. '+floattostr(NUM)+' septilhões)'
else if (NUM >= power(10,27)) and (NUM < power(10,30)) then
EXT := 'valor muito alto ! (aprox. '+floattostr(NUM)+' octilhões)'
else if (NUM >= power(10,30)) and (NUM < power(10,33)) then
EXT := 'valor muito alto ! (aprox. '+floattostr(NUM)+' nonilhões)'
else if (NUM >= power(10,33)) and (NUM < power(10,36)) then
EXT := 'valor muito alto ! (aprox. '+floattostr(NUM)+' decilhões)'
else
EXT := 'valor alto demais ! ('+floattostr(NUM)+')';
end
else if TP = 'O' then//ORDINAIS
begin
if copy(floattostr(NUM),1,1) = '-' then
begin
NEG := ' negativo';
NUM := strtoint(stringreplace(floattostr(NUM),'-','',[rfIgnoreCase, rfReplaceAll]));
end
else
NEG := '';
if NUM = 0 then
EXT := 'zero'
else if (NUM >= 1) and (NUM < power(10,15)) then
EXT := ORD(NUM)
else
EXT := 'valor alto demais ! ('+floattostr(NUM)+')';
end
else if TP = 'R' then//ROMANOS
begin
if copy(floattostr(NUM),1,1) = '-' then
begin
NEG := '-';
NUM := strtoint(stringreplace(floattostr(NUM),'-','',[rfIgnoreCase, rfReplaceAll]));
end
else
NEG := '';
if NUM = 0 then
EXT := ' '
else if (NUM >= 1) and (NUM < 4000) then
EXT := ROM(NUM)
else
EXT := 'valor alto demais ! ('+floattostr(NUM)+')';
EXT := NEG + EXT;
NEG := '';
end;
result := EXT + NEG;
end;
function TForm1.UNI(NUM: integer): string;
var
N_UNI: array [1..9] of string;
begin
N_UNI[1] := 'um';
N_UNI[2] := 'dois';
N_UNI[3] := 'três';
N_UNI[4] := 'quatro';
N_UNI[5] := 'cinco';
N_UNI[6] := 'seis';
N_UNI[7] := 'sete';
N_UNI[8] := 'oito';
N_UNI[9] := 'nove';
result := N_UNI[NUM];
end;
function TForm1.DEZ(NUM: integer): string;
var
EXT: string;
N_DEZ: array [1..9] of string;
N_UDEZ: array [1..9] of string;
U,D: integer;
begin
N_DEZ[1] := 'dez';
N_DEZ[2] := 'vinte';
N_DEZ[3] := 'trinta';
N_DEZ[4] := 'quarenta';
N_DEZ[5] := 'cinquenta';
N_DEZ[6] := 'sessenta';
N_DEZ[7] := 'setenta';
N_DEZ[8] := 'oitenta';
N_DEZ[9] := 'noventa';
N_UDEZ[1] := 'onze';
N_UDEZ[2] := 'doze';
N_UDEZ[3] := 'treze';
N_UDEZ[4] := 'catorze';
N_UDEZ[5] := 'quinze';
N_UDEZ[6] := 'dezesseis';
N_UDEZ[7] := 'dezessete';
N_UDEZ[8] := 'dezoito';
N_UDEZ[9] := 'dezenove';
U := strtoint(copy(inttostr(NUM),2,1));
D := strtoint(copy(inttostr(NUM),1,1));
if (NUM > 10) and (NUM < 20) then
EXT := N_UDEZ[U]
else if copy(inttostr(NUM),2,1) = '0' then
EXT := N_DEZ[D]
else
EXT := N_DEZ[D] + ' e ' + UNI(U);
result := EXT;
end;
function TForm1.CEN(NUM: integer): string;
var
EXT: string;
N_CEN: array [1..9] of string;
C: integer;
DU: integer;
begin
N_CEN[1] := 'cento';
N_CEN[2] := 'duzentos';
N_CEN[3] := 'trezentos';
N_CEN[4] := 'quatrocentos';
N_CEN[5] := 'quinhentos';
N_CEN[6] := 'seiscentos';
N_CEN[7] := 'setecentos';
N_CEN[8] := 'oitocentos';
N_CEN[9] := 'novecentos';
C := strtoint(copy(inttostr(NUM),1,1));
DU := strtoint(copy(inttostr(NUM),2,2));
if NUM = 100 then
EXT := 'cem'
else if DU = 0 then
EXT := N_CEN[C]
else if DU < 10 then
EXT := N_CEN[C] + ' e ' + UNI(DU)
else
EXT := N_CEN[C] + ' e ' + DEZ(DU);
result := EXT;
end;
function TForm1.MIL(NUM: real): string;
var
EXT: string;
CDU: integer;
DU: integer;
MMM: integer;
begin
CDU := strtoint(copy(floattostr(NUM),length(floattostr(NUM))-2,3));
DU := strtoint(copy(floattostr(NUM),length(floattostr(NUM))-1,2));
if NUM < 10000 then
MMM := strtoint(copy(floattostr(NUM),1,1))
else if NUM < 100000 then
MMM := strtoint(copy(floattostr(NUM),1,2))
else
MMM := strtoint(copy(floattostr(NUM),1,3));
if MMM = 1 then
EXT := 'mil'
else if MMM < 10 then
EXT := UNI(MMM) + ' mil'
else if MMM < 100 then
EXT := DEZ(MMM) + ' mil'
else
EXT := CEN(MMM) + ' mil';
if CDU = 0 then
EXT := EXT
else if CDU < 10 then
EXT := EXT + ' e ' + UNI(CDU)
else if CDU < 100 then
EXT := EXT + ' e ' + DEZ(CDU)
else if DU = 0 then
EXT := EXT + ' e ' + CEN(CDU)
else
EXT := EXT + ' ' + CEN(CDU);
result := EXT;
end;
function TForm1.MILHARES(NUM: real; NIVEL: integer): string;
var
EXT: string;
CDU: integer;
MMM: integer;
MLH: array [1..4] of integer;
CLH: array [1..4] of real;
CLA: array [1..4] of array[1..2] of string;
I: integer;
begin
CDU := strtoint(copy(floattostr(NUM),length(floattostr(NUM))-2,3));
MMM := strtoint(copy(floattostr(NUM),length(floattostr(NUM))-5,3));
CLA[1,1] := ' milhão';
CLA[1,2] := ' milhões';
CLA[2,1] := ' bilhão';
CLA[2,2] := ' bilhões';
CLA[3,1] := ' trilhão';
CLA[3,2] := ' trilhões';
CLA[4,1] := ' quatrilhão';
CLA[4,2] := ' quatrilhões';
for I := 1 to NIVEL do
begin
if (NIVEL > 1) and (NIVEL <> I) then
begin
MLH[NIVEL-1] := strtoint(copy(floattostr(NUM),length(floattostr(NUM))-((3*NIVEL)+2),3));
CLH[NIVEL-1] := strtofloat(copy(floattostr(NUM),length(floattostr(NUM))-((3*NIVEL)-1),(3*(NIVEL+1))));
end;
CLH[NIVEL] := strtofloat(copy(floattostr(NUM),length(floattostr(NUM))-((3*NIVEL)+2),(3*(NIVEL+1))));
end;
if NUM < strtofloat('10' + stringofchar('0',3*(NIVEL+1))) then
MLH[NIVEL] := strtoint(copy(floattostr(NUM),1,1))
else if NUM < strtofloat('100' + stringofchar('0',3*(NIVEL+1))) then
MLH[NIVEL] := strtoint(copy(floattostr(NUM),1,2))
else
MLH[NIVEL] := strtoint(copy(floattostr(NUM),1,3));
if MLH[NIVEL] = 1 then
EXT := UNI(MLH[NIVEL]) + CLA[NIVEL,1]
else if MLH[NIVEL] < 10 then
EXT := UNI(MLH[NIVEL]) + CLA[NIVEL,2]
else if MLH[NIVEL] < 100 then
EXT := DEZ(MLH[NIVEL]) + CLA[NIVEL,2]
else
EXT := CEN(MLH[NIVEL]) + CLA[NIVEL,2];
if NIVEL = 1 then
begin
if CLH[NIVEL] = 0 then
EXT := EXT
else
if (CDU = 0) and (MMM > 0) then
begin
if MMM = 0 then
EXT := EXT
else
EXT := EXT + ' e ' + NUM_EXTENSO(CLH[1],'C')
end else
if (CDU > 0) and (MMM = 0) then
begin
if CDU = 0 then
EXT := EXT
else if CDU < 10 then
EXT := EXT + ' e ' + UNI(CDU)
else if CDU < 100 then
EXT := EXT + ' e ' + DEZ(CDU)
else if strtoint(copy(inttostr(CDU),2,2)) = 0 then
EXT := EXT + ' e ' + CEN(CDU)
else
EXT := EXT + ' ' + CEN(CDU);
end
else
EXT := EXT + ', ' + NUM_EXTENSO(CLH[1],'C');
end
else if NIVEL = 2 then
begin
if CLH[NIVEL] = 0 then
EXT := EXT
else
if (CDU = 0) and (MMM = 0) and (MLH[NIVEL-1] > 0) then
begin
if MLH[NIVEL-1] = 0 then
EXT := EXT
else
EXT := EXT + ' e ' + NUM_EXTENSO(CLH[NIVEL],'C')
end else
if (CDU = 0) and (MMM > 0) and (MLH[NIVEL-1] = 0) then
begin
if MMM = 0 then
EXT := EXT
else
EXT := EXT + ' e ' + NUM_EXTENSO(CLH[NIVEL-1],'C')
end else
if (CDU > 0) and (MMM = 0) and (MLH[NIVEL-1] = 0) then
begin
if CDU = 0 then
EXT := EXT
else if CDU < 10 then
EXT := EXT + ' e ' + UNI(CDU)
else if CDU < 100 then
EXT := EXT + ' e ' + DEZ(CDU)
else if strtoint(copy(inttostr(CDU),2,2)) = 0 then
EXT := EXT + ' e ' + CEN(CDU)
else
EXT := EXT + ' ' + CEN(CDU);
end
else
EXT := EXT + ', ' + NUM_EXTENSO(CLH[NIVEL],'C');
end
else if NIVEL = 3 then
begin
if CLH[NIVEL] = 0 then
EXT := EXT
else
if (CDU = 0) and (MMM = 0) and (MLH[NIVEL-2] = 0) and (MLH[NIVEL-1] > 0) then
begin
if MLH[NIVEL-1] = 0 then
EXT := EXT
else
EXT := EXT + ' e ' + NUM_EXTENSO(CLH[NIVEL],'C')
end else
if (CDU = 0) and (MMM = 0) and (MLH[NIVEL-2] > 0) and (MLH[NIVEL-1] = 0) then
begin
if MLH[NIVEL-1] = 0 then
EXT := EXT
else
EXT := EXT + ' e ' + NUM_EXTENSO(CLH[NIVEL],'C')
end else
if (CDU = 0) and (MMM > 0) and (MLH[NIVEL-2] = 0) and (MLH[NIVEL-1] = 0) then
begin
if MMM = 0 then
EXT := EXT
else
EXT := EXT + ' e ' + NUM_EXTENSO(CLH[NIVEL-1],'C')
end else
if (CDU > 0) and (MMM = 0) and (MLH[NIVEL-2] = 0) and (MLH[NIVEL-1] = 0) then
begin
if CDU = 0 then
EXT := EXT
else if CDU < 10 then
EXT := EXT + ' e ' + UNI(CDU)
else if CDU < 100 then
EXT := EXT + ' e ' + DEZ(CDU)
else if strtoint(copy(inttostr(CDU),2,2)) = 0 then
EXT := EXT + ' e ' + CEN(CDU)
else
EXT := EXT + ' ' + CEN(CDU);
end
else
EXT := EXT + ', ' + NUM_EXTENSO(CLH[NIVEL],'C');
end
else if NIVEL = 4 then
begin
if CLH[NIVEL] = 0 then
EXT := EXT
else
if (CDU = 0) and (MMM = 0) and (MLH[NIVEL-3] = 0) and (MLH[NIVEL-2] = 0) and (MLH[NIVEL-1] > 0) then
begin
if MLH[NIVEL-1] = 0 then
EXT := EXT
else
EXT := EXT + ' e ' + NUM_EXTENSO(CLH[NIVEL],'C')
end else
if (CDU = 0) and (MMM = 0) and (MLH[NIVEL-3] = 0) and (MLH[NIVEL-2] > 0) and (MLH[NIVEL-1] = 0) then
begin
if MLH[NIVEL-2] = 0 then
EXT := EXT
else
EXT := EXT + ' e ' + NUM_EXTENSO(CLH[NIVEL],'C')
end else
if (CDU = 0) and (MMM = 0) and (MLH[NIVEL-3] > 0) and (MLH[NIVEL-2] = 0) and (MLH[NIVEL-1] = 0) then
begin
if MLH[NIVEL-1] = 0 then
EXT := EXT
else
EXT := EXT + ' e ' + NUM_EXTENSO(CLH[NIVEL],'C')
end else
if (CDU = 0) and (MMM > 0) and (MLH[NIVEL-1] = 0) and (MLH[NIVEL-2] = 0) and (MLH[NIVEL-3] = 0) then
begin
if MMM = 0 then
EXT := EXT
else
EXT := EXT + ' e ' + NUM_EXTENSO(CLH[NIVEL],'C')
end else
if (CDU > 0) and (MMM = 0) and (MLH[NIVEL-3] = 0) and (MLH[NIVEL-2] = 0) and (MLH[NIVEL-1] = 0) then
begin
if CDU = 0 then
EXT := EXT
else if CDU < 10 then
EXT := EXT + ' e ' + UNI(CDU)
else if CDU < 100 then
EXT := EXT + ' e ' + DEZ(CDU)
else if strtoint(copy(inttostr(CDU),2,2)) = 0 then
EXT := EXT + ' e ' + CEN(CDU)
else
EXT := EXT + ' ' + CEN(CDU);
end
else
EXT := EXT + ', ' + NUM_EXTENSO(CLH[NIVEL],'C');
end;
result := EXT;
end;
function TForm1.ORD(NUM: real): string;
var
N_UNI: array [0..9] of string;
N_DEZ: array [0..9] of string;
N_CEN: array [0..9] of string;
N_MIL: array [1..4] of string;
EXT: string;
begin
N_UNI[0] := '';
N_UNI[1] := 'primeiro';
N_UNI[2] := 'segundo';
N_UNI[3] := 'terceiro';
N_UNI[4] := 'quarto';
N_UNI[5] := 'quinto';
N_UNI[6] := 'sexto';
N_UNI[7] := 'sétimo';
N_UNI[8] := 'oitavo';
N_UNI[9] := 'nono';
N_DEZ[0] := '';
N_DEZ[1] := 'décimo';
N_DEZ[2] := 'vigésimo';
N_DEZ[3] := 'trigésimo';
N_DEZ[4] := 'quadragésimo';
N_DEZ[5] := 'quinquagésimo';
N_DEZ[6] := 'sexagésimo';
N_DEZ[7] := 'septuagésimo';
N_DEZ[8] := 'octogésimo';
N_DEZ[9] := 'nonagésimo';
N_CEN[0] := '';
N_CEN[1] := 'centésimo';
N_CEN[2] := 'ducentésimo';
N_CEN[3] := 'trecentésimo';
N_CEN[4] := 'quadringentésimo';
N_CEN[5] := 'quingentésimo';
N_CEN[6] := 'sexcentésimo';
N_CEN[7] := 'septingentésimo';
N_CEN[8] := 'octingentésimo';
N_CEN[9] := 'nongentésimo';
N_MIL[1] := 'milésimo';
N_MIL[2] := 'milionésimo';
N_MIL[3] := 'bilionésimo';
N_MIL[4] := 'trilionésimo';
if NUM < 10 then
EXT := N_UNI[strtoint(floattostr(NUM))]
else if NUM < 100 then
EXT := N_DEZ[strtoint(copy(floattostr(NUM),1,1))] + ' ' + N_UNI[strtoint(copy(floattostr(NUM),2,1))]
else if NUM < 1000 then
EXT := N_CEN[strtoint(copy(floattostr(NUM),1,1))] + ' ' + N_DEZ[strtoint(copy(floattostr(NUM),2,1))] + ' ' + N_UNI[strtoint(copy(floattostr(NUM),3,1))]
else if NUM < power(10,6) then
begin
if strtoint(copy(stringofchar('0',3)+floattostr(NUM),length(stringofchar('0',3)+floattostr(NUM))-5,3)) <> 1 then
EXT := ORD(strtoint(copy(stringofchar('0',3)+floattostr(NUM),length(stringofchar('0',3)+floattostr(NUM))-5,3)));
EXT := EXT+' '+N_MIL[1]+' '+ORD(strtofloat(copy(stringofchar('0',3)+floattostr(NUM),length(stringofchar('0',3)+floattostr(NUM))-2,3)))
end
else if NUM < power(10,9) then
begin
if strtoint(copy(stringofchar('0',3)+floattostr(NUM),length(stringofchar('0',3)+floattostr(NUM))-8,3)) <> 1 then
EXT := ORD(strtoint(copy(stringofchar('0',3)+floattostr(NUM),length(stringofchar('0',3)+floattostr(NUM))-8,3)));
EXT := EXT+' '+N_MIL[2]+' '+ORD(strtofloat(copy(stringofchar('0',3)+floattostr(NUM),length(stringofchar('0',3)+floattostr(NUM))-5,6)));
end
else if NUM < power(10,12) then
begin
if strtoint(copy(stringofchar('0',3)+floattostr(NUM),length(stringofchar('0',3)+floattostr(NUM))-11,3)) <> 1 then
EXT := ORD(strtoint(copy(stringofchar('0',3)+floattostr(NUM),length(stringofchar('0',3)+floattostr(NUM))-11,3)));
EXT := EXT+' '+N_MIL[3]+' '+ORD(strtofloat(copy(stringofchar('0',3)+floattostr(NUM),length(stringofchar('0',3)+floattostr(NUM))-8,9)));
end
else if NUM < power(10,15) then
begin
if strtoint(copy(stringofchar('0',3)+floattostr(NUM),length(stringofchar('0',3)+floattostr(NUM))-14,3)) <> 1 then
EXT := ORD(strtoint(copy(stringofchar('0',3)+floattostr(NUM),length(stringofchar('0',3)+floattostr(NUM))-14,3)));
EXT := EXT+' '+N_MIL[4]+' '+ORD(strtofloat(copy(stringofchar('0',3)+floattostr(NUM),length(stringofchar('0',3)+floattostr(NUM))-11,12)));
end;
EXT := StringReplace(EXT, ' ', ' ',[rfIgnoreCase, rfReplaceAll]);
EXT := StringReplace(EXT, ' ', ' ',[rfIgnoreCase, rfReplaceAll]);
EXT := trimleft(trimright(EXT));
result := EXT;
end;
function TForm1.ROM(NUM: real): string;
var
N_UNI: array [0..9] of string;
N_DEZ: array [0..9] of string;
N_CEN: array [0..9] of string;
N_MIL: array [0..3] of string;
SIMBOL: array [1..7] of char;
I: integer;
EXT: string;
begin
SIMBOL[1] := 'I';
SIMBOL[2] := 'V';
SIMBOL[3] := 'X';
SIMBOL[4] := 'L';
SIMBOL[5] := 'C';
SIMBOL[6] := 'D';
SIMBOL[7] := 'M';
N_UNI[0] := '';
N_UNI[1] := SIMBOL[1];
N_UNI[2] := stringofchar(SIMBOL[1],2);
N_UNI[3] := stringofchar(SIMBOL[1],3);
N_UNI[4] := SIMBOL[1]+SIMBOL[2];
N_UNI[5] := SIMBOL[2];
N_UNI[6] := SIMBOL[2]+SIMBOL[1];
N_UNI[7] := SIMBOL[2]+stringofchar(SIMBOL[1],2);
N_UNI[8] := SIMBOL[2]+stringofchar(SIMBOL[1],3);
N_UNI[9] := SIMBOL[1]+SIMBOL[3];
N_DEZ[0] := '';
N_DEZ[1] := SIMBOL[3];
N_DEZ[2] := stringofchar(SIMBOL[3],2);
N_DEZ[3] := stringofchar(SIMBOL[3],3);
N_DEZ[4] := SIMBOL[3]+SIMBOL[4];
N_DEZ[5] := SIMBOL[4];
N_DEZ[6] := SIMBOL[4]+SIMBOL[3];
N_DEZ[7] := SIMBOL[4]+stringofchar(SIMBOL[3],2);
N_DEZ[8] := SIMBOL[4]+stringofchar(SIMBOL[3],3);
N_DEZ[9] := SIMBOL[3]+SIMBOL[5];
N_CEN[0] := '';
N_CEN[1] := SIMBOL[5];
N_CEN[2] := stringofchar(SIMBOL[5],2);
N_CEN[3] := stringofchar(SIMBOL[5],3);
N_CEN[4] := SIMBOL[5]+SIMBOL[6];
N_CEN[5] := SIMBOL[6];
N_CEN[6] := SIMBOL[6]+SIMBOL[5];
N_CEN[7] := SIMBOL[6]+stringofchar(SIMBOL[5],2);
N_CEN[8] := SIMBOL[6]+stringofchar(SIMBOL[5],3);
N_CEN[9] := SIMBOL[5]+SIMBOL[7];
N_MIL[0] := '';
N_MIL[1] := SIMBOL[7];
N_MIL[2] := stringofchar(SIMBOL[7],2);
N_MIL[3] := stringofchar(SIMBOL[7],3);
EXT := '';
for I := 1 to length(floattostr(NUM)) do
begin
case I of
1:EXT := N_UNI[strtoint(copy(floattostr(NUM),length(floattostr(NUM)),1))] + EXT;
2:EXT := N_DEZ[strtoint(copy(floattostr(NUM),length(floattostr(NUM))-1,1))] + EXT;
3:EXT := N_CEN[strtoint(copy(floattostr(NUM),length(floattostr(NUM))-2,1))] + EXT;
4:EXT := N_MIL[strtoint(copy(floattostr(NUM),length(floattostr(NUM))-3,1))] + EXT;
end;
end;
result := EXT;
end;
function TForm1.ROMANO_CARDINAL(NUM: string): string;
var
I: integer;
begin
if trim(NUM) = '' then
begin
result := '0';
exit;
end;
for I := 1 to 3999 do
begin
if trim(NUM) = NUM_EXTENSO(I,'R') then
begin
result := inttostr(I);
exit;
end;
end;
result := trim(NUM) + ' não é um número romano válido !';
end;
function TForm1.CARDINAL_ROMANO(NUM: real): string;
begin
result := NUM_EXTENSO(NUM,'R');
end;
Pronto. Para testar, coloque as funções acima mencionadas.
Exemplo de utilização:
Edit1.text := NUM_EXTENSO(458,'C')
|
|
 Comentários | |
| | Comentários pertencem aos seus respectivos autores. Não somos responsáveis pelo seus conteúdos. |
|
|
Edição 112 |
|
|
50 Programas Fontes |
|
|
Produtos |
|
|
