rdprinter

function Extenso(Valor: Extended; Documento, Monetario: Boolean): string;
var
  Centavos, Centena, Milhar, Milhao, Bilhao, Texto: string;
  X: Byte;
const
  Unidades: array[1..9] of string[10] = (´um´, ´dois´, ´três´, ´quatro´,
    ´cinco´, ´seis´, ´sete´, ´oito´, ´nove´);
  Dez: array[1..9] of string[12] = (´onze´, ´doze´, ´treze´,
    ´quatorze´, ´quinze´, ´dezesseis´, ´dezessete´, ´dezoito´, ´dezenove´);
  Dezenas: array[1..9] of string[12] = (´dez´, ´vinte´, ´trinta´,
    ´quarenta´, ´cinquenta´, ´sessenta´, ´setenta´, ´oitenta´, ´noventa´);
  Centenas: array[1..9] of string[20] = (´cento´, ´duzentos´,
    ´trezentos´, ´quatrocentos´, ´quinhentos´, ´seiscentos´, ´setecentos´,
    ´oitocentos´, ´novecentos´);
  function Ifs(Expressao: Boolean; CasoVerdadeiro, CasoFalso: string): string;
  begin
    if Expressao then
      Result := CasoVerdadeiro
    else
      Result := CasoFalso;
  end;
  function MiniExtenso(Valor: string): string;
  var
    Unidade, Dezena, Centena: string;
  begin
    Unidade := ´´;
    Dezena := ´´;
    Centena := ´´;
    if (Valor[2] = ´1´) and (Valor[3] <> ´0´) then
    begin
      Unidade := Dez[StrToInt(Valor[3])];
      Dezena := ´´;
    end
    else
    begin
      if Valor[2] <> ´0´ then
        Dezena := Dezenas[StrToInt(Valor[2])];
      if Valor[3] <> ´0´ then
        Unidade := Unidades[StrToInt(Valor[3])];
    end;
    if (Valor[1] = ´1´) and (Unidade = ´´) and (Dezena = ´´) then
      Centena := ´cem´
    else if Valor[1] <> ´0´ then
      Centena := Centenas[StrToInt(Valor[1])]
    else
      Centena := ´´;
    Result := Centena +
      Ifs((Centena <> ´´) and ((Dezena <> ´´) or (Unidade <> ´´)), ´ e ´, ´´) +
      Dezena +
      Ifs((Dezena <> ´´) and (Unidade <> ´´), ´ e ´, ´´) + Unidade;
  end;

begin
  if Valor = 0 then
  begin
    Result := ´´;
    Exit;
  end;
  Texto := FormatFloat(´000000000000.00´, Valor);
  Centavos := MiniExtenso(´0´ + Copy(Texto, 14, 2));
  Centena := MiniExtenso(Copy(Texto, 10, 3));
  Milhar := MiniExtenso(Copy(Texto, 7, 3));
  if Milhar <> ´´ then
    Milhar := Milhar + ´ mil´;
  Milhao := MiniExtenso(Copy(Texto, 4, 3));
  if Milhao <> ´´ then
    Milhao := Milhao + ifs(Copy(Texto, 4, 3) = ´001´, ´ milhão´, ´ milhões´);
  Bilhao := MiniExtenso(Copy(Texto, 1, 3));
  if Bilhao <> ´´ then
    Bilhao := Bilhao + ifs(Copy(Texto, 1, 3) = ´001´, ´ bilhão´, ´ milhões´);
  if Monetario then
  begin
    if (Bilhao <> ´´) and (Milhao + Milhar + Centena = ´´) then
      Result := Bilhao + ´ de Reais ´
    else if (Milhao <> ´´) and (Milhar + Centena = ´´) then
      Result := Milhao + ´ de Reais ´
    else
      Result := Bilhao +
        ifs((Bilhao <> ´´) and (Milhao + Milhar + Centena <> ´´),
        ifs((Pos(´ e ´, Bilhao) > 0) or (Pos(´ e ´, Milhao + Milhar + Centena) >
        0), ´, ´, ´ e ´), ´´) +
        Milhao +
        ifs((Milhao <> ´´) and (Milhar + Centena <> ´´), ifs((Pos(´ e ´, Milhao)
        > 0) or
        (Pos(´ e ´, Milhar + Centena) > 0), ´, ´, ´ e ´), ´´) +
        Milhar + ifs((Milhar <> ´´) and (Centena <> ´´), ifs(Pos(´ e ´, Centena)
        > 0, ´, ´, ´ e ´), ´´) +
        Centena +
        ifs(Int(Valor) = 0, ´´, (ifs(Int(Valor) = 1, ´ Real ´, ´ Reais ´)));
    if (Result <> ´´) and (Centavos <> ´´) then
      Result := Result + ´ e ´
    else
      Result := Result;
    if Centavos <> ´´ then
      Result := Result + Centavos +
        ifs(Copy(Texto, 14, 2) = ´01´, ´ Centavo ´, ´ Centavos ´);
    if Documento then
      for X := 1 to 250 do
        Result := Result + ´*´;
  end
  else
  begin
    Result := Bilhao +
      ifs((Bilhao <> ´´) and (Milhao + Milhar + Centena <> ´´),
      ifs((Pos(´ e ´, Bilhao) > 0) or (Pos(´ e ´, Milhao + Milhar + Centena) >
      0), ´, ´, ´ e ´), ´´) +
      Milhao +
      ifs((Milhao <> ´´) and (Milhar + Centena <> ´´), ifs((Pos(´ e ´, Milhao) >
      0) or
      (Pos(´ e ´, Milhar + Centena) > 0), ´, ´, ´ e ´), ´´) +
      Milhar + ifs((Milhar <> ´´) and (Centena <> ´´), ifs(Pos(´ e ´, Centena) >
      0, ´, ´, ´ e ´), ´´) +
      Centena;
    if Centavos <> ´´ then
      Result := Result + ´ e ´ + Centavos;
  end;
end;