Ir para conteúdo
Fórum Script Brasil
  • 0

(Resolvido) Implementar código no OnExit do componente

robinhocne

Perguntado por robinhocne,

 Share

Pergunta

robinhocne

robinhocne

Postado
Postado (editado)

Pessoal eu tenho esse componente abaixo que criei do TDateEdit do RxLib, só para implementar a cor, agora estava querendo

implementar no Evento onExit dele o preenchimento de data Automatica....atualmente eu faço assim no OnExit no componente quando está no form:

procedure TFrmConsultaVenda.TxtDtIniExit(Sender: TObject);
var
  CarDt : Integer;
  Data  : String;
begin

  if TxtDtIni.Text <> '  /  /    ' then
    begin

      Data  := Trim(TiraMascara(TxtDtIni.Text));
      CarDt := Length(Data);
      if Length(Trim(TiraMascara(TxtDtIni.Text))) = 2 then
        begin
          Data := Data + FormatDateTime('/mm/yyyy',Date);
          TxtDtIni.Text := Data;
        end
        else
      if Length(Trim(TiraMascara(TxtDtIni.Text))) = 4 then
        begin
          Data := Data + FormatDateTime('/yyyy',Date);
          TxtDtIni.Text := Data;
        end;

    end;

end;
Abaixo o componente que criei. 
unit Data;

interface

uses
  SysUtils, Classes, Controls, StdCtrls, Mask, ToolEdit,  Graphics, Messages;

type
  TData = class(TDateEdit)
  private
    OnEnterColor: TColor;
    OnExitColor: TColor;
    procedure ExportaColor(const Value: TColor);
    procedure ImportaColor(const Value: TColor);

  protected
    procedure ColocaCor(Sender: TObject);
    procedure RetiraCor(Sender: TObject);
    procedure ImportaCor(Value: TColor);
    procedure ExportaCor(Value: TColor);
  public
    constructor Create(Aowner: TComponent); override;
    procedure CMEnter(var Msg: TMessage); message CM_ENTER;
    procedure CMExit(var Msg: TMessage); message CM_EXIT;        
  published
    property CorOnEnter: TColor read OnEnterColor write ImportaColor;
    property CorOnExit: TColor read OnExitColor write ExportaColor;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('CompsProprios', [TData]);
end;

{ TData }

procedure TData.CMEnter(var Msg: TMessage);
begin
  ColocaCor(Self);
  inherited
end;

procedure TData.CMExit(var Msg: TMessage);
begin
  RetiraCor(Self);
  inherited
end;

procedure TData.ColocaCor(Sender: TObject);
begin
  if Sender is TDateEdit then
    TDateEdit(Sender).Color := OnEnterColor;
end;

constructor TData.Create(Aowner: TComponent);
begin
  inherited;
  OnEnterColor := clSkyBlue;
  OnExitColor  := clWindow;
  OnEnter      := ColocaCor;
  OnExit       := RetiraCor;
end;

procedure TData.ExportaColor(const Value: TColor);
begin

end;

procedure TData.ExportaCor(Value: TColor);
begin
  OnExitColor := Value;
end;

procedure TData.ImportaColor(const Value: TColor);
begin

end;

procedure TData.ImportaCor(Value: TColor);
begin
  OnEnterColor := Value;
end;

procedure TData.RetiraCor(Sender: TObject);
begin
   if Sender is TDateEdit then
    TDateEdit(Sender).Color := OnExitColor;
end;

end.

Editado por robinhocne
Link para o comentário
Compartilhar em outros sites

9 respostass a esta questão

Posts Recomendados

  • 0
robinhocne

robinhocne

Postado
  • Autor
Postado
tem sim... veja o ultimo codigo desse link

http://www.activedelphi.com.br/forum/viewt...638f95f4222ef2d

faça uma analogia e aplique ao seu codigo

abraço

opa valeu Jhonas tá quase....consegui fazer tudo...conforme abaixo:

unit Data;

interface

uses
  SysUtils, Classes, Controls, StdCtrls, Mask, ToolEdit,  Graphics, Messages, DateUtils;

type
  TData = class(TDateEdit)
  private
    OnEnterColor: TColor;
    OnExitColor: TColor;
    procedure ExportaColor(const Value: TColor);
    procedure ImportaColor(const Value: TColor);

  protected
    procedure ColocaCor(Sender: TObject);
    procedure RetiraCor(Sender: TObject);
    procedure ImportaCor(Value: TColor);
    procedure ExportaCor(Value: TColor);
    procedure CompletaData(TData: TDateEdit);
    Function TiraMascara (Valor : String) : String;
  public
    constructor Create(Aowner: TComponent); override;
    procedure CMEnter(var Msg: TMessage); message CM_ENTER;
    procedure CMExit(var Msg: TMessage); message CM_EXIT;
  published
    property CorOnEnter: TColor read OnEnterColor write ImportaColor;
    property CorOnExit: TColor read OnExitColor write ExportaColor;
  end;

procedure Register;

implementation



procedure Register;
begin
  RegisterComponents('Innovation', [TData]);
end;

{ TData }

procedure TData.CMEnter(var Msg: TMessage);
begin
  ColocaCor(Self);
  inherited
end;

procedure TData.CMExit(var Msg: TMessage);
begin
  RetiraCor(Self);
  CompletaData(Self);
  inherited
end;

procedure TData.ColocaCor(Sender: TObject);
begin
  if Sender is TDateEdit then
    TDateEdit(Sender).Color := OnEnterColor;
end;

procedure TData.CompletaData(TData: TDateEdit);
var
   Dt, CarcDt : String;
//   CarcDt : Integer;
begin

  Dt := '';
  
  if TData.Text <> '  /  /    ' then
    begin
      Dt  := Trim(TiraMascara(TData.Text));
      CarcDt := IntToStr(Length(Dt));
      if CarcDt = '2' then
        begin
          Dt:= Dt+ FormatDateTime('/mm/yyyy',Date);
          TData.Text := Dt;
        end
        else
      if CarcDt = '4' then
        begin
          Dt:= copy(Dt,1,2) + '/' + copy(Dt,3,2) + FormatDateTime('/yyyy',Date);
          TData.Text := Dt;
        end;

    end;
end;

constructor TData.Create(Aowner: TComponent);
begin
  inherited;
  OnEnterColor := clSkyBlue;
  OnExitColor  := clWindow;
  OnEnter      := ColocaCor;
  OnExit       := RetiraCor;
end;

procedure TData.ExportaColor(const Value: TColor);
begin

end;

procedure TData.ExportaCor(Value: TColor);
begin
  OnExitColor := Value;
end;

procedure TData.ImportaColor(const Value: TColor);
begin

end;

procedure TData.ImportaCor(Value: TColor);
begin
  OnEnterColor := Value;
end;

procedure TData.RetiraCor(Sender: TObject);
begin
   if Sender is TDateEdit then
    TDateEdit(Sender).Color := OnExitColor;
end;

function TData.TiraMascara(Valor: String): String;
Var NovoValor : String; i : Integer;
begin
   NovoValor := '';
   For i := 1 To Length (Valor) Do
      begin
         If ((Valor [i] = '.') Or (Valor [i] = ',') Or (Valor [i] = '-') Or (Valor [i] = '/') Or (Valor [i] = '(') Or (Valor [i] = ')') ) Then Continue;
         NovoValor := NovoValor + Valor [i];
      end;
   Result := NovoValor;
end;

end.
mas quando eu informo por exemplo dia 11 ao sair data ele deveria preencher com o mes e ano corrente no caso ficaria assim : 11/04/2012, mas ao passar no Date não está pegando a data atual: 
procedure TData.CompletaData(TData: TDateEdit);
var
   Dt, CarcDt : String;
begin

  Dt := '';
  
  if TData.Text <> '  /  /    ' then
    begin
      Dt  := Trim(TiraMascara(TData.Text));
      CarcDt := IntToStr(Length(Dt));
      if CarcDt = '2' then
        begin
          Dt:= Dt+ FormatDateTime('/mm/yyyy',Date); //pega o mes e ano da data atual
          TData.Text := Dt;
        end
        else
      if CarcDt = '4' then
        begin
          Dt:= copy(Dt,1,2) + '/' + copy(Dt,3,2) + FormatDateTime('/yyyy',Date);//pega o ano da data atual
          TData.Text := Dt;
        end;

    end;
end;

Quando passa aqui

Dt:= Dt+ FormatDateTime('/mm/yyyy',Date); <<<<<

No Date está vindo 0, ai acaba jogando a data assim : 11/12/1899

o que poder ser ?

Link para o comentário
Compartilhar em outros sites
  • 0
Jhonas

Jhonas

Postado
Postado 

No Date está vindo 0, ai acaba jogando a data assim : 11/12/1899

o que poder ser ?
OBS: a data de 1899 ocorre quando nenhuma data foi atribuida a variavel veja esse exemplo com o seu codigo 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    function TiraMascara(Valor: String): String;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.TiraMascara(Valor: String): String;
Var NovoValor : String; i : Integer;
begin
   NovoValor := '';
   For i := 1 To Length (Valor) Do
      begin
         If ((Valor [i] = '.') Or (Valor [i] = ',') Or (Valor [i] = '-') Or (Valor [i] = '/') Or (Valor [i] = '(') Or (Valor [i] = ')') ) Then Continue;
         NovoValor := NovoValor + Valor [i];
      end;
   Result := NovoValor;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
   Dt, CarcDt : String;
begin

  Dt := '';

  if Edit1.Text <> '  /  /    ' then
    begin
      Dt  := Trim(TiraMascara(Edit1.Text));
      CarcDt := IntToStr(Length(Dt));
      if CarcDt = '2' then
        begin
          Dt:= Dt+ FormatDateTime('/mm/yyyy',Date); //pega o mes e ano da data atual
          Edit1.Text := Dt;
        end
        else
      if CarcDt = '4' then
        begin
          Dt:= copy(Dt,1,2) + '/' + copy(Dt,3,2) + FormatDateTime('/yyyy',Date);//pega o ano da data atual
          Edit1.Text := Dt;
        end;

    end;


end;

end.

OBS: veja que a data é complementada por estar usando um Edit

no caso de um campo data, acho que voce deve fazer o tratamento para data e não para string

if TData.Text <> ' / / ' then

abraço

Link para o comentário
Compartilhar em outros sites
  • 0
robinhocne

robinhocne

Postado
  • Autor
Postado 
No Date está vindo 0, ai acaba jogando a data assim : 11/12/1899

o que poder ser ?
OBS: a data de 1899 ocorre quando nenhuma data foi atribuida a variavel veja esse exemplo com o seu codigo 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    function TiraMascara(Valor: String): String;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.TiraMascara(Valor: String): String;
Var NovoValor : String; i : Integer;
begin
   NovoValor := '';
   For i := 1 To Length (Valor) Do
      begin
         If ((Valor [i] = '.') Or (Valor [i] = ',') Or (Valor [i] = '-') Or (Valor [i] = '/') Or (Valor [i] = '(') Or (Valor [i] = ')') ) Then Continue;
         NovoValor := NovoValor + Valor [i];
      end;
   Result := NovoValor;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
   Dt, CarcDt : String;
begin

  Dt := '';

  if Edit1.Text <> '  /  /    ' then
    begin
      Dt  := Trim(TiraMascara(Edit1.Text));
      CarcDt := IntToStr(Length(Dt));
      if CarcDt = '2' then
        begin
          Dt:= Dt+ FormatDateTime('/mm/yyyy',Date); //pega o mes e ano da data atual
          Edit1.Text := Dt;
        end
        else
      if CarcDt = '4' then
        begin
          Dt:= copy(Dt,1,2) + '/' + copy(Dt,3,2) + FormatDateTime('/yyyy',Date);//pega o ano da data atual
          Edit1.Text := Dt;
        end;

    end;


end;

end.

OBS: veja que a data é complementada por estar usando um Edit

no caso de um campo data, acho que voce deve fazer o tratamento para data e não para string

if TData.Text <> ' / / ' then

abraço

mas porque o Date não recebe a data atual ?

Link para o comentário
Compartilhar em outros sites
  • 0
Jhonas

Jhonas

Postado
Postado

Amigo, achei que voce tinha entendido a dica ....

veja a correção do seu componente

unit UDataCompl;

interface

uses
  SysUtils, Classes, Controls, StdCtrls, Mask, ToolEdit,  Graphics, Messages, DateUtils;

type
  TData = class(TDateEdit)
  private
    OnEnterColor: TColor;
    OnExitColor: TColor;
    procedure ExportaColor(const Value: TColor);
    procedure ImportaColor(const Value: TColor);

  protected
    procedure ColocaCor(Sender: TObject);
    procedure RetiraCor(Sender: TObject);
    procedure ImportaCor(Value: TColor);
    procedure ExportaCor(Value: TColor);
    procedure CompletaData(TData: TDateEdit);
    Function TiraMascara (Valor : String) : String;
  public
    constructor Create(Aowner: TComponent); override;
    procedure CMEnter(var Msg: TMessage); message CM_ENTER;
    procedure CMExit(var Msg: TMessage); message CM_EXIT;
  published
    property CorOnEnter: TColor read OnEnterColor write ImportaColor;
    property CorOnExit: TColor read OnExitColor write ExportaColor;
  end;

procedure Register;

implementation



procedure Register;
begin
  RegisterComponents('Innovation', [TData]);
end;

{ TData }

procedure TData.CMEnter(var Msg: TMessage);
begin
  ColocaCor(Self);
  inherited
end;

procedure TData.CMExit(var Msg: TMessage);
begin
  RetiraCor(Self);
  CompletaData(Self);
  inherited
end;

procedure TData.ColocaCor(Sender: TObject);
begin
  if Sender is TDateEdit then
    TDateEdit(Sender).Color := OnEnterColor;
end;

procedure TData.CompletaData(TData: TDateEdit);
var
   Dt, CarcDt : String;
//   CarcDt : Integer;
begin

   Dt := '';

   Dt  := Trim(TiraMascara(TData.Text));
   CarcDt := IntToStr(Length(Dt));
   if CarcDt = '0' then
     begin
       Dt:= Dt+ FormatDateTime('dd/mm/yyyy',Now);
       TData.Text := Dt;
     end;
   if CarcDt = '2' then
     begin
       Dt:= copy(Dt,1,2) + FormatDateTime('/mm/yyyy',Now);
       TData.Text := Dt;
     end;
   if CarcDt = '4' then
     begin
       Dt:= copy(Dt,1,2) + '/' + copy(Dt,3,2) + FormatDateTime('/yyyy',Now);
       TData.Text := Dt;
     end;

end;

constructor TData.Create(Aowner: TComponent);
begin
  inherited;
  OnEnterColor := clSkyBlue;
  OnExitColor  := clWindow;
  OnEnter      := ColocaCor;
  OnExit       := RetiraCor;
end;

procedure TData.ExportaColor(const Value: TColor);
begin

end;

procedure TData.ExportaCor(Value: TColor);
begin
  OnExitColor := Value;
end;

procedure TData.ImportaColor(const Value: TColor);
begin

end;

procedure TData.ImportaCor(Value: TColor);
begin
  OnEnterColor := Value;
end;

procedure TData.RetiraCor(Sender: TObject);
begin
   if Sender is TDateEdit then
    TDateEdit(Sender).Color := OnExitColor;
end;

function TData.TiraMascara(Valor: String): String;
Var NovoValor : String; i : Integer;
begin
   NovoValor := '';
   For i := 1 To Length (Valor) Do
      begin
         If ((Valor [i] = '.') Or (Valor [i] = ',') Or (Valor [i] = '-') Or (Valor [i] = '/') Or (Valor [i] = '(') Or (Valor [i] = ')') ) Then Continue;
         NovoValor := NovoValor + Valor [i];
      end;
   Result := NovoValor;
end;

end.

abraço

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.

×
 Share
Ir para lista de Perguntas


  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,3k
×
×
  • Criar Novo...