Delphi dicas

Extenso em dll, com parâmetros adicionais

{

Para chamar a função, dentro da área de declaração da unit chamadora, utilize :



function Extenso(Valor: Real; MF: string; Moeda: Boolean): string; external 'Extensos.dll';



e Crie uma DLL no Delphi com o código a seguir, após devidamente compilada, retornará ao programa chamador numerais em extenso, com a opção de Masculino e Feminino (um, uma, dois, duas) através da variável MF com os valores "M" ou "F", e da opção de retornar Moeda ou Não, através da variável de mesmo nome com os valores True ou False. A manutenção desta opção é fácil pois o nome da moeda está contido na matrizes "Cifra" e "Cents" declaradas no início da DLL.

A DLL está corrigida dos surgimentos da letra "e" quando o numero for menor que mil, além de apresentar correta concordância da apresentação. Aceita expressões numéricas positivas menores que um milhão!

Bom Trabalho

}



library Extensos;



uses

SysUtils,

Classes;



{$R *.RES}



function Extenso(Valor: Real; MF: string; Moeda: Boolean): string;

const

UnidadesM: array[1..9] of string = ('UM', 'DOIS', 'TRES', 'QUATRO', 'CINCO', 'SEIS', 'SETE', 'OITO', 'NOVE');

UnidadesF: array[1..9] of string = ('UMA', 'DUAS', 'TRES', 'QUATRO', 'CINCO', 'SEIS', 'SETE', 'OITO', 'NOVE');

Dez: array[1..9] of string = ('ONZE', 'DOZE', 'TREZE', 'QUATORZE', 'QUINZE', 'DEZESSEIS', 'DEZESSETE',

'DEZOITO', 'DEZENOVE');

Dezenas: array[1..9] of string = ('DEZ', 'VINTE', 'TRINTA', 'QUARENTA', 'CINQUENTA', 'SESSENTA', 'SETENTA',

'OITENTA', 'NOVENTA');

Centenas: array[1..9] of string = ('CENTO', 'DUZENTOS', 'TREZENTOS', 'QUATROCENTOS', 'QUINHENTOS', 'SEISCENTOS',

'SETECENTOS', 'OITOCENTOS', 'NOVECENTOS');

Cifra: array[1..2] of string = (' REAL', ' REAIS');

Cents: array[1..2] of string = (' CENTAVO', ' CENTAVOS');

Zero = 'Zero';

var

Texto, Milhar, Centena, Centavos: string;



function Ifs(Expressao: Boolean; CasoVerdadeiro, CasoFalso: String): String;

begin

        if Expressao then

        Result :=	CasoVerdadeiro

        else

        Result := CasoFalso;

end;



function MiniExtenso(trio: string): string;

var

Unidade, Dezena, Centena: string;

begin

        Unidade := '';

        Dezena := '';

        Centena := '';

        if (trio[2] = '1') and (trio[3] <> '0') then begin

                Unidade := Dez[StrToInt(trio[3])];

                Dezena := ''; end

        else begin

                if trio[2] <> '0' then Dezena := Dezenas[StrToInt(trio[2])];

                if trio[3] <> '0' then Unidade := Ifs(MF = 'M', UnidadesM[StrToInt(trio[3])], UnidadesF[StrToInt(trio[3])]);

        end;

        if (trio[1] = '1') and (Unidade = '') and (Dezena = '') then

        Centena := 'CEM'

        else

        if trio[1] <> '0' then

        Centena := Centenas[StrToInt(trio[1])]

        else

        Centena := '';

        Result := Centena + Ifs((Centena <> '') and ((Dezena <> '') or (Unidade <> '')), ' E ', '') +

        Dezena + Ifs(( Dezena <> '') and (Unidade<> '' ),' E ', '') + Unidade;

end;



begin

        if (valor > 999999.99) or (valor < 0) then begin

                Result := 'O número deve ser maior ou igual a zero e menor que 999.999,99.';

                Exit;

        end;

        if valor = 0 then begin

                Result := Zero;

                Exit;

        end;

        Result := '';

        Texto := FormatFloat('000000.00', Valor);

        Milhar := MiniExtenso(Copy(Texto, 1, 3));

        Centena := MiniExtenso(Copy(Texto, 4, 3));

        Centavos := MiniExtenso('0' + Copy(Texto, 8, 2));

        if Milhar <> '' then Result := Milhar + ' MIL';

        if Centena <> '' then begin

                if (Copy(Texto, 4, 1) = '0') and (Milhar <> '') then Result := Result + ' E '

                else if Milhar <> '' then Result := Result + ', ';

                Result := Result + Centena;

        end;

        if Moeda = True then if Length(Result) = 2 then Result := Result + Cifra[1]

        else if Result <> '' then Result := Result + Cifra[2];

        if Centavos <> '' then begin

                if Result <> '' then  Result := Result + ' E ' + Centavos else Result := Centavos;

                if Moeda = True then if Length(Centavos) = 2 then Result := Result + Cents[1] else Result := Result + Cents[2];

        end;

end;



exports

Extenso;



begin

end.