Como digitar a data corrida no TDateTimePicker
Já tive usuários que me relataram a intensão de nos campos tipo data,
ter a possibilidade de ir digitando a data sem a necessidade de
ter que usar as setas para ir do foco dos dias para meses e anos.
Felizmente nosso amigo Ivan Cesar criou uma classe Interposer de
que resolve TDateTimePicker este problema.
Veja o código fonte:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
| unit DateTimePicker.Interposer;
interface
uses
System.Classes,
System.SysUtils,
Vcl.StdCtrls,
Vcl.ComCtrls,
Winapi.Messages;
type
TDateTimePicker = class(Vcl.ComCtrls.TDateTimePicker)
protected
procedure Change; override;
private
FMoveCursor: Boolean;
procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
end;
implementation
{ TDateTimePicker }
procedure TDateTimePicker.Change;
const
CDtSep = '/';
var
FEdit: TCustomEdit;
begin
inherited;
if not DroppedDown then
if DateFormat = dfShort then
if Format.Contains(CDtSep) then
if FMoveCursor then
begin
FEdit := TCustomEdit(Self);
if Trim(FEdit.Text)[FEdit.SelStart + 2] = CDtSep then
Self.Perform($0100, $27, 0);
end;
end;
procedure TDateTimePicker.WMKeyDown(var Message: TWMKeyDown);
begin
if not DoKeyDown(Message) then
inherited;
UpdateUIState(Message.CharCode);
FMoveCursor := Message.CharCode in [96 .. 105];
end;
end. |
unit DateTimePicker.Interposer;
interface
uses
System.Classes,
System.SysUtils,
Vcl.StdCtrls,
Vcl.ComCtrls,
Winapi.Messages;
type
TDateTimePicker = class(Vcl.ComCtrls.TDateTimePicker)
protected
procedure Change; override;
private
FMoveCursor: Boolean;
procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
end;
implementation
{ TDateTimePicker }
procedure TDateTimePicker.Change;
const
CDtSep = '/';
var
FEdit: TCustomEdit;
begin
inherited;
if not DroppedDown then
if DateFormat = dfShort then
if Format.Contains(CDtSep) then
if FMoveCursor then
begin
FEdit := TCustomEdit(Self);
if Trim(FEdit.Text)[FEdit.SelStart + 2] = CDtSep then
Self.Perform($0100, $27, 0);
end;
end;
procedure TDateTimePicker.WMKeyDown(var Message: TWMKeyDown);
begin
if not DoKeyDown(Message) then
inherited;
UpdateUIState(Message.CharCode);
FMoveCursor := Message.CharCode in [96 .. 105];
end;
end.
Para aplicar o efeito ao seu DateTimePicker basta simplismente
dar uses DateTimePicker.Interposer na interface de sua unidade
e colocar dd/MM/yyyy na propriedade Format do DateTimePicker.
Importante também colocar após Vcl.ComCtrls.
Veja o exemplo:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
| unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls,
JvDateTimePicker, Vcl.StdCtrls, Vcl.Mask, DateTimePicker.Interposer;
type
TForm1 = class(TForm)
DateTimePicker1: TDateTimePicker;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
end. |
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls,
JvDateTimePicker, Vcl.StdCtrls, Vcl.Mask, DateTimePicker.Interposer;
type
TForm1 = class(TForm)
DateTimePicker1: TDateTimePicker;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
end.
Assim a sua tela ganah esta funcionalidade com praticamente nada de programação,
poupando bastante trabalho.
-
Giovani Da Cruz
-
5.684 views
- 1 comentários
- 17 de janeiro de 2017
Está gostando do conteúdo? Considere pagar um cafezinho para nossa equipe!
Posts Relacionados - Continue Aprendendo
Boa tarde,
Primeiro, parabéns pelas orientações, funcionou perfeitamente.
Uma coisa que achei interesse, e isso seria como melhoria: tem como, quando o usuário digitar uma data inválida (exemplo: 31/02/2019) aparecer uma mensagem pra ele, dizendo que essa mensagem não existe? Na sua orientação, o cursos não aceita mas se o usuário não prestar atenção, ele fica eternamente digitando sem notar o problema. Sei que parece básico, mas estou pensando pela cabeça do usuário/cliente.
Leve isso como melhoria. Grato.