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 + -
显示快捷键?