unit uDBCalendarView;

interface

uses
  System.Classes, Vcl.WinXCalendars, Data.DB, VCL.DBCtrls;

type
  TDBCalendarView = class(TCalendarView)
  private
    FDataLink: TFieldDataLink;
    procedure DataChange(Sender: TObject);
    procedure SetDataField(const Value: string);
    procedure SetDataSource(const Value: TDataSource);
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;
    function GetFieldDate: TDate;
  protected
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent);
    destructor Destroy; override;
    property Field: TField read GetField;
  published
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
  end;

implementation

uses
  System.SysUtils;

{ TDBCalendarView }

constructor TDBCalendarView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Enabled := False; // read-only
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
end;

destructor TDBCalendarView.Destroy;
begin
  FDataLink.Free;
  inherited;
end;

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

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

procedure TDBCalendarView.DataChange(Sender: TObject);
begin
  self.Date := GetFieldDate;
end;

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

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

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

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

procedure TDBCalendarView.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;

function TDBCalendarView.GetFieldDate: TDate;
begin
  if FDataLink.Field <> nil then
  begin
    if (FDataLink.Field.DataType in [ftDate, ftDateTime, ftTimeStamp, ftTime]) then
      Result := FDataLink.Field.AsDateTime
    else
      Result := Now;
  end
  else
    if csDesigning in ComponentState then Result := Now;
end;

end.