⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 jvdbdatetimepicker.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvDBDateTimePicker.PAS, released May 8, 2000

The Initial Developer of the Original Code is Eko Subagio (ekosbg att bigfoot dott com)
Portions created by Eko Subagio are Copyright (C) 2000 Eko Subagio.
Portions created by Microsoft are Copyright (C) 1998, 1999 Microsoft Corp.
All Rights Reserved.

Contributor(s): ______________________________________.

               by Eko Subagio
Current Version: 1.00

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
  (rom) comments should be ripped by the help writer
-----------------------------------------------------------------------------}
/////////////////////////////////////////////////////////////////////////
// TJvDBDateTimePicker
// Copyright(c)2000 Eko Subagio
// TJvDBDateTimePicker is derived from TDateTimePicker from Delphi 5
// TDateTimePicker Copyright(c) 2000 Borland/Inprise.
// Extending and add capability to integrate with database
// www.geocities.com/ekosbg
/////////////////////////////////////////////////////////////////////////
// $Id: JvDBDateTimePicker.pas,v 1.25 2005/02/17 10:20:20 marquardt Exp $

unit JvDBDateTimePicker;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, Messages, Classes, Controls, DB, DBCtrls,
  JvDateTimePicker;

type
  TJvDBDateTimePicker = class(TJvDateTimePicker)
  private
    FDataLink: TFieldDataLink;
    FBeepOnError: Boolean;
    FTrimValue: Boolean;
    FIsReadOnly: Boolean;
    FPaintControl: TPaintControl;
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetReadOnly: Boolean;
    procedure SetReadOnly(Value: Boolean);
    procedure SetDataField(Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure EditingChange(Sender: TObject);
    procedure WMLButtonDown(var Msg: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
    procedure CMGetDataLink(var Msg: TMessage); message CM_GETDATALINK;
    procedure CNNotify(var Msg: TWMNotify); message CN_NOTIFY;
  protected
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    function IsDateAndTimeField: Boolean;
    // Adding capability to edit
    procedure DoExit; override;
    procedure DataChange(Sender: TObject);
    // Adding capability to edit
    procedure KeyPress(var Key: Char); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure Change; override;
    procedure UpdateData(Sender: TObject);
    // On Close Up & Drop Down
    procedure CalendarOnCloseUp(Sender: TObject);
    procedure CalendarOnDropDown(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property BeepOnError: Boolean read FBeepOnError write FBeepOnError default True;
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property TrimValue: Boolean read FTrimValue write FTrimValue default True;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvDBDateTimePicker.pas,v $';
    Revision: '$Revision: 1.25 $';
    Date: '$Date: 2005/02/17 10:20:20 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  {$IFDEF HAS_UNIT_VARIANTS}
  Variants,
  {$ENDIF HAS_UNIT_VARIANTS}
  SysUtils, ComCtrls, CommCtrl, 
  JvConsts;

//=== { TJvDBDateTimePicker } ================================================

///////////////////////////////////////////////////////////////////////////
//constructor TJvDBDateTimePicker.Create
//Parameter   : AOwner as TComponent
//Description : As Constructor the procedure had have responsibility to
//              handle new instance for initial new value.
//Revision    : August 30, 2000
//Author      : -ekosbg-
///////////////////////////////////////////////////////////////////////////

constructor TJvDBDateTimePicker.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIsReadOnly := True;
  ControlStyle := ControlStyle + [csReplicatable];
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnUpdateData := UpdateData;
  FDataLink.OnEditingChange := EditingChange;
  OnCloseUp := CalendarOnCloseUp;
  OnDropDown := CalendarOnDropDown;
  FBeepOnError := True;
  FTrimValue := True;
  FPaintControl := TPaintControl.Create(Self, DATETIMEPICK_CLASS);
end;

///////////////////////////////////////////////////////////////////////////
//Destructor TJvDBDateTimePicker.Destroy
//Parameter   : None
//Description : Destructor had have responsibility to destroy all garbage
//              that had been used in Constructor, free anything in here
//              after anything is initialized in Constructor
//Revision    : August 30, 2000
//Author      : -ekosbg-
///////////////////////////////////////////////////////////////////////////

destructor TJvDBDateTimePicker.Destroy;
begin
  OnCloseUp := nil;
  OnDropDown := nil;
  FPaintControl.Free;
  FDataLink.OnDataChange := nil;
  FDataLink.OnUpdateData := nil;
  FDataLink.Free;
  FDataLink := nil;
  inherited Destroy;
end;

///////////////////////////////////////////////////////////////////////////
//procedure    : TJvDBDateTimePicker.CalendarOnCloseUp
//Parameter    : Sender as TObject
//Descriptions : To set the dataset into edit mode, when the user
//               closing up the Calendar.
//Revision     : October 18, 2000 ekosbg att bigfoot dott com
///////////////////////////////////////////////////////////////////////////

procedure TJvDBDateTimePicker.CalendarOnCloseUp(Sender: TObject);
begin
  FDataLink.Edit;
end;

///////////////////////////////////////////////////////////////////////////
//procedure    : TJvDBDateTimePicker.CalendarOnDropDown
//Parameter    : Sender as TObject
//Descriptions : To set the dataset into edit mode, when the user
//               dropping down the Calendar.
//Revision     : October 18, 2000 ekosbg att bigfoot dott com
///////////////////////////////////////////////////////////////////////////

procedure TJvDBDateTimePicker.CalendarOnDropDown(Sender: TObject);
begin
  FDataLink.Edit;
end;

///////////////////////////////////////////////////////////////////////////
//procedure TJvDBDateTimePicker.Change;
//Description : We should maintain the changes in TJvDBDateTimePicker to
//              datalink, in order to notify datalink that it was changed.
//Revision    : August 30, 2000
//Author      : -ekosbg-
///////////////////////////////////////////////////////////////////////////

procedure TJvDBDateTimePicker.Change;
begin
  // call method modified
  FDataLink.Edit;
//  FDataLink.Modified;
  // we still need base class code
  inherited Change;
  UpdateData(Self);
end;

procedure TJvDBDateTimePicker.CMGetDataLink(var Msg: TMessage);
begin
  Msg.Result := Integer(FDataLink);
end;

///////////////////////////////////////////////////////////////////////////
//procedure TJvDBDateTimePicker.DataChange
//Parameter   : Sender as TObject
//Description : DataChange had have responsibility to make data in control
//              always up to date with the current value in database
//              This is event handler for TFieldDataLink event property
//              OnDataChange
//Revision    : August 30, 2000
//Author      : -ekosbg-
///////////////////////////////////////////////////////////////////////////

procedure TJvDBDateTimePicker.DataChange(Sender: TObject);
begin
  if FDataLink.Field <> nil then
  begin
    if Kind = dtkDate then
    begin
      if IsDateAndTimeField then
        DateTime := FDataLink.Field.AsDateTime
      else
        DateTime := Trunc(FDataLink.Field.AsDateTime);
    end
    else
    begin
      if IsDateAndTimeField then
        DateTime := FDataLink.Field.AsDateTime
      else
        DateTime := Frac(FDataLink.Field.AsDateTime);
    end;
  end
  else
  if csDesigning in ComponentState then
    DateTime := Now;
  CheckNullValue;
end;

///////////////////////////////////////////////////////////////////////////
//procedure TJvDBDateTimePicker.DoExit
//Description : User action , She/He leave the control.......
//              We should tell to database that is leave and database
//             should be updated using datalink value
//Revision    : August 30, 2000
//Author      : -ekosbg-
///////////////////////////////////////////////////////////////////////////

procedure TJvDBDateTimePicker.DoExit;
begin
  // trapping in exception
  try
    // Changes should Reflect database
    FDataLink.UpdateRecord;
  except
    // Only got an error the focus will not leave the control
    SetFocus;
  end;
  // We needs the method behavior from parents of DoExit;
  inherited DoExit;
end;

procedure TJvDBDateTimePicker.EditingChange(Sender: TObject);
begin
  FIsReadOnly := not FDataLink.Editing;
end;

//function TJvDBDateTimePicker.GetDataField

⌨️ 快捷键说明

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