procedure TFormDate.SetInitDate(AValue: TDate); begin
cal.Date := AValue; end;
3、新建一个控件，派生自Tcomponent。 代码如下：
unit DateDialog;
interface uses
SysUtils, Classes, Controls, frmDlg; type
TDateDialog = class(TComponent) private
FDlg: TFormDate;
function GetDate: TDate;
procedure SetDate(AValue: TDate); protected public
constructor Create(AOwner: TComponent);override; function Execute: Boolean; published
property Date: TDate read GetDate write SetDate; end;
procedure Register;
implementation
procedure Register; begin
RegisterComponents('Linco', [TDateDialog]); end;
constructor TDateDialog.Create(AOwner: TComponent); begin
inherited Create(AOwner);
FDlg := TFormDate.Create(self); end;
function TDateDialog.Execute: Boolean; begin
result := (FDlg.ShowModal = mrOK); end;
function TDateDialog.GetDate: TDate; begin
result := FDlg.GetSelDate; end;
procedure TDateDialog.SetDate(AValue: TDate); begin
FDlg.SetInitDate(AValue); end; end.
代码比较简单就不多解释了。 思考题：
1、做一个模仿TcolorDialog的对话框控件。
Delphi控件开发浅入深出（八）
八、数据敏感控件的制作。
Delphi的一大亮点就是它的数据库开发能力。而数据敏感组件则在这中间起着很重要的作用。在Delphi的Data Control页面下的控件都是用于显示和编辑数据库中的数据的。相信大家已经体会到数据敏感控件的好处了。我们这一节就给大家演示一下数据敏感控件的开发方法。
需要提醒大家的是，不像其他体系的控件，数据敏感控件并没有一个统一的基类，只要是从TwinControl类或其子类派生就可以，数据敏感控件的特殊之处就在于我们下面提到的数据连接。
相信用Delphi开发过数据库的人一定对delphi中没有一个日期数据敏感控件而恼火。每次都要我们自己处理数据的更新与显示。所以我们就来开发一个DBDateTimePicker控件。
新建一个控件，从TdateTimePicker派生，源代码如下：
{*******************************************************} { Linco TDBDateTimePicker
{ mail me: about521@163.com } {*******************************************************} unit DBDateTimePicker; interface uses
SysUtils, Classes, Controls, ComCtrls, DBCtrls, Messages, DB; type
TDBDateTimePicker = class(TDateTimePicker) private
FDataLink: TFieldDataLink;
procedure CMGetDataLink(var Msg: TMessage);message CM_GETDATALINK; procedure DataChange(Sender: TObject); procedure EditingChange(Sender: TObject); procedure FSetDataField(AValue: string);
procedure FSetDataSource(AValue: TDataSource); procedure FSetReadOnly(AValue: Boolean); procedure ShowData;
procedure UpdateData(Sender: TObject); function FGetDataField: string;
function FGetDataSource: TDataSource; function FGetField: TField; function FGetReadOnly: Boolean; protected
procedure Change;override;
procedure Notification(AComponent: TComponent;Operation: TOperation);override;
public
constructor Create(AOwner: TComponent); override; destructor Destroy; override;
property Field: TField read FGetField; published
property DataField: string read FGetDataField write FSetDataField; property DataSource: TDataSource read FGetDataSource write FSetDataSource; property ReadOnly: Boolean read FGetReadOnly write FSetReadOnly; end;
procedure Register; implementation uses Variants;
constructor TDBDateTimePicker.Create(AOwner: TComponent); begin
inherited Create(AOwner);
FDataLink := TFieldDataLink.Create; FDataLink.OnDataChange := DataChange; FDataLink.Control := self;
FDataLink.OnEditingChange := EditingChange; FDataLink.OnUpdateData := UpdateData; self.DateTime := Now(); end;
destructor TDBDateTimePicker.Destroy; begin
FDataLink.Free; inherited; end;
procedure TDBDateTimePicker.CMGetDataLink(var Msg: TMessage); begin
Msg.Result := Integer(FDataLink);
end;
procedure TDBDateTimePicker.DataChange(Sender: TObject); begin
if Field<>nil then
if Field.Value = null then
if (DataSource.DataSet.State = dsEdit)
or (DataSource.DataSet.State = dsInsert) then Field.AsDateTime := Now(); ShowData; end;
procedure TDBDateTimePicker.EditingChange(Sender: TObject); begin
if (DataSource <> nil) and (DataField <> '') then FDataLink.Edit; end;
procedure TDBDateTimePicker.FSetDataField(AValue: string); begin
FDataLink.FieldName := AValue; end;
procedure TDBDateTimePicker.FSetReadOnly(AValue: Boolean); begin
FDataLink.ReadOnly := AValue; end;
procedure TDBDateTimePicker.ShowData; begin
if (DataSource <> nil) and (DataField <> '') and(Field<>nil)then begin
case Kind of
dtkDate: if Field.AsString <> '' then self.Date := Field.AsDateTime else
self.Date := Now();
dtkTime: if Field.AsString <> '' then self.Time := Field.AsDateTime else
self.Time := Now(); else
self.DateTime := Now(); end;
end; end;
procedure TDBDateTimePicker.FSetDataSource(AValue: TDataSource); begin
FDataLink.DataSource := AValue; if AValue <> nil then
AValue.FreeNotification(self); end;
procedure TDBDateTimePicker.Change; begin
if (DataSource <> nil) and (DataField <> '') then begin
FDataLink.Edit;
Field.Value := self.Text; end;
inherited Change; end;
procedure TDBDateTimePicker.Notification(AComponent: TComponent;Operation: TOperation);
begin
if (Operation = opRemove) and (FDataLink <> nil) and (AComponent = DataSource) then DataSource := nil; end;
procedure TDBDateTimePicker.UpdateData(Sender: TObject); var
t: TFieldType; begin
if (DataSource <> nil) and (DataField <> '') then begin
t := FDataLink.Field.DataType; case t of
ftTime: FDataLink.Field.AsDateTime := self.Time; ftDate: FDataLink.Field.AsDateTime := self.Date;
ftDateTime: FDataLink.Field.AsDateTime := self.DateTime; end; end; end;
function TDBDateTimePicker.FGetDataField: string;