unit DateEdit;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, StdCtrls, DateUtils, SysConst;
type
TGetDatumFunc =
function(
var Datum: TDateTime): boolean
of Object;
TDateEdit =
class(TEdit)
private { Private declarations }
FDateMask :
String;
FGetDatum,
FTestDatum : TGetDatumFunc;
procedure SetDateMask(value:
String);
procedure SetNextDate(t: Integer);
procedure Exit(Sender: TObject);
protected { Protected declarations }
public { Public declarations }
constructor Create(Owner: TComponent);
override;
procedure DblClick;
override;
procedure KeyPress(
var Key: Char);
override;
published { Published declarations }
property DateMask:
string read FDateMask
write SetDateMask;
property DatumGetFunc: TGetDatumFunc
read FGetDatum
write FGetDatum;
property DatumTestFunc: TGetDatumFunc
read FTestDatum
write FTestDatum;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('
RaSoWa', [TDateEdit]);
end;
constructor TDateEdit.Create(Owner: TComponent);
begin
inherited Create(Owner);
FDateMask := ShortDateFormat;
FGetDatum :=
nil;
FTestDatum :=
nil;
OnExit := Exit;
end;
procedure TDateEdit.SetDateMask(value:
String);
begin
if FDateMask <> Value
then FDateMask := Value;
end;
procedure TDateEdit.SetNextDate(t: Integer);
var d : TDateTime;
begin
if TryStrToDate(Text, d)
then d := IncDay(d, t)
else d := Date;
Text := FormatDateTime(FDateMask, d);
end;
procedure TDateEdit.KeyPress(
var Key: Char);
begin
case Key
of
'
+' :
begin
SetNextDate(1);
end;
'
-' :
begin
SetNextDate(-1);
end;
'
,' : Key := DateSeparator;
#13 :
begin
Key := #0;
SendMessage(
Handle, WM_NEXTDLGCTL, 0, 0);
// ????????
// Self.Perform(WM_NEXTDLGCTL, 0, 0); // ???????
end;
end;
if not(Key
in [#1..#31,'
0'..'
9','
.'])
then Key := #0;
inherited;
end;
procedure TDateEdit.Exit(Sender: TObject);
var d : TDateTime;
begin
if TryStrToDate(Text, d)
then Text := FormatDateTime(FDateMask, d)
else raise EConvertError.CreateResFmt(@SInvalidDate, [Text]);
inherited;
end;
procedure TDateEdit.DblClick;
var d : TDateTime;
ok : Boolean;
begin
if Assigned(FGetDatum)
then begin
if not TryStrToDate(Text, d)
then d := Date;
if FGetDatum(d)
then begin
ok := True;
if Assigned(FTestDatum)
then ok := FTestDatum(d);
if ok
then Text := FormatDateTime(FDateMask, d);
end;
end;
inherited;
end;
end.