Buscar por:

Extenso em dll, com parâmetros adicionais

Código

{

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.