借鉴网上写的DBDateTime控件,作为关联时间类型的数据感知控件,使用这个控件运行程序,在这个控件里第一次采用输入的方式输入日期的时候,输入无效。比如这个控件关联的日期 数据库里的 数据是 1990-01-01,运行程序,点击进入这个控件,在年那里输入 1988 ,在点击跳到月是 控件显示的 从 1988 恢复到 1990 ,第二次再输入就没有问题。
控件代码:unit DBDateTime;interfaceuses
SysUtils, Classes, Controls, ComCtrls,DBCtrls,DB,Windows,Messages,Dialogs;type
TDBDateTime = class(TDateTimePicker)
private
FDataLink: TFieldDataLink;
FAlignment: TAlignment;
procedure SetAlignment(const Value: TAlignment);
procedure DataChange(Sender: TObject);
procedure EditingChange(Sender: TObject);
procedure UpdateData(Sender: TObject);
function GetDataField: WideString;
function GetDataSource: TDataSource;
procedure SetDataField(const Value: WideString);
procedure SetDataSource(const Value: TDataSource);
procedure CMExit(var Message: TCMExit); message CM_EXIT;
{ Private declarations }
protected
procedure Change; override;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
{ Protected declarations }
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
{ Public declarations }
published
property Alignment: TAlignment read FAlignment write SetAlignment;
property DataField: WideString read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
end;procedure Register;implementationprocedure Register;
begin
RegisterComponents('Data Controls', [TDBDateTime]);
end;{ TDBDateTime }procedure TDBDateTime.Change;
begin
FDataLink.Modified;
if not FDataLink.Editing then
FdataLink.Edit;
//postmessage(Self.Handle,wm_keydown,VK_RIGHT,0);
inherited Change;
end;procedure TDBDateTime.CMExit(var Message: TCMExit);
begin
try
FDataLink.UpdateRecord;
except
//SelectAll;
SetFocus;
raise;
end; DoExit;
end;constructor TDBDateTime.Create(AOwner: TComponent);
begin
inherited Create(Aowner);
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := DataChange;
FDataLink.OnEditingChange := EditingChange;
FDataLink.OnUpdateData := UpdateData;
end;procedure TDBDateTime.DataChange(Sender: TObject);
begin
if FDataLink.Field <> nil then
begin
if FDatalink.Field.AsDateTime =0 then DateTime := 1
else DateTime := FDatalink.Field.AsDateTime;
end else
begin
DateTime := now() ;
end;end;destructor TDBDateTime.Destroy;
begin
FDataLink.OnDataChange:=nil;
FDataLink.OnUpdateData:=nil;
FDataLink.Free;
FDataLink := nil; inherited Destroy;
end;procedure TDBDateTime.EditingChange(Sender: TObject);
begin
if (DataSource <> nil) and (DataField <> '') then
FDataLink.Edit;
end;function TDBDateTime.GetDataField: WideString;
begin
Result := FDataLink.FieldName;
end;function TDBDateTime.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;procedure TDBDateTime.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (FDataLink <> nil) and
(AComponent = DataSource) then DataSource := nil;
end;procedure TDBDateTime.SetAlignment(const Value: TAlignment);
var
style: DWORD;
begin
if FAlignment <> Value then
begin
FAlignment := Value;
Style := GetWindowLong(Handle,GWL_STYLE);
style := style and (not ES_LEFT) and (not ES_CENTER) and (not ES_RIGHT);
case FAlignment of
taLeftJustify: SetWindowLong(Handle,GWL_STYLE,style or ES_LEFT);
taRightJustify: SetWindowLong(Handle,GWL_STYLE,style or ES_RIGHT);
taCenter: SetWindowLong(Handle,GWL_STYLE,style or ES_CENTER);
end;
Invalidate;
end;
end;procedure TDBDateTime.SetDataField(const Value: WideString);
begin
FDataLink.FieldName := Value;
end;procedure TDBDateTime.SetDataSource(const Value: TDataSource);
begin
if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
FDataLink.DataSource := Value;
if Value <> nil then Value.FreeNotification(Self);
end;procedure TDBDateTime.UpdateData(Sender: TObject);
begin
//ShowMessage(DateTimeToStr(DateTime));
FDatalink.Field.AsDateTime:= DateTime;
end;end.
控件代码:unit DBDateTime;interfaceuses
SysUtils, Classes, Controls, ComCtrls,DBCtrls,DB,Windows,Messages,Dialogs;type
TDBDateTime = class(TDateTimePicker)
private
FDataLink: TFieldDataLink;
FAlignment: TAlignment;
procedure SetAlignment(const Value: TAlignment);
procedure DataChange(Sender: TObject);
procedure EditingChange(Sender: TObject);
procedure UpdateData(Sender: TObject);
function GetDataField: WideString;
function GetDataSource: TDataSource;
procedure SetDataField(const Value: WideString);
procedure SetDataSource(const Value: TDataSource);
procedure CMExit(var Message: TCMExit); message CM_EXIT;
{ Private declarations }
protected
procedure Change; override;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
{ Protected declarations }
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
{ Public declarations }
published
property Alignment: TAlignment read FAlignment write SetAlignment;
property DataField: WideString read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
end;procedure Register;implementationprocedure Register;
begin
RegisterComponents('Data Controls', [TDBDateTime]);
end;{ TDBDateTime }procedure TDBDateTime.Change;
begin
FDataLink.Modified;
if not FDataLink.Editing then
FdataLink.Edit;
//postmessage(Self.Handle,wm_keydown,VK_RIGHT,0);
inherited Change;
end;procedure TDBDateTime.CMExit(var Message: TCMExit);
begin
try
FDataLink.UpdateRecord;
except
//SelectAll;
SetFocus;
raise;
end; DoExit;
end;constructor TDBDateTime.Create(AOwner: TComponent);
begin
inherited Create(Aowner);
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := DataChange;
FDataLink.OnEditingChange := EditingChange;
FDataLink.OnUpdateData := UpdateData;
end;procedure TDBDateTime.DataChange(Sender: TObject);
begin
if FDataLink.Field <> nil then
begin
if FDatalink.Field.AsDateTime =0 then DateTime := 1
else DateTime := FDatalink.Field.AsDateTime;
end else
begin
DateTime := now() ;
end;end;destructor TDBDateTime.Destroy;
begin
FDataLink.OnDataChange:=nil;
FDataLink.OnUpdateData:=nil;
FDataLink.Free;
FDataLink := nil; inherited Destroy;
end;procedure TDBDateTime.EditingChange(Sender: TObject);
begin
if (DataSource <> nil) and (DataField <> '') then
FDataLink.Edit;
end;function TDBDateTime.GetDataField: WideString;
begin
Result := FDataLink.FieldName;
end;function TDBDateTime.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;procedure TDBDateTime.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (FDataLink <> nil) and
(AComponent = DataSource) then DataSource := nil;
end;procedure TDBDateTime.SetAlignment(const Value: TAlignment);
var
style: DWORD;
begin
if FAlignment <> Value then
begin
FAlignment := Value;
Style := GetWindowLong(Handle,GWL_STYLE);
style := style and (not ES_LEFT) and (not ES_CENTER) and (not ES_RIGHT);
case FAlignment of
taLeftJustify: SetWindowLong(Handle,GWL_STYLE,style or ES_LEFT);
taRightJustify: SetWindowLong(Handle,GWL_STYLE,style or ES_RIGHT);
taCenter: SetWindowLong(Handle,GWL_STYLE,style or ES_CENTER);
end;
Invalidate;
end;
end;procedure TDBDateTime.SetDataField(const Value: WideString);
begin
FDataLink.FieldName := Value;
end;procedure TDBDateTime.SetDataSource(const Value: TDataSource);
begin
if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
FDataLink.DataSource := Value;
if Value <> nil then Value.FreeNotification(Self);
end;procedure TDBDateTime.UpdateData(Sender: TObject);
begin
//ShowMessage(DateTimeToStr(DateTime));
FDatalink.Field.AsDateTime:= DateTime;
end;end.
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货