dbdatetimepicker.pas

来自「delphi数据库的程序代码」· PAS 代码 · 共 107 行

PAS
107
字号
unit DBDateTimePicker;

interface

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

type
  TDBDateTimePicker = class(TDateTimePicker)
  private
    { Private declarations }
    FAllowChange: Boolean;
    FDataLink: TFieldDataLink;
    function GetDataField: string;
    function GetDataSource: TDataSource;
    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure DataChange(Sender: TObject);
    procedure Change(Sender: TObject);
    procedure CMExit(var Message: TWMNoParams); message CM_EXIT;
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(Aowner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
  end;

procedure Register;

implementation

constructor TDBDateTimePicker.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
   FDataLink:=TFieldDataLink.Create;
   FDataLink.OnDataChange:=DataChange;
   OnChange:=Change;
   FAllowChange:=True;
end;

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

procedure TDBDateTimePicker.DataChange(Sender: TObject);
begin
   if FDataLink.Field=nil then Self.Date:=0
   else
      if FAllowChange then Self.Date:=FDataLink.Field.AsDateTime;
end;

procedure TDBDateTimePicker.Change(Sender: TObject);
begin
   with FDataLink do begin
      FAllowChange:=False;
      if not editing then Edit;
   end;
   FDatalink.Field.AsDateTime:=self.Date;
   FAllowChange:=True;
end;

procedure TDBDateTimePicker.CMExit(var Message: TWMNoParams);
begin
   try
      FDataLink.UpdateRecord;
   except
      on Exception do SetFocus;
   end;
   inherited;
end;

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

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

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

procedure TDBDateTimePicker.SetDataSource(Value: TDataSource);
begin
   FDataLink.DataSource:=Value;
end;

procedure Register;
begin
  RegisterComponents('Data Controls', [TDBDateTimePicker]);
end;

end.

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?