unit PBCDateEdit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Mask,MaskUtils;
type
TDateValidCheck = procedure (Sender: TObject) of object;
type
TPBCDateEdit = class(TMaskEdit)
private
{ Private declarations }
FFontColor : TColor;
FColor : TColor;
FValid : TDateValidCheck; // 日期有效性判断
FValue : TDate; // 当前日期值
FCanEmpty : Boolean; // 是否必须输入日期
FEmptyText : String; // 空日期值串
protected
{ Protected declarations }
procedure setValue(dInDate:TDate);
function getValue:TDate;
procedure KeyPress( var Key: Char );override;
procedure setEnabled(pEnabled:Boolean);override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
procedure ValidateEdit; override;
procedure DoEnter; override;
function IsEmpty:Boolean;
function BuildEditMask:String;
published
{ Published declarations }
property Width default 70;
property Value:TDate read getValue write setValue;
property CanEmpty:Boolean read FCanEmpty write FCanEmpty default true;
property OnValid:TDateValidCheck read FValid write FValid;
end;
implementation
uses pbcCommonUtils;
{ 自动生成日期格式 }
function TPBCDateEdit.BuildEditMask:String;
var
sWrkStr:String;
begin
sWrkStr:=upperCase(ShortDateFormat);
sWrkStr:=StringReplace(sWrkStr,'Y',' ',[rfReplaceAll]);
sWrkStr:=StringReplace(sWrkStr,'M',' ',[rfReplaceAll]);
sWrkStr:=StringReplace(sWrkStr,'D',' ',[rfReplaceAll]);
Self.FEmptyText := trim(sWrkStr); { 默认格式的空串形式 }
sWrkStr:=upperCase(ShortDateFormat);
sWrkStr:=StringReplace(sWrkStr,'Y','0',[rfReplaceAll]);
sWrkStr:=StringReplace(sWrkStr,'M','0',[rfReplaceAll]);
sWrkStr:=StringReplace(sWrkStr,'D','0',[rfReplaceAll]);
result :=sWrkSTr + ';1; ';
end;
{ 初始化 }
constructor TPBCDateEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Self.FColor := self.Color;
Self.FFontColor := self.Font.Color;
Self.Text := '';
Self.EditMask := BuildEditMask;
Self.CanEmpty := true;
if length(Self.EditMask)>12 then begin
Self.MaxLength:=10;
Self.Width:= 70;
end else begin
Self.MaxLength:=8;
Self.Width:=57;
end;
end;
{ 重新设置编辑 }
procedure TPBCDateEdit.DoEnter;
var
sWrkStr:String;
begin
sWrkStr:=BuildEditMask;
if sWrkStr<>Self.EditMask then begin
Self.EditMask := sWrkStr;
if length(self.EditMask)>12 then begin
Self.MaxLength:=10;
Self.Width:= 70;
end else begin
Self.MaxLength:=8;
Self.Width:=57;
end;
end;
inherited;
end;
{ 处理回车 }
procedure TPBCDateEdit.KeyPress( var Key: Char );
begin
if key = #13 then begin
GetParentForm(self).Perform(WM_NEXTDLGCTL,0,0);
Key:=#0;
end;
inherited;
end;
{ 处理颜色 }
procedure TPBCDateEdit.setEnabled(pEnabled:Boolean);
begin
inherited;
if self.Ctl3D=true then begin
if pEnabled=false then begin
self.Color:=clBtnFace;
self.Font.Color:=clBlue;
end else begin
self.Color:=FColor;
self.Font.Color:=FFontColor;
end;
end;
end;
{ 读取日期值 }
function TPBCDateEdit.getValue:TDate;
begin
result := Self.FValue;
end;
{ 写入日期值 }
procedure TPBCDateEdit.setValue(dIndate:TDate);
begin
Self.FValue:= dIndate;
Self.Text := DateToStr(dInDate);
end;
{ 检查日期值 }
procedure TPBCDateEdit.ValidateEdit;
var
dDate :TDate;
begin
if (Self.CanEmpty=false) or (trim(Self.Text) <> Self.FEmptyText) then begin
try
dDate := StrToDate(Self.text);
Self.FValue := dDate;
except
on EConvertError do begin
pbc_ShowWarning('输入的日期值无效！');
Self.SetFocus;
end;
end;
end;
if Self.CanEmpty=true and (trim(Self.Text)=Self.FEmptyText) then begin
Self.FValue:=0;
Self.EditMask:='';
end;
if assigned(FValid) then OnValid(Self);
end;
{ 判断输入值为空 }
function TPBCDateEdit.IsEmpty:Boolean;
begin
if Self.Value=0 then result:=true else result:=false;
end;
end.
