adbtimct.pas
来自「delphi编程控件」· PAS 代码 · 共 291 行
PAS
291 行
unit adbtimct;
(*
COPYRIGHT (c) RSD Software 1997 - 98
All Rights Reserved.
*)
interface
{$I aclver.inc}
uses Classes, ATimeCtl, DB, DBTables{$IFDEF DELPHI3_0}, dbctrls{$ENDIF};
type
TAutoDBTimeControl = class(TCustomAutoTimeControl)
private
FDataLink : TFieldDataLink;
FUpdateFlag : Boolean;
procedure DataChange(Sender: TObject);
procedure UpdateData(Sender: TObject);
function GetFieldName: String;
function GetDataSource: TDataSource;
function GetDataField: TField;
procedure SetFieldName(const Value: String);
procedure SetDataSource(Value: TDataSource);
protected
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure DoTimeChange; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Field: TField read GetDataField;
property Time;
published
property DataField: string read GetFieldName write SetFieldName;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property Align;
property DragCursor;
property DragMode;
property Enabled;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDrag;
property OnTimeChange;
end;
TAutoDBTimeEdit = class(TCustomAutoTimeEdit)
private
FDataLink : TFieldDataLink;
FUpdateFlag : Boolean;
procedure DataChange(Sender: TObject);
procedure UpdateData(Sender: TObject);
function GetFieldName: String;
function GetDataSource: TDataSource;
function GetDataField: TField;
procedure SetFieldName(const Value: String);
procedure SetDataSource(Value: TDataSource);
protected
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure DoTimeChange; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Field: TField read GetDataField;
property Time;
published
property DataField: string read GetFieldName write SetFieldName;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property AutoSelect;
property AutoSize;
property BorderStyle;
property Color;
property Ctl3D;
property DragCursor;
property DragMode;
property DropDownWidth;
property Enabled;
property Font;
{$IFDEF DELPHI3_0}
property ImeMode;
property ImeName;
{$ENDIF}
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnChange;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDrag;
property OnTimeChange;
end;
implementation
{TAutoDBTimeControl}
constructor TAutoDBTimeControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FDataLink := TFieldDataLink.Create;
FDataLink.Control := self;
FDataLink.OnDataChange := DataChange;
FDataLink.OnUpdateData := UpdateData;
FUpdateFlag := False;
end;
destructor TAutoDBTimeControl.Destroy;
begin
FDataLink.Free;
inherited Destroy;
end;
procedure TAutoDBTimeControl.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (FDataLink <> Nil) and
(AComponent = DataSource) then DataSource := nil;
end;
procedure TAutoDBTimeControl.DoTimeChange;
begin
if(FDataLink <> Nil) And (FDataLink.Field <> Nil) then
UpdateData(self);
inherited DoTimeChange;
end;
procedure TAutoDBTimeControl.DataChange(Sender: TObject);
begin
if (FDataLink.Field <> Nil) And Not FUpdateFlag then begin
FUpdateFlag := True;
Time := FDataLink.Field.AsDateTime;
FUpdateFlag := False;
end;
end;
procedure TAutoDBTimeControl.UpdateData(Sender: TObject);
begin
if Not FUpdateFlag then begin
FUpdateFlag := True;
FDataLink.Edit;
if FDataLink.Editing then
FDataLink.Field.AsDateTime := Time;
FUpdateFlag := False;
end;
end;
function TAutoDBTimeControl.GetFieldName: String;
begin
Result := FDataLink.FieldName;
end;
function TAutoDBTimeControl.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
function TAutoDBTimeControl.GetDataField: TField;
begin
Result := FDataLink.Field;
end;
procedure TAutoDBTimeControl.SetFieldName(const Value: String);
begin
FDataLink.FieldName := Value;
end;
procedure TAutoDBTimeControl.SetDataSource(Value: TDataSource);
begin
FDataLink.DataSource := Value;
if Value <> Nil then
Value.FreeNotification(Self);
end;
{TAutoDBTimeEdit}
constructor TAutoDBTimeEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FDataLink := TFieldDataLink.Create;
FDataLink.Control := self;
FDataLink.OnDataChange := DataChange;
FDataLink.OnUpdateData := UpdateData;
FUpdateFlag := False;
end;
destructor TAutoDBTimeEdit.Destroy;
begin
FDataLink.Free;
inherited Destroy;
end;
procedure TAutoDBTimeEdit.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (FDataLink <> Nil) and
(AComponent = DataSource) then DataSource := nil;
end;
procedure TAutoDBTimeEdit.DoTimeChange;
begin
if(FDataLink <> Nil) And (FDataLink.Field <> Nil) then
UpdateData(self);
inherited DoTimeChange;
end;
procedure TAutoDBTimeEdit.DataChange(Sender: TObject);
begin
if (FDataLink.Field <> Nil) And Not FUpdateFlag then begin
FUpdateFlag := True;
Time := FDataLink.Field.AsDateTime;
FUpdateFlag := False;
end;
end;
procedure TAutoDBTimeEdit.UpdateData(Sender: TObject);
begin
if Not FUpdateFlag then begin
FUpdateFlag := True;
FDataLink.Edit;
if FDataLink.Editing then
FDataLink.Field.AsDateTime := Time;
FUpdateFlag := False;
end;
end;
function TAutoDBTimeEdit.GetFieldName: String;
begin
Result := FDataLink.FieldName;
end;
function TAutoDBTimeEdit.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
function TAutoDBTimeEdit.GetDataField: TField;
begin
Result := FDataLink.Field;
end;
procedure TAutoDBTimeEdit.SetFieldName(const Value: String);
begin
FDataLink.FieldName := Value;
end;
procedure TAutoDBTimeEdit.SetDataSource(Value: TDataSource);
begin
FDataLink.DataSource := Value;
if Value <> Nil then
Value.FreeNotification(Self);
end;
end.
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?