From: "Vanyó Tamás" <vanyotamas@free.agria.hu>
Newsgroups: borland.public.delphi.database.multi-tier
References: <3b42dcf4_2@dnews>
Subject: Re: TDBDateTimePicker
Date: Wed, 4 Jul 2001 14:23:42 +0200
Lines: 232
X-Priority: 3
X-MSMail-Priority: Normal
X-Newsreader: Microsoft Outlook Express 5.50.4133.2400
X-MimeOLE: Produced By Microsoft MimeOLE V5.50.4133.2400
NNTP-Posting-Host: 193.6.115.1
Message-ID: <3b430a4b_2@dnews>
X-Trace: dnews 994249291 193.6.115.1 (4 Jul 2001 05:21:31 -0700)
Path: dnews
Xref: dnews borland.public.delphi.database.multi-tier:30944

Hello!
I created the TwoDBDateTimePicker component in Delphi 5.
It is simle, but work. Here the source code:

Vanyó Tamás
vanyotamas@free.agria.hu

{ ----------------------------------------------------------- }
unit wvDBDateTimePicker;

interface

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

type
  TwoDBDateTimePicker = class(TDateTimePicker)
  private
    FDataLink: TFieldDataLink;
    procedure DataChange(Sender: TObject);
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;
    procedure SetDataField(const Value: string);
    procedure SetDataSource(const Value: TDataSource);

    procedure UpdateData(Sender: TObject);
    procedure WMCut(var Message: TMessage); message WM_CUT;
    procedure WMPaste(var Message: TMessage); message WM_PASTE;
    procedure WMUndo(var Message: TMessage); message WM_UNDO;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
  protected
    procedure Change; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); 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;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TwoDBDateTimePicker]);
end;

{ TwoDBDateTimePicker }

procedure TwoDBDateTimePicker.Change;
begin
  FDataLink.Modified;
  inherited Change;
end;

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

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

constructor TwoDBDateTimePicker.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnUpdateData := UpdateData;
end;

procedure TwoDBDateTimePicker.DataChange(Sender: TObject);
begin
  if FDataLink.Field <> nil then
    if FDataLink.CanModify then
      DateTime := FDataLink.Field.AsDateTime
end;

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

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

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

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

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

procedure TwoDBDateTimePicker.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then
    FDataLink.Edit;
end;

procedure TwoDBDateTimePicker.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
    not FDataLink.Field.IsValidChar(Key) then
  begin
    MessageBeep(0);
    Key := #0;
  end;
  case Key of
    ^H, ^V, ^X, #32..#255:
      FDataLink.Edit;
    #27:
      begin
        FDataLink.Reset;
        Key := #0;
      end;
  end;
end;

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

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

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

procedure TwoDBDateTimePicker.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 TwoDBDateTimePicker.UpdateAction(Action: TBasicAction): Boolean;
begin
  Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
    FDataLink.UpdateAction(Action);
end;

procedure TwoDBDateTimePicker.UpdateData(Sender: TObject);
begin
  FDataLink.Field.AsDateTime := DateTime;
end;

procedure TwoDBDateTimePicker.WMCut(var Message: TMessage);
begin
  FDataLink.Edit;
  inherited;
end;

procedure TwoDBDateTimePicker.WMPaste(var Message: TMessage);
begin
  FDataLink.Edit;
  inherited;
end;

procedure TwoDBDateTimePicker.WMUndo(var Message: TMessage);
begin
  FDataLink.Edit;
  inherited;
end;

end.

{ ----------------------------------------------------------- }

"Bear" <bearinfo@163.net> az alábbiakat írta a következő üzenetben:
news:3b42dcf4_2@dnews...
> Why there is no TDBDateTimePicker in Delphi6 ??
> It is very useful !
>
>
>
> --
>      _/_/_/_/  _/_/_/_/   _/_/      _/_/_/
>     _/    _/  _/        _/  _/     _/   _/
>    _/_/_/    _/_/_/    _/_/ _/    _/_/_/
>   _/    _/  _/        _/    _/   _/   _/
>  _/_/_/_/  _/_/_/_/  _/     _/  _/     _/