我们公司就这个就改过的,你试试看行不?
// 常规工具库 ___ 佐尔软件公司 |||//
// 日期时间编辑器 _____ 版权所有 ||//
// ||/
//______________________Copyright(C) Zuoer 2002_____________________|/
unit ZRDbDateTime;
interface
uses Messages, Windows, SysUtils, CommCtrl, Classes, Controls, Forms,
Menus, Graphics, StdCtrls, RichEdit, ToolWin, dbctrls, Db, ComCtrls;
type
TDBDateTimeEdit=class(TDateTimePicker)
protected
FDataLink: TFieldDataLink;
FOldBeforePost:TDataSetNotifyEvent;
FNullFormat: string;
procedure DataChange(Sender: TObject);
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
function GetReadOnly: Boolean;
procedure SetDataField(const Value: string);
procedure SetDataSource(const Value: TDataSource);
procedure SetReadOnly(const Value: Boolean);
procedure UpdateData(Sender: TObject);
procedure UpdateDataBeforePost(DataSet: TDataSet);
procedure CMEnter (var Message: TCMEnter); message CM_ENTER;
procedure CMExit (var Message: TCMExit); message CM_EXIT;
procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
function GetDateTime: TDateTime;
procedure SetDateTime(const Value: TDateTime);
procedure Change; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure CheckEmptyDate; override;
procedure RequestAlign; override;
procedure CheckNullDateTime;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Field: TField read GetField;
published
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
property NullFormat:string read FNullFormat write FNullFormat;
property DateTime:TDateTime read GetDateTime write SetDateTime;
end;
implementation
uses {$IFDEF VER140}RTLConsts,Variants,{$ENDIF} Consts;
{ TDBDateTimeEdit }
procedure TDBDateTimeEdit.Change;
begin
FDataLink.Modified;
inherited Change;
end;
procedure TDBDateTimeEdit.CheckEmptyDate;
begin
if ShowCheckbox then
inherited CheckEmptyDate;
end;
procedure TDBDateTimeEdit.CMEnter(var Message: TCMEnter);
begin
if FDataLink.DataSet<>nil then
begin
FOldBeforePost:=FDataLink.DataSet.BeforePost;
FDataLink.DataSet.BeforePost:=UpdateDataBeforePost;
end;
inherited;
CheckNullDateTime;
end;
procedure TDBDateTimeEdit.CMExit(var Message: TCMExit);
begin
if FDataLink.DataSet<>nil then
begin
if FDataLink.DataSet.State in [dsInsert,dsEdit] then
begin
UpdateData (Self);
FDataLink.UpdateRecord;
end;
FDataLink.DataSet.BeforePost:=FOldBeforePost;
end;
inherited;
CheckNullDateTime;
end;
type
TDateTimePickerRef = class(TCommonCalendar)
private
FCalAlignment: TDTCalAlignment;
FChanging: Boolean;
FChecked: Boolean;
FDateFormat: TDTDateFormat;
FDateMode: TDTDateMode;
FDroppedDown: Boolean;
FKind: TDateTimeKind;
FLastChange: TSystemTime;
FParseInput: Boolean;
FShowCheckbox: Boolean;
FOnUserInput: TDTParseInputEvent;
FOnCloseUp: TNotifyEvent;
FOnChange: TNotifyEvent;
FOnDropDown: TNotifyEvent;
FFormat: String;
end;
function IsBlankSysTime(const ST: TSystemTime): Boolean;
type
TFast = array [0..3] of DWORD;
begin
Result := (TFast(ST)[0] or TFast(ST)[1] or TFast(ST)[2] or TFast(ST)[3]) = 0;
end;
procedure TDBDateTimeEdit.CNNotify(var Message: TWMNotify);
var
DT: TDateTime;
begin
with Message, NMHdr^ do
begin
if code = DTN_DATETIMECHANGE then
begin
Result := 0;
with PNMDateTimeChange(NMHdr)^ do
begin
if TDateTimePickerRef(self).FDroppedDown and (dwFlags = GDT_VALID) then
begin
TDateTimePickerRef(self).FLastChange := st;
inherited DateTime := SystemTimeToDateTime(TDateTimePickerRef(self).FLastChange);
end
else begin
if TDateTimePickerRef(self).FShowCheckbox and IsBlankSysTime(st) then
TDateTimePickerRef(self).FChecked := False
else if dwFlags = GDT_VALID then
begin
TDateTimePickerRef(self).FLastChange := st;
DT := SystemTimeToDateTime(st);
inherited DateTime:=DT;
if TDateTimePickerRef(self).FShowCheckbox then TDateTimePickerRef(self).FChecked := True;
end;
end;
Change;
end
end
else
inherited;
end;
end;
constructor TDBDateTimeEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FNullFormat:='''''';
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := DataChange;
FDataLink.OnUpdateData := UpdateData;
end;
procedure TDBDateTimeEdit.DataChange(Sender: TObject);
begin
if FDataLink.Field <> nil then
DateTime:=FDataLink.Field.AsDateTime
else
//if csDesigning in ComponentState then
DateTime:=Now;
//inherited Change;
end;
destructor TDBDateTimeEdit.Destroy;
begin
FDataLink.Free;
FDataLink := nil;
inherited Destroy;
end;
function TDBDateTimeEdit.GetDataField: string;
begin
Result := FDataLink.FieldName;
end;
function TDBDateTimeEdit.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
function TDBDateTimeEdit.GetDateTime: TDateTime;
begin
Result:=inherited DateTime;
end;
function TDBDateTimeEdit.GetField: TField;
begin
Result := FDataLink.Field;
end;
function TDBDateTimeEdit.GetReadOnly: Boolean;
begin
Result := FDataLink.ReadOnly;
end;
procedure TDBDateTimeEdit.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (FDataLink <> nil) and
(AComponent = DataSource) then DataSource := nil;
end;
procedure TDBDateTimeEdit.SetDataField(const Value: string);
begin
FDataLink.FieldName := Value;
CheckNullDateTime;
end;
procedure TDBDateTimeEdit.SetDataSource(const Value: TDataSource);
begin
if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
FDataLink.DataSource := Value;
if Value <> nil then Value.FreeNotification(Self);
CheckNullDateTime;
end;
procedure TDBDateTimeEdit.SetDateTime(const Value: TDateTime);
begin
inherited DateTime:=Value;
CheckNullDateTime;
end;
procedure TDBDateTimeEdit.SetReadOnly(const Value: Boolean);
begin
FDataLink.ReadOnly := Value;
CheckNullDateTime;
end;
procedure TDBDateTimeEdit.UpdateData(Sender: TObject);
begin
FDataLink.Field.AsDateTime := DateTime;
end;
procedure TDBDateTimeEdit.UpdateDataBeforePost(DataSet: TDataSet);
begin
UpdateData(Self);
if Assigned(FOldBeforePost) then
FOldBeforePost(DataSet);
end;
procedure TDBDateTimeEdit.RequestAlign;
begin
inherited RequestAlign;
CheckNullDateTime;
end;
procedure TDBDateTimeEdit.CheckNullDateTime;
begin
if HasParent {and Visible }then
if (DateTime=0.0) and (not Focused {or (Kind=dtkDate) and (DateMode=dmComboBox) }or ReadOnly) then
SendMessage(Handle, DTM_SETFORMAT, 0 , Integer(PChar(FNullFormat)))
else
begin
SendMessage(Handle, DTM_SETFORMAT, 0 , Integer(PChar(Format)));
if ReadOnly then
SendMessage(Handle, DTM_SETFORMAT, 0 , Integer(PChar(Text)));
end;
end;
end.