Jump to content
Fórum Script Brasil
  • 0

(Resolvido) Implementar código no OnExit do componente

robinhocne

Asked by robinhocne,

 Share

Question

robinhocne

robinhocne

Posted
Posted (edited)

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.

Edited by robinhocne
Link to comment
Share on other sites

9 answers to this question

Recommended Posts

  • 0
robinhocne

robinhocne

Posted
  • Author
Posted
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 to comment
Share on other sites
  • 0
Jhonas

Jhonas

Posted
Posted 

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 to comment
Share on other sites
  • 0
robinhocne

robinhocne

Posted
  • Author
Posted 
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 to comment
Share on other sites
  • 0
Jhonas

Jhonas

Posted
Posted

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 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
Go to question listing


  • Forum Statistics

    • Total Topics
      152.2k
    • Total Posts
      652k
×
×
  • Create New...