Jump to content
Fórum Script Brasil
  • 0

[resolvido]data Extenso


Eder
 Share

Question

Ola..pessoal...tou montando este codigo pra mostrar a data por extenso ...igual se mostra em Promissória.

assim:

procedure TForm1.Edit3Enter(Sender: TObject);
Var
DataVencimento : TDateTime;
begin
DataVencimento:=StrToDateTime(maskedit5.text);
Edit3.Text := 'Aos ' + FormatDateTime('dd "dias do mês de " mmmm "do ano de " yyyy',DataVencimento);  //converte para exenso 
end;
o resultado ta saindo assim:
Aos 01 dias do mês de janeiro do ano de 2008
Não sei ao certo, gostaria de uma dica.....mas acho que deveria sair assim:
Ao(s) primeiro dia do mês de Janeiro do ano de dois mil e oito

Alguém poderia me dar uma dica e o que eu alteraria no codigo??

Obs.: teria que ser algo que não precisasse da DATEUTILS..pois meu delphi é 4 e não tem ela.

Grato

Edited by Eder
Link to comment
Share on other sites

5 answers to this question

Recommended Posts

  • 0
Guest --Jonas --

O Delphi permite formatar datas para apresentação por extenso de forma bastante simples. Vejamos os seguintes exemplos:

Para formatar a data 13/08/2007, podemos utilizar:

No create do form colocar

Shortdateformat:=

dddd, dd/mm/yyyy = Quinta, 13/08/2007

dd/mmm/yyyy = 13/Ago/2007

dddd, dd" de "mmmm" de "yyyy = Segunda, 13 de Agosto de 2007

dd" de "mmmm" de "yyyy, dddd = 13 de Agosto de 2007, Segunda

Link to comment
Share on other sites

  • 0

Ola..Jonas...Bza?

carinha ...isto tou sabendo beleza...

Mas o que eu queria e não to conseguindo fazer é como este exemplo abaixo:

01/01/2008

Ao(s) primeiro dia do mês de Janeiro do ano de dois mil e oito

Entendeu??

terias algum exemplo como mostro acima??

Grato

Link to comment
Share on other sites

  • 0
Mas o que eu queria e não to conseguindo fazer é como este exemplo abaixo:

01/01/2008

Ao(s) primeiro dia do mês de Janeiro do ano de dois mil e oito

Eder, acredito que você poderia fazer uma combinação de uso das funções de data com uma função para conversão de número para extenso (você encontra várias na net ,se bem que a maioria é bem mais complexa do que você precisa...).

Você teria apenas que ver essa questão da parte inicial do texto, quando deverá aparecer "primeiro", "segundo"... "décimo quinto" - será sempre neste linha?

Link to comment
Share on other sites

  • 0
Guest --Jonas --

Vou te dar mastigadinho ....rs

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Mask, ToolEdit;

type
  TForm1 = class(TForm)
    DateEdit1: TDateEdit;
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Centavos, Centena, Milhar, Milhao, Texto, msg: string;
  end;

var
  Form1: TForm1;

const
  dias: array[1..9] of Pchar = ('Primeiro', 'Segundo', 'Terceiro', 'Quarto', 'Quinto', 'Sexto', 'Setimo', 'Oitavo', 'Nono');
     // completar para os demais dias do mês

implementation

{$R *.DFM}

function extenso (valor: real): string;
var
Centavos, Centena, Milhar, Milhao, Texto, msg: string;
const
Unidades: array[1..9] of string = ('Um', 'Dois', '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');


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:=Unidades[strtoint(trio[3])];
    end;


  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('000000.00',valor);
  Milhar:=MiniExtenso(Copy(Texto,1,3));
  Centena:=MiniExtenso(Copy(Texto,4,3));
  Result:=Milhar;

  if Milhar<>'' then
  if copy(texto,4,3)='000' then
    Result:=Result+' mil'
  else
    Result:=Result+' mil ';

  if (((copy(texto,4,2)='00') and (Milhar<>'')
    and (copy(texto,6,1)<>'0')) or (centavos=''))
    and (Centena<>'') then Result:=Result+' e ';
  if (Milhar+Centena <>'') then Result:=Result+Centena;
  if (Milhar='') and (copy(texto,4,3)='001') then
    Result:=Result+' '
  else
    if (copy(texto,4,3)<>'000') then Result:=Result+' ';

end;



procedure TForm1.Button1Click(Sender: TObject);
var
   Present: TDateTime;
   Year, Month, Day, Hour, Min, Sec, MSec: Word;
   mês : string;
   begin
      Present:= DateEdit1.Date;
      DecodeDate(Present, Year, Month, Day);
      case Month of
         1: mês := ' de Janeiro de ';
         2: mês := ' de Fevereiro de ';
         3: mês := ' de Março de ';
         4: mês := ' de Abril de ';
         5: mês := ' de Maio de ';
         6: mês := ' de Junho de ';
         7: mês := ' de Julho de ';
         8: mês := ' de Agosto de ';
         9: mês := ' de Setembro de ';
         10: mês := ' de Outubro de ';
         11: mês := ' de Novembro de ';
         12: mês := ' de Dezembro de ';
   end;

   Label1.Caption := 'Ao ' + dias[day] + ' dia do mês'  + mês + extenso(Year);

end;

end.

Link to comment
Share on other sites

  • 0
Você teria apenas que ver essa questão da parte inicial do texto, quando deverá aparecer "primeiro", "segundo"... "décimo quinto" - será sempre neste linha?

Resposta p/ Micheus: sim...vou pegar o exemplo do Jonas e dar uma estudada, parece que nele tem tudo o que preciso..

Valeu Jonas...qualquer coisa eu peço ajuda aos colegas..

Grato a atenção Micheus e Jonas.

Abraço

:)

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

 Share



  • Forum Statistics

    • Total Topics
      150.2k
    • Total Posts
      647.4k
×
×
  • Create New...