325 lines
8.4 KiB
ObjectPascal
325 lines
8.4 KiB
ObjectPascal
{ RxDBTimeEdit unit
|
|
|
|
Copyright (C) 2005-2017 Lagunov Aleksey alexs75@yandex.ru and Lazarus team
|
|
original conception from rx library for Delphi (c)
|
|
|
|
This library is free software; you can redistribute it and/or modify it
|
|
under the terms of the GNU Library General Public License as published by
|
|
the Free Software Foundation; either version 2 of the License, or (at your
|
|
option) any later version with the following modification:
|
|
|
|
As a special exception, the copyright holders of this library give you
|
|
permission to link this library with independent modules to produce an
|
|
executable, regardless of the license terms of these independent modules,and
|
|
to copy and distribute the resulting executable under terms of your choice,
|
|
provided that you also meet, for each linked independent module, the terms
|
|
and conditions of the license of that module. An independent module is a
|
|
module which is not derived from or based on this library. If you modify
|
|
this library, you may extend this exception to your version of the library,
|
|
but you are not obligated to do so. If you do not wish to do so, delete this
|
|
exception statement from your version.
|
|
|
|
This program is distributed in the hope that it will be useful, but WITHOUT
|
|
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
|
|
for more details.
|
|
|
|
You should have received a copy of the GNU Library General Public License
|
|
along with this library; if not, write to the Free Software Foundation,
|
|
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
|
}
|
|
|
|
unit RxDBTimeEdit;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
|
|
RxTimeEdit, DB, DbCtrls, LMessages, LCLType;
|
|
|
|
type
|
|
|
|
{ TCustomRxDBTimeEdit }
|
|
|
|
TCustomRxDBTimeEdit = class(TCustomRxTimeEdit)
|
|
private
|
|
FDataLink: TFieldDataLink;
|
|
|
|
procedure DataChange(Sender: TObject);
|
|
function GetDataField: string;
|
|
function GetDataSource: TDataSource;
|
|
function GetField: TField;
|
|
procedure SetDataField(const AValue: string);
|
|
procedure SetDataSource(const AValue: TDataSource);
|
|
|
|
procedure UpdateData(Sender: TObject);
|
|
procedure FocusRequest(Sender: TObject);
|
|
procedure ActiveChange(Sender: TObject);
|
|
procedure LayoutChange(Sender: TObject);
|
|
procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
|
|
function IsReadOnly: boolean;
|
|
procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS;
|
|
procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS;
|
|
protected
|
|
function GetReadOnly: Boolean;override;
|
|
procedure SetReadOnly(AValue: Boolean);override;
|
|
property DataField: string read GetDataField write SetDataField;
|
|
property DataSource: TDataSource read GetDataSource write SetDataSource;
|
|
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
procedure Change; override;
|
|
|
|
procedure Loaded; override;
|
|
procedure Notification(AComponent: TComponent;
|
|
Operation: TOperation); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
property Field: TField read GetField;
|
|
end;
|
|
|
|
TRxDBTimeEdit = class(TCustomRxDBTimeEdit)
|
|
published
|
|
property DataField;
|
|
property DataSource;
|
|
property ReadOnly;
|
|
|
|
property AutoSize;
|
|
property AutoSelect;
|
|
property Align;
|
|
property Anchors;
|
|
property BorderSpacing;
|
|
property ButtonOnlyWhenFocused;
|
|
property ButtonHint;
|
|
property CharCase;
|
|
property Color;
|
|
// property DirectInput;
|
|
property DragCursor;
|
|
property DragMode;
|
|
property EchoMode;
|
|
property Enabled;
|
|
// property Flat;
|
|
property Font;
|
|
// property Glyph;
|
|
property MaxLength;
|
|
// property NumGlyphs;
|
|
property OnButtonClick;
|
|
property OnChange;
|
|
property OnClick;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEditingDone;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMouseDown;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnStartDrag;
|
|
property OnUTF8KeyPress;
|
|
property ParentColor;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PasswordChar;
|
|
property PopupMenu;
|
|
property ShowHint;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property Visible;
|
|
end;
|
|
|
|
|
|
implementation
|
|
uses rxdbutils, LCLVersion;
|
|
|
|
type
|
|
TFieldDataLinkHack = class(TFieldDataLink)
|
|
end;
|
|
|
|
{ TCustomRxDBTimeEdit }
|
|
|
|
procedure TCustomRxDBTimeEdit.DataChange(Sender: TObject);
|
|
begin
|
|
if Assigned(FDataLink.Field) and (FDataLink.Field.DataType in DataTimeTypes) then
|
|
Self.Time:=FDatalink.Field.AsDateTime
|
|
else
|
|
Text := '';
|
|
end;
|
|
|
|
function TCustomRxDBTimeEdit.GetDataField: string;
|
|
begin
|
|
Result := FDataLink.FieldName;
|
|
end;
|
|
|
|
function TCustomRxDBTimeEdit.GetDataSource: TDataSource;
|
|
begin
|
|
Result := FDataLink.DataSource;
|
|
end;
|
|
|
|
function TCustomRxDBTimeEdit.GetField: TField;
|
|
begin
|
|
Result := FDataLink.Field;
|
|
end;
|
|
|
|
function TCustomRxDBTimeEdit.GetReadOnly: Boolean;
|
|
begin
|
|
Result := FDataLink.ReadOnly;
|
|
end;
|
|
|
|
procedure TCustomRxDBTimeEdit.SetDataField(const AValue: string);
|
|
begin
|
|
FDataLink.FieldName := AValue;
|
|
end;
|
|
|
|
procedure TCustomRxDBTimeEdit.SetDataSource(const AValue: TDataSource);
|
|
begin
|
|
ChangeDataSource(Self,FDataLink,AValue);
|
|
end;
|
|
|
|
procedure TCustomRxDBTimeEdit.SetReadOnly(AValue: Boolean);
|
|
begin
|
|
inherited SetReadOnly(AValue);
|
|
FDataLink.ReadOnly := AValue;
|
|
end;
|
|
|
|
procedure TCustomRxDBTimeEdit.UpdateData(Sender: TObject);
|
|
var
|
|
D: Int64;
|
|
begin
|
|
if Assigned(FDataLink.Field) and (FDataLink.Field.DataType in DataTimeTypes) then
|
|
begin
|
|
D:=trunc(FDataLink.Field.AsDateTime);
|
|
FDataLink.Field.AsDateTime := D + Self.Time;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomRxDBTimeEdit.FocusRequest(Sender: TObject);
|
|
begin
|
|
SetFocus;
|
|
end;
|
|
|
|
procedure TCustomRxDBTimeEdit.ActiveChange(Sender: TObject);
|
|
begin
|
|
if FDatalink.Active then
|
|
DataChange(Sender)
|
|
else
|
|
begin
|
|
Text := '';
|
|
FDataLink.Reset;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomRxDBTimeEdit.LayoutChange(Sender: TObject);
|
|
begin
|
|
DataChange(Sender);
|
|
end;
|
|
|
|
procedure TCustomRxDBTimeEdit.CMGetDataLink(var Message: TLMessage);
|
|
begin
|
|
Message.Result := PtrUInt(FDataLink);
|
|
end;
|
|
|
|
function TCustomRxDBTimeEdit.IsReadOnly: boolean;
|
|
begin
|
|
result := true;
|
|
if FDatalink.Active and not Self.ReadOnly then
|
|
result := (Field=nil) or Field.ReadOnly;
|
|
end;
|
|
|
|
procedure TCustomRxDBTimeEdit.WMSetFocus(var Message: TLMSetFocus);
|
|
begin
|
|
inherited WMSetFocus(Message);
|
|
if not FDatalink.Editing then
|
|
FDatalink.Reset;
|
|
end;
|
|
|
|
procedure TCustomRxDBTimeEdit.WMKillFocus(var Message: TLMKillFocus);
|
|
begin
|
|
inherited WMKillFocus(Message);
|
|
if not FDatalink.Editing then
|
|
FDatalink.Reset
|
|
else
|
|
TFieldDataLinkHack(FDatalink).UpdateData;
|
|
end;
|
|
|
|
procedure TCustomRxDBTimeEdit.KeyDown(var Key: Word; Shift: TShiftState);
|
|
begin
|
|
inherited KeyDown(Key, Shift);
|
|
if Key=VK_ESCAPE then
|
|
begin
|
|
//cancel out of editing by reset on esc
|
|
FDataLink.Reset;
|
|
SelectAll;
|
|
Key := VK_UNKNOWN;
|
|
end
|
|
else
|
|
if Key=VK_DELETE then
|
|
begin
|
|
if not IsReadOnly then
|
|
FDatalink.Edit;
|
|
end
|
|
else
|
|
if Key=VK_TAB then
|
|
begin
|
|
if FDataLink.CanModify and FDatalink.Editing then
|
|
FDataLink.UpdateRecord;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomRxDBTimeEdit.Change;
|
|
begin
|
|
if Assigned(FDatalink) then
|
|
begin
|
|
//FDatalink.Edit;
|
|
FDataLink.Modified;
|
|
end;
|
|
inherited Change;
|
|
end;
|
|
|
|
procedure TCustomRxDBTimeEdit.Loaded;
|
|
begin
|
|
inherited Loaded;
|
|
if (csDesigning in ComponentState) then
|
|
DataChange(Self);
|
|
end;
|
|
|
|
procedure TCustomRxDBTimeEdit.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if (Operation=opRemove) then
|
|
begin
|
|
if (FDataLink<>nil) and (AComponent=DataSource) then
|
|
DataSource:=nil;
|
|
end;
|
|
end;
|
|
|
|
constructor TCustomRxDBTimeEdit.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FDataLink := TFieldDataLink.Create;
|
|
FDataLink.Control := Self;
|
|
FDataLink.OnDataChange := @DataChange;
|
|
FDataLink.OnUpdateData := @UpdateData;
|
|
FDataLink.OnActiveChange := @ActiveChange;
|
|
{$if (lcl_major = 0) and (lcl_release <= 30)}
|
|
FDataLink.OnLayoutChange := @LayoutChange;
|
|
{$endif}
|
|
end;
|
|
|
|
destructor TCustomRxDBTimeEdit.Destroy;
|
|
begin
|
|
FreeAndNil(FDataLink);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
end.
|