关于日期(50分)

怎样才可以使取到的日期的年为四位呢?我有意思是说不管显示在屏幕上还是存在SQL SERVER数据库里!在屏幕上显示时用DBEDIT能不能做到?用什么控件来输入日期呢?

取决于个人设置的样式吧？

1.在"控制面板"的"区域设置"中的"日期"页;
2.在程序设置:ShortDateFormat:='YYYY.MM.DD'

试试如下函数

FormatDateTime('yyyy',Date)
DecodeDate(Date, Y, M, D)

用 TDateTimePicker（在win32页上）

一个象日历一样的日期输入控件

1.在主程序中采用
ShortDateFormat := 'yyyy-mm-dd';
即可。
2.SQL Server中不管系统中设置的日期格式如何，存储是采用浮点数，采用何种方式读取都可以。

{ ****************************************************** }
{ * TOopsDatePicker: version 1.1, Jan 20, 2000. * }
{ * TOopsDBDatePicker: version 1.2, May 05, 2000. * }
{ * Copyright (C) 1995-2000 OopsWare Company. Oops! * }
{ * OopsWare Company. All rights reserved. * }
{ * E-mail: oops@jn-public.sd.cninfo.net * }
{ ****************************************************** }

unit OopsDatePicker;

{$R-,D-}

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, Db, DBCtrls;

type
TPopupCale = class(TMonthCalendar)
private
procedure WMMouseActivate(var Message: TMessage); message WM_MOUSEACTIVATE;
procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
public
constructor Create(AOwner: TComponent); override;
end;

TOopsDatePicker = class(TCustomControl)
private
FBitmapBtbClear: TBitmap;
FCale: TPopupCale;
FDate: TDate;
FDateFormat: TDTDateFormat;
FDateStr: string;
FDateText: string;
FDatePart: Integer;
FDateIsEmpty: Boolean;
FButtonWidth: Integer;
FHasFocus: Boolean;
FListVisible: Boolean;
FPressedDropDown: Boolean;
FPressedClear: Boolean;
FRectBtnClear: TRect;
FRectBtnPopup: TRect;
FRectDateText: TRect;
FRectYMDText: Array [0..2] of TRect;
FTracking: Boolean;
FUserCharPos: Integer;
FOnChange: TNotifyEvent;
FOnDropDown: TNotifyEvent;
FOnCloseUp: TNotifyEvent;
procedure ListMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure CloseUp(Accept: Boolean);
procedure DrawBtnPopup;
procedure DrawBtnClear;
procedure DrawDateText;
procedure DropDown;
procedure TrackButton(X, Y: Integer);
procedure SetDate(Value: TDate);
procedure SetDateFormat(Value: TDTDateFormat);
procedure SetDateToEmpty(Value: Boolean);
procedure StopTracking;
procedure UpdateDispRect;
procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
procedure WMCancelMode(var Message: TMessage); message WM_CANCELMODE;
procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE;
procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
procedure WMKillFocus(var Message: TMessage); message WM_KILLFOCUS;
procedure WMSetFocus(var Message: TMessage); message WM_SETFOCUS;
protected
procedure Change; dynamic;
procedure CreateParams(var Params: TCreateParams); override;
procedure Paint; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
function GetBorderSize: Integer; virtual;
function GetTextHeight: Integer; virtual;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
published
property Anchors;
property BiDiMode;
property Color;
property Constraints;
property Ctl3D;
property Date: TDate read FDate write SetDate;
property DateFormat: TDTDateFormat read FDateFormat write SetDateFormat;
property DateIsEmpty: Boolean read FDateIsEmpty write SetDateToEmpty;
property Enabled;
property Font;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnClick;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp;
property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;

TOopsDBDatePicker = class(TOopsDatePicker)
private
FDataLink: TFieldDataLink;
procedure DataChange(Sender: TObject);
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
function GetReadOnly: Boolean;
procedure SetDataField(const Value: string);
procedure SetDataSource(Value: TDataSource);
procedure SetReadOnly(Value: Boolean);
procedure UpdateData(Sender: TObject);
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
protected
procedure Change; override;
procedure Loaded; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ExecuteAction(Action: TBasicAction): Boolean; override;
function UpdateAction(Action: TBasicAction): Boolean; 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;
end;

procedure Register;

implementation

{$R OopsDatePicker}

const
CLongDateFormat = 'yyyy''年''MM''月''dd''日''';
CShortDateFormat = 'yyyy/MM/dd';
CNullDateFormat = '';
CaleMinDate = -53688; // 1753/01/01 (-53798 while cause TMonthCalendar Error!!!)
CaleMaxDate = 2958465; // 9999/12/31 (2958466 while cause TMonthCalendar Error!!!)

{ TPopupCale }

constructor TPopupCale.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
if NewStyleControls then ControlStyle := [csOpaque, csDoubleClicks, csNoDesignVisible, csReplicatable]
else ControlStyle := [csOpaque, csFramed, csDoubleClicks, csNoDesignVisible, csReplicatable];
end;

procedure TPopupCale.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
Style := WS_POPUP or WS_BORDER;
ExStyle := WS_EX_TOOLWINDOW;
AddBiDiModeExStyle(ExStyle);
WindowClass.Style := CS_SAVEBITS;
end;
end;

procedure TPopupCale.KeyDown(var Key: Word; Shift: TShiftState);
begin
case Key of
VK_UP : Date:=Date-7;
VK_DOWN : Date:=Date+7;
VK_LEFT : Date:=Date-1;
VK_RIGHT : Date:=Date+1;
VK_PRIOR : Date:=IncMonth(Date, -1);
VK_NEXT : Date:=IncMonth(Date, 1);
VK_HOME : Date:=IncMonth(Date, -12);
VK_END : Date:=IncMonth(Date, 12);
end;
end;

procedure TPopupCale.WMMouseActivate(var Message: TMessage);
begin
Message.Result := MA_NOACTIVATE;
end;

procedure TPopupCale.WMGetDlgCode(var Message: TMessage);
begin
Message.Result := DLGC_WANTARROWS or DLGC_WANTCHARS;
end;

{ TOopsDatePicker }

constructor TOopsDatePicker.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
if NewStyleControls then ControlStyle := [csOpaque, csReplicatable]
else ControlStyle := [csOpaque, csFramed, csReplicatable];
ParentColor := False;
FButtonWidth := GetSystemMetrics(SM_CXVSCROLL);
FBitmapBtbClear := TBitmap.Create;
FBitmapBtbClear.Handle:=LoadBitmap(hInstance, 'BTNCLEAR');
FDateStr:=CShortDateFormat;
FCale := TPopupCale.Create(Self);
FCale.Visible := False;
FCale.Font := Font;
FCale.AutoSize := True;
FCale.Parent := Self;
FCale.OnMouseUp := ListMouseUp;
Date := Now;
Width := 121;
TabStop := True;
end;

destructor TOopsDatePicker.Destroy;
begin
FBitmapBtbClear.Free;
FCale.OnMouseUp := nil;
FCale.Destroy;
inherited Destroy;
end;

procedure TOopsDatePicker.CloseUp(Accept: Boolean);
begin
if FListVisible then
begin
SetWindowPos(FCale.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
FListVisible := False;
if Accept then begin FDateIsEmpty:=False; Date:=FCale.Date; Change; end;
Invalidate;
SetFocus;
if Assigned(FOnCloseUp) then FOnCloseUp(Self);
end;
end;

procedure TOopsDatePicker.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do if NewStyleControls and Ctl3D
then ExStyle := ExStyle or WS_EX_CLIENTEDGE
else Style := Style or WS_BORDER;
end;

procedure TOopsDatePicker.Change;
begin
if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TOopsDatePicker.DropDown;
var P: TPoint;
Y: Integer;
begin
if not FListVisible then
begin
if Assigned(FOnDropDown) then FOnDropDown(Self);
FListVisible := True;
FCale.Date:=FDate;
P := Parent.ClientToScreen(Point(Left, Top));
Y := P.Y + Height;
if Y + FCale.Height > Screen.Height then Y := P.Y - FCale.Height;
if P.X<0 then P.X:=0;
if P.X+FCale.Width > Screen.Width then P.X := Screen.Width - FCale.Width;
SetWindowPos(FCale.Handle, HWND_TOP, P.X, Y, 0, 0, SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW);
DrawBtnPopup;
end;
end;

procedure TOopsDatePicker.KeyDown(var Key: Word; Shift: TShiftState);
var y, m, d: Word;
begin
inherited KeyDown(Key, Shift);
if (ssAlt in Shift) and ((Key=VK_UP) or (Key=VK_DOWN)) then begin if FListVisible then CloseUp(True) else DropDown; Key := 0 end;
if FListVisible then FCale.KeyDown(Key, Shift)
else
if (not FDateIsEmpty)or(Key=VK_HOME) then begin
case Key of
VK_UP : begin DecodeDate(Date, y, m, d);
if y>9998 then Exit;
case FDatePart of
0: begin
y:=y+1; if (m=2) and (d>28) and (not IsLeapYear) then d:=28;
Date:=EncodeDate(y, m, d) end;
1: Date:=IncMonth(Date,1);
2: Date:=Date+1; end;
if FDatePart=0 then FUserCharPos:=1;
if FDatePart=1 then FUserCharPos:=5;
if FDatePart=2 then FUserCharPos:=7;
Change;
end;
VK_DOWN : begin DecodeDate(Date, y, m, d);
if y<1754 then Exit;
case FDatePart of
0: begin
y:=y-1; if (m=2) and (d>28) and (not IsLeapYear) then d:=28;
Date:=EncodeDate(y, m, d) end;
1: Date:=IncMonth(Date,-1);
2: Date:=Date-1; end;
if FDatePart=0 then FUserCharPos:=1;
if FDatePart=1 then FUserCharPos:=5;
if FDatePart=2 then FUserCharPos:=7;
Change;
end;
VK_LEFT : begin
if FDatePart<1 then FDatePart:=2 else FDatePart:=FDatePart-1;
if FDatePart=0 then FUserCharPos:=1;
if FDatePart=1 then FUserCharPos:=5;
if FDatePart=2 then FUserCharPos:=7;
DrawDateText;
end;
VK_RIGHT : begin
if FDatePart>1 then FDatePart:=0 else FDatePart:=FDatePart+1;
if FDatePart=0 then FUserCharPos:=1;
if FDatePart=1 then FUserCharPos:=5;
if FDatePart=2 then FUserCharPos:=7;
DrawDateText;
end;
VK_HOME : begin
FDateIsEmpty:=False;
FDatePart:=0;
FUserCharPos:=1;
Date:=Trunc(Now);
Change;
end;
VK_DELETE: begin
SetDateToEmpty(True);
Change;
end;
VK_BACK : begin
if FUserCharPos>1 then FUserCharPos:=FUserCharPos-1;
if FUserCharPos in [1..4] then FDatePart:=0;
if FUserCharPos in [5, 6] then FDatePart:=1;
if FUserCharPos in [7, 8] then FDatePart:=2;
DrawDateText;
end;
end;
end;
end;

procedure TOopsDatePicker.KeyPress(var Key: Char);
var y, m, d: Word;
s: string;
begin
inherited KeyPress(Key);
if FListVisible then begin if Key in [#13, #27] then CloseUp(Key = #13) end
else begin
if not (Key in ['0'..'9']) then Exit;
if FDateIsEmpty then SetDateToEmpty(False);
s := FormatDateTime('yyyymmdd',Date);
s[FUserCharPos]:=Key;
y:=StrToInt(Copy(s, 1, 4));
m:=StrToInt(Copy(s, 5, 2));
d:=StrToInt(Copy(s, 7, 2));
if y<1753 then y:=1753;
if m>12 then m:=12;
if m<1 then m:=1;
if d<1 then d:=1;
if (d>31) and (m in [1,3,5,7,8,10,12]) then d:=31;
if (d>30) and (m in [4,6,9,11]) then d:=30;
if (m=2) and (d>28) then if IsLeapYear then d:=29 else d:=28;
FUserCharPos:=FUserCharPos+1;
if FUserCharPos>8 then FUserCharPos:=1;
if FUserCharPos in [1..4] then FDatePart:=0;
if FUserCharPos in [5, 6] then FDatePart:=1;
if FUserCharPos in [7, 8] then FDatePart:=2;
Date:=EncodeDate(y,m,d);
Change;
end;
end;

procedure TOopsDatePicker.DrawBtnPopup;
var Flags: Integer;
begin
if FListVisible
then Flags := DFCS_SCROLLCOMBOBOX or DFCS_FLAT or DFCS_PUSHED
else Flags := DFCS_SCROLLCOMBOBOX;
DrawFrameControl(Canvas.Handle, FRectBtnPopup, DFC_SCROLL, Flags);
end;

procedure TOopsDatePicker.DrawBtnClear;
var R: TRect;
Flags: Integer;
begin
if FPressedClear then Flags := DFCS_FLAT or DFCS_PUSHED else Flags := DFCS_SCROLLUP;
DrawFrameControl(Canvas.Handle, FRectBtnClear, DFC_SCROLL, Flags);
if FPressedClear
then R:=Bounds(FRectBtnClear.Left + ((FButtonWidth-FBitmapBtbClear.Width) div 2) + 1,
(ClientHeight-FBitmapBtbClear.Height) div 2 + 1, FBitmapBtbClear.Width, FBitmapBtbClear.Height)
else R:=Bounds(FRectBtnClear.Left + ((FButtonWidth-FBitmapBtbClear.Width) div 2),
(ClientHeight-FBitmapBtbClear.Height) div 2, FBitmapBtbClear.Width, FBitmapBtbClear.Height);
Canvas.BrushCopy(R, FBitmapBtbClear, Rect(0, 0, FBitmapBtbClear.Width, FBitmapBtbClear.Height), clOlive);
end;

procedure TOopsDatePicker.DrawDateText;
begin
Canvas.Font := Font;
Canvas.Brush.Color := Color;
if FDateIsEmpty then FDateText:=CNullDateFormat else FDateText:=FormatDateTime(FDateStr,FDate);
UpdateDispRect;
if SysLocale.MiddleEast then TControlCanvas(Canvas).UpdateTextFlags;
Canvas.TextRect(FRectDateText, 1, 2, FDateText);
if FHasFocus and not FListVisible then
begin
Canvas.Font.Color := clHighlightText;
Canvas.Brush.Color := clHighlight;
if SysLocale.MiddleEast then TControlCanvas(Canvas).UpdateTextFlags;
Canvas.TextRect(FRectYMDText[FDatePart], 1, 2, FDateText);
if FDateIsEmpty then Canvas.DrawFocusRect(FRectDateText);
end;
end;

procedure TOopsDatePicker.ListMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var Rect: TRect;
begin
Rect := FCale.ClientRect;
Rect.Top:=Rect.Top+40;
PtInRect(Rect, Point(X, Y));
if (Button = mbLeft) and PtInRect(Rect, Point(X, Y))
then CloseUp(PtInRect(FCale.ClientRect, Point(X, Y)));
end;

procedure TOopsDatePicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
SetFocus;
if not FHasFocus then Exit;
if FListVisible then CloseUp(False) else
begin
MouseCapture := True;
FTracking := True;
TrackButton(X, Y);
if PtInRect(FRectBtnPopup, Point(X, Y)) then DropDown;
if PtInRect(FRectYMDText[0], Point(X, Y)) then begin FDatePart:=0; FUserCharPos:=1; DrawDateText end;
if PtInRect(FRectYMDText[1], Point(X, Y)) then begin FDatePart:=1; FUserCharPos:=5; DrawDateText end;
if PtInRect(FRectYMDText[2], Point(X, Y)) then begin FDatePart:=2; FUserCharPos:=7; DrawDateText end;
end;
end;
inherited MouseDown(Button, Shift, X, Y);
end;

procedure TOopsDatePicker.MouseMove(Shift: TShiftState; X, Y: Integer);
var
ListPos: TPoint;
MousePos: TSmallPoint;
begin
if FTracking then
begin
TrackButton(X, Y);
if FListVisible then
begin
ListPos := FCale.ScreenToClient(ClientToScreen(Point(X, Y)));
if PtInRect(FCale.ClientRect, ListPos) then
begin
StopTracking;
MousePos := PointToSmallPoint(ListPos);
SendMessage(FCale.Handle, WM_LBUTTONDOWN, 0, Integer(MousePos));
Exit;
end;
end;
end;
inherited MouseMove(Shift, X, Y);
end;

procedure TOopsDatePicker.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if FPressedClear and (not FDateIsEmpty) then begin Change; SetDateToEmpty(True); end;
StopTracking;
inherited MouseUp(Button, Shift, X, Y);
end;

procedure TOopsDatePicker.Paint;
begin
UpdateDispRect;
DrawDateText;
DrawBtnClear;
DrawBtnPopup;
end;

function TOopsDatePicker.GetBorderSize: Integer;
var
Params: TCreateParams;
R: TRect;
begin
CreateParams(Params);
SetRect(R, 0, 0, 0, 0);
AdjustWindowRectEx(R, Params.Style, False, Params.ExStyle);
Result := R.Bottom - R.Top;
end;

function TOopsDatePicker.GetTextHeight: Integer;
var
DC: HDC;
SaveFont: HFont;
Metrics: TTextMetric;
begin
DC := GetDC(0);
SaveFont := SelectObject(DC, Font.Handle);
GetTextMetrics(DC, Metrics);
SelectObject(DC, SaveFont);
ReleaseDC(0, DC);
Result := Metrics.tmHeight;
end;

procedure TOopsDatePicker.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
inherited SetBounds(ALeft, ATop, AWidth, GetTextHeight + GetBorderSize + 4);
end;

procedure TOopsDatePicker.SetDateToEmpty(Value: Boolean);
begin
if FDateIsEmpty = Value then Exit;
FUserCharPos:=1;
FDateIsEmpty := Value;
FDatePart := 0;
Invalidate;
end;

procedure TOopsDatePicker.SetDate(Value: TDate);
begin
if FDate=Value then Exit;
FDate:=Value;
FCale.Date:=Value;
Invalidate;
end;

procedure TOopsDatePicker.SetDateFormat(Value: TDTDateFormat);
begin
if FDateFormat <> Value then
begin
FDateFormat := Value;
if FDateFormat=dfLong
then FDateStr:=CLongDateFormat else FDateStr:=CShortDateFormat;
DrawDateText;
end;
end;

procedure TOopsDatePicker.StopTracking;
begin
if FTracking then
begin
TrackButton(-1, -1);
FTracking := False;
MouseCapture := False;
end;
end;

procedure TOopsDatePicker.UpdateDispRect;
begin
if FCale.Parent<>Self then Exit;
FRectBtnClear := Rect(ClientWidth - FButtonWidth * 2, 0, ClientWidth - FButtonWidth, ClientHeight);
FRectBtnPopup := Rect(ClientWidth - FButtonWidth , 0, ClientWidth , ClientHeight);
FRectDateText := Rect(1 , 1, ClientWidth - FButtonWidth * 2 - 1, ClientHeight-1);
if FDateFormat=dfShort then begin
FRectYMDText[0] := Rect(1, 1, Canvas.TextWidth(Copy(FDateText,1,4)) + 1, ClientHeight - 1);
FRectYMDText[1] := Rect(1 + Canvas.TextWidth(Copy(FDateText,1,5)), 1, Canvas.TextWidth(Copy(FDateText,1,7))+1, ClientHeight - 1);
FRectYMDText[2] := Rect(1 + Canvas.TextWidth(Copy(FDateText,1,8)), 1, Canvas.TextWidth(Copy(FDateText,1,10))+1, ClientHeight - 1);
end else begin
FRectYMDText[0] := Rect(1, 1, Canvas.TextWidth(Copy(FDateText,1,4)) + 1, ClientHeight - 1);
FRectYMDText[1] := Rect(1 + Canvas.TextWidth(Copy(FDateText,1,6)), 1, Canvas.TextWidth(Copy(FDateText,1,8))+1, ClientHeight - 1);
FRectYMDText[2] := Rect(1 + Canvas.TextWidth(Copy(FDateText,1,10)), 1, Canvas.TextWidth(Copy(FDateText,1,12))+1, ClientHeight - 1);
end;
end;

procedure TOopsDatePicker.TrackButton(X, Y: Integer);
var NewStateClear, NewStateDropDown: Boolean;
begin
NewStateClear := PtInRect(FRectBtnClear, Point(X, Y));
NewStateDropDown := PtInRect(FRectBtnPopup, Point(X, Y));
if FPressedClear <> NewStateClear then begin FPressedClear := NewStateClear; DrawBtnClear end;
if FPressedDropDown <> NewStateDropDown then begin FPressedDropDown := NewStateDropDown; DrawBtnPopup end;
end;

procedure TOopsDatePicker.CMCancelMode(var Message: TCMCancelMode);
begin
if (Message.Sender <> Self) and (Message.Sender <> FCale) then
CloseUp(False);
end;

procedure TOopsDatePicker.WMCancelMode(var Message: TMessage);
begin
StopTracking;
inherited;
end;

procedure TOopsDatePicker.WMGetDlgCode(var Message: TMessage);
begin
Message.Result := DLGC_WANTARROWS or DLGC_WANTCHARS;
end;

procedure TOopsDatePicker.CMCtl3DChanged(var Message: TMessage);
begin
if NewStyleControls then
begin
RecreateWnd;
Height := 0;
end;
inherited;
end;

procedure TOopsDatePicker.CMFontChanged(var Message: TMessage);
begin
inherited;
Height := 0;
end;

procedure TOopsDatePicker.WMKillFocus(var Message: TMessage);
begin
FHasFocus := False;
Inherited;
Invalidate;
CloseUp(False);
end;

procedure TOopsDatePicker.WMSetFocus(var Message: TMessage);
begin
FHasFocus := True;
FDatePart := 0;
FUserCharPos:=1;
Inherited;
Invalidate;
end;

{ TOopsDBDatePicker }

constructor TOopsDBDatePicker.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := DataChange;
FDataLink.OnUpdateData := UpdateData;
end;

destructor TOopsDBDatePicker.Destroy;
begin
FDataLink.Free;
FDataLink := nil;
inherited Destroy;
end;

procedure TOopsDBDatePicker.Loaded;
begin
inherited Loaded;
if (csDesigning in ComponentState) then DataChange(Self);
end;

procedure TOopsDBDatePicker.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (FDataLink <> nil) and
(AComponent = DataSource) then DataSource := nil;
end;

procedure TOopsDBDatePicker.Change;
begin
FDataLink.Edit;
// inherited Change;
FDataLink.Modified;
inherited Change;
end;

function TOopsDBDatePicker.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;

procedure TOopsDBDatePicker.SetDataSource(Value: TDataSource);
begin
if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
FDataLink.DataSource := Value;
if Value <> nil then Value.FreeNotification(Self);
end;

function TOopsDBDatePicker.GetDataField: string;
begin
Result := FDataLink.FieldName;
end;

procedure TOopsDBDatePicker.SetDataField(const Value: string);
begin
FDataLink.FieldName := Value;
end;

function TOopsDBDatePicker.GetReadOnly: Boolean;
begin
Result := FDataLink.ReadOnly;
end;

procedure TOopsDBDatePicker.SetReadOnly(Value: Boolean);
begin
FDataLink.ReadOnly := Value;
end;

function TOopsDBDatePicker.GetField: TField;
begin
Result := FDataLink.Field;
end;

procedure TOopsDBDatePicker.DataChange(Sender: TObject);
begin
if FDataLink.Editing then Exit;
if FDataLink.Field <> nil then
begin
if not FDataLink.Field.IsNull then Date:=FDataLink.Field.AsDateTime;
DateIsEmpty:=FDataLink.Field.IsNull;
end else
begin
DateIsEmpty:=True;
end;
end;

procedure TOopsDBDatePicker.UpdateData(Sender: TObject);
begin
if DateIsEmpty
then FDataLink.Field.Clear
else FDataLink.Field.AsDateTime := Date;
end;

procedure TOopsDBDatePicker.CMExit(var Message: TCMExit);
begin
try
FDataLink.UpdateRecord;
except
SetFocus;
raise;
end;
inherited;
end;

procedure TOopsDBDatePicker.CMGetDataLink(var Message: TMessage);
begin
Message.Result := Integer(FDataLink);
end;

function TOopsDBDatePicker.ExecuteAction(Action: TBasicAction): Boolean;
begin
Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
FDataLink.ExecuteAction(Action);
end;

function TOopsDBDatePicker.UpdateAction(Action: TBasicAction): Boolean;
begin
Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
FDataLink.UpdateAction(Action);
end;

procedure Register;
begin
RegisterComponents('OopsWare', [TOopsDatePicker]);
RegisterComponents('OopsWare', [TOopsDBDatePicker]);
end;

end.

哇这么长,怎么输入进去的?我这里长度超过1K多都贴不上了....

多人接受答案了。