david
78ab77cd4c
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.jvcl@19 7f62d464-2af8-f54e-996c-e91b33f51cbe
591 lines
19 KiB
ObjectPascal
591 lines
19 KiB
ObjectPascal
{-----------------------------------------------------------------------------
|
|
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.delphi-jedi.org
|
|
|
|
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 12461 2009-08-14 17:21:33Z obones $
|
|
|
|
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(const 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;
|
|
function GetField: TField;
|
|
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;
|
|
property Field: TField read GetField;
|
|
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: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_39/run/JvDBDateTimePicker.pas $';
|
|
Revision: '$Revision: 12461 $';
|
|
Date: '$Date: 2009-08-14 19:21:33 +0200 (ven., 14 août 2009) $';
|
|
LogPath: 'JVCL\run'
|
|
);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
implementation
|
|
|
|
uses
|
|
Variants, SysUtils, ComCtrls, CommCtrl,
|
|
{$IFNDEF COMPILER12_UP}
|
|
JvJCLUtils,
|
|
{$ENDIF ~COMPILER12_UP}
|
|
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 Field <> nil then
|
|
begin
|
|
if Kind = dtkDate then
|
|
begin
|
|
if IsDateAndTimeField then
|
|
DateTime := Field.AsDateTime
|
|
else
|
|
DateTime := Trunc(Field.AsDateTime);
|
|
end
|
|
else
|
|
begin
|
|
if IsDateAndTimeField then
|
|
DateTime := Field.AsDateTime
|
|
else
|
|
DateTime := Frac(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
|
|
//Return Value : String
|
|
//Description : The function retrieve for fieldname from specified
|
|
// datasource
|
|
//Revision : August 30, 2000
|
|
//Author : -ekosbg-
|
|
///////////////////////////////////////////////////////////////////////////
|
|
|
|
function TJvDBDateTimePicker.GetDataField: string;
|
|
begin
|
|
Result := FDataLink.FieldName;
|
|
end;
|
|
|
|
///////////////////////////////////////////////////////////////////////////
|
|
//function TJvDBDateTimePicker.GetDataSource
|
|
//Return Value : TDataSource
|
|
//Description : The function retrieve DataSource from specified Table
|
|
// To make connection with database
|
|
//Revision : August 30, 2000
|
|
//Author : -ekosbg-
|
|
///////////////////////////////////////////////////////////////////////////
|
|
|
|
function TJvDBDateTimePicker.GetDataSource: TDataSource;
|
|
begin
|
|
Result := FDataLink.DataSource;
|
|
end;
|
|
|
|
function TJvDBDateTimePicker.GetField: TField;
|
|
begin
|
|
Result := FDataLink.Field;
|
|
end;
|
|
|
|
function TJvDBDateTimePicker.GetReadOnly: Boolean;
|
|
begin
|
|
Result := FDataLink.ReadOnly;
|
|
end;
|
|
|
|
function TJvDBDateTimePicker.IsDateAndTimeField: Boolean;
|
|
begin
|
|
with FDataLink do
|
|
Result := (Field <> nil) and
|
|
(Field.DataType in [ftDateTime, ftTimeStamp]) and
|
|
not TrimValue;
|
|
end;
|
|
|
|
///////////////////////////////////////////////////////////////////////////
|
|
//procedure TJvDBDateTimePicker.KeyDown
|
|
//Parameter : Key as Word by references,
|
|
// ShiftState as TShiftState, this is enumeration type
|
|
//Description : Handling user action what should to do ? The control should
|
|
// tell to datalink that they should change mode to edit doing
|
|
// an action such as delete, insert or...you guess it
|
|
//Revision : August 30, 2000
|
|
//Author : -ekosbg-
|
|
///////////////////////////////////////////////////////////////////////////
|
|
|
|
procedure TJvDBDateTimePicker.KeyDown(var Key: Word; Shift: TShiftState);
|
|
const
|
|
cAllowedKeysWhenReadOnly = [VK_LEFT, VK_RIGHT];
|
|
begin
|
|
{ Only allow left and right arrow when read-only, don't care about Shift }
|
|
if not (Key in cAllowedKeysWhenReadOnly) and FIsReadOnly and not FDataLink.CanModify then
|
|
begin
|
|
if BeepOnError then
|
|
Beep;
|
|
Key := 0;
|
|
Exit;
|
|
end;
|
|
|
|
// we still parent code
|
|
inherited KeyDown(Key, Shift);
|
|
// Is it Delete key, insert key or shiftstate ...
|
|
case Key of
|
|
VK_DELETE:
|
|
if Shift * KeyboardShiftStates = [] then
|
|
begin
|
|
FDataLink.Edit;
|
|
if Kind = dtkDate then
|
|
begin
|
|
if IsDateAndTimeField then
|
|
DateTime := NullDate
|
|
else
|
|
DateTime := Trunc(NullDate);
|
|
end
|
|
else
|
|
begin
|
|
if IsDateAndTimeField then
|
|
DateTime := NullDate
|
|
else
|
|
DateTime := Frac(NullDate);
|
|
end;
|
|
CheckNullValue;
|
|
UpdateData(Self);
|
|
end;
|
|
VK_INSERT:
|
|
if (Shift * KeyboardShiftStates = [ssShift]) then
|
|
FDataLink.Edit;
|
|
else
|
|
FDataLink.Edit;
|
|
end;
|
|
end;
|
|
|
|
///////////////////////////////////////////////////////////////////////////
|
|
//procedure TJvDBDateTimePicker.KeyPress
|
|
//Parameter : Key as Char by references when the key changes it will
|
|
// reflect to the sender parameter variable.
|
|
//Description : Handling user action what should to do ?
|
|
// Hmmm... ok, first of all the character that user typed
|
|
// should be checked, if it is invalid ignored the character.
|
|
// Otherwise, tell to datalink that the mode should change
|
|
// to edit.
|
|
//Revision : August 30, 2000
|
|
//Author : -ekosbg-
|
|
///////////////////////////////////////////////////////////////////////////
|
|
|
|
procedure TJvDBDateTimePicker.KeyPress(var Key: Char);
|
|
begin
|
|
if FIsReadOnly and not FDataLink.CanModify then
|
|
begin
|
|
if BeepOnError then
|
|
Beep;
|
|
Key := #0;
|
|
Exit;
|
|
end;
|
|
|
|
inherited KeyPress(Key);
|
|
if CharInSet(Key, [#32..#255]) and ((Field <> nil) and
|
|
not (Field.IsValidChar(Key))) then
|
|
begin
|
|
if BeepOnError then
|
|
Beep;
|
|
Key := #0;
|
|
end;
|
|
case Key of
|
|
#32..#255:
|
|
FDataLink.Edit;
|
|
Esc:
|
|
begin
|
|
FDataLink.Reset;
|
|
SetFocus;
|
|
Key := #0;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvDBDateTimePicker.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if (Operation = opRemove) and (FDataLink <> nil) and (AComponent = DataSource) then
|
|
DataSource := nil;
|
|
end;
|
|
|
|
///////////////////////////////////////////////////////////////////////////
|
|
//procedure TJvDBDateTimePicker.SetDataField
|
|
//Parameter : Value as String
|
|
//Description : The procedure is handling the capability to set the
|
|
// DataField property
|
|
//Revision : August 30, 2000
|
|
//Author : -ekosbg-
|
|
///////////////////////////////////////////////////////////////////////////
|
|
|
|
procedure TJvDBDateTimePicker.SetDataField(const Value: string);
|
|
begin
|
|
FDataLink.FieldName := Value;
|
|
end;
|
|
|
|
///////////////////////////////////////////////////////////////////////////
|
|
//procedure TJvDBDateTimePicker.SetDataSource
|
|
//Parameter : Value as TDataSource
|
|
//Description : The procedure is handling the capability to set the
|
|
// DataSource property
|
|
//Revision : August 30, 2000
|
|
//Author : -ekosbg-
|
|
///////////////////////////////////////////////////////////////////////////
|
|
|
|
procedure TJvDBDateTimePicker.SetDataSource(Value: TDataSource);
|
|
begin
|
|
FDataLink.DataSource := Value;
|
|
end;
|
|
|
|
procedure TJvDBDateTimePicker.SetReadOnly(Value: Boolean);
|
|
begin
|
|
FDataLink.ReadOnly := Value;
|
|
end;
|
|
|
|
///////////////////////////////////////////////////////////////////////////
|
|
//procedure TJvDBDateTimePicker.UpdateDate
|
|
//Parameter :
|
|
//Description : We should change the value in datalink, and this is the
|
|
// procedure to handle that event. It will assign with
|
|
// event property Datalink, that is OnUpdateData
|
|
//Revision : August 30, 2000
|
|
//Author : -ekosbg-
|
|
///////////////////////////////////////////////////////////////////////////
|
|
|
|
procedure TJvDBDateTimePicker.UpdateData(Sender: TObject);
|
|
begin
|
|
// update value in datalink with date value in control, not from system
|
|
// DataLink field might be empty
|
|
if (Field = nil) or not FDataLink.Editing then
|
|
Exit;
|
|
|
|
if Kind = dtkDate then
|
|
begin
|
|
if Trunc(NullDate) = Trunc(DateTime) then
|
|
if TrimValue or not IsDateAndTimeField then
|
|
Field.Value := Null
|
|
else
|
|
Field.AsDateTime := Frac(DateTime)
|
|
else
|
|
if TrimValue or not IsDateAndTimeField then
|
|
Field.AsDateTime := Trunc(DateTime)
|
|
else
|
|
Field.AsDateTime := DateTime;
|
|
end
|
|
else
|
|
if IsDateAndTimeField then
|
|
begin
|
|
if Frac(NullDate) = Frac(DateTime) then
|
|
if TrimValue then
|
|
Field.Value := Null
|
|
else
|
|
Field.AsDateTime := Trunc(DateTime)
|
|
else
|
|
if TrimValue then
|
|
Field.AsDateTime := Frac(DateTime)
|
|
else
|
|
Field.AsDateTime := DateTime;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvDBDateTimePicker.WMPaint(var Msg: TWMPaint);
|
|
var
|
|
D: TDateTime;
|
|
ST: TSystemTime;
|
|
begin
|
|
if not (csPaintCopy in ControlState) then
|
|
inherited
|
|
else
|
|
begin
|
|
// DataLink field might be empty
|
|
if Field <> nil then
|
|
begin
|
|
if Kind = dtkDate then
|
|
begin
|
|
if IsDateAndTimeField then
|
|
D := Field.AsDateTime
|
|
else
|
|
D := Trunc(Field.AsDateTime);
|
|
end
|
|
else
|
|
begin
|
|
if IsDateAndTimeField then
|
|
D := Field.AsDateTime
|
|
else
|
|
D := Frac(Field.AsDateTime);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
D := Now; // Default value for date time edits
|
|
end;
|
|
|
|
DateTimeToSystemTime(D, ST);
|
|
DateTime_SetSystemTime(FPaintControl.Handle, GDT_VALID, ST);
|
|
SendMessage(FPaintControl.Handle, WM_ERASEBKGND, Msg.DC, 0);
|
|
SendMessage(FPaintControl.Handle, WM_PAINT, Msg.DC, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvDBDateTimePicker.WMLButtonDown(var Msg: TWMLButtonDown);
|
|
begin
|
|
if FIsReadOnly and not FDataLink.CanModify then
|
|
begin
|
|
SendCancelMode(Self);
|
|
SetFocus;
|
|
end
|
|
else
|
|
inherited;
|
|
end;
|
|
|
|
procedure TJvDBDateTimePicker.CNNotify(var Msg: TWMNotify);
|
|
var
|
|
st: TSystemTime;
|
|
begin
|
|
case Msg.NMHdr^.code of
|
|
DTN_DATETIMECHANGE:
|
|
begin
|
|
FDataLink.Edit;
|
|
if FIsReadOnly and not FDataLink.CanModify then
|
|
begin
|
|
DateTimeToSystemTime(DateTime, st);
|
|
MsgSetDateTime(st);
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
initialization
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
|
|
|
finalization
|
|
UnregisterUnitVersion(HInstance);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
end.
|