lbdbcurrencyctrls.pas

天涯進銷存系統

unit LBDBCurrencyCtrls;


interface

uses Messages, SysUtils, Classes, Controls, Windows, DB, DbCtrls,
     LBCurrencyCtrls;

type
  TLBDBCurrencyEdit = class(TLBCustomCurrencyEdit)
  private
    FDataLink: TFieldDataLink;
    FFocused: Boolean;
    procedure DataChange(Sender: TObject);
    procedure EditingChange(Sender: TObject);
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;
    function GetReadOnly: Boolean;
    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure SetFocused(Value: Boolean);
    procedure SetReadOnly(Value: Boolean);
    procedure UpdateData(Sender: TObject);
    procedure WMKeyDown(var Message: TMessage); message WM_KEYDOWN;    
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
  protected
    procedure BeforeChange; override;
    function EditCanModify: Boolean; virtual;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure Reset; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function ExecuteAction(Action: TBasicAction): Boolean; override;
    function UpdateAction(Action: TBasicAction): Boolean; override;
    property Field: TField read GetField;
  published
    property BorderStyle;
    property CellWidth;
    property Color;
    property Ctl3D;
    property CurrencySymbol;
    property CurrencySymbolAligned;
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property DecimalNumber;
    property DecimalSeparatorColor;
    property DigitalNumber;
    property Enabled;
    property FocusedColor;
    property Font;
    property GridLineColor;
    property GridLineWidth;
    property KilobitSeparatorColor;
    property MaxLength;
    property MoveOutAllowed;
    property NegativeColor;
    property NegativeFont;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
    property ShowHint;
    property ShowNegativeColor;
    property ShowNegativeFont;
    property ShowNegativeSign;
    property TabOrder;
    property TabStop;
    property TextLayout;
    property Visible;
    property Value;
    property ZeroEmpty;
    property OnBeforeChange;
    property OnMoveOut;    
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

implementation

{ TLBDBCurrencyEdit }


constructor TLBDBCurrencyEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  inherited ReadOnly := True;
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnEditingChange := EditingChange;
  FDataLink.OnUpdateData := UpdateData;
end;

destructor TLBDBCurrencyEdit.Destroy;
begin
  FDataLink.Free;
  FDataLink := nil;
  inherited Destroy;
end;

procedure TLBDBCurrencyEdit.Loaded;
begin
  inherited Loaded;
  if (csDesigning in ComponentState) then DataChange(Self);
end;

procedure TLBDBCurrencyEdit.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and
    (AComponent = DataSource) then DataSource := nil;
end;

function TLBDBCurrencyEdit.EditCanModify: Boolean;
begin
  Result := FDataLink.Edit;
end;

procedure TLBDBCurrencyEdit.Reset;
begin
  FDataLink.Reset;
end;

procedure TLBDBCurrencyEdit.SetFocused(Value: Boolean);
begin
  if FFocused <> Value then
  begin
    FFocused := Value;
    FDataLink.Reset;
  end;
end;

procedure TLBDBCurrencyEdit.BeforeChange;
begin
  FDataLink.Edit;
  FDataLink.Modified;
  inherited BeforeChange;
end;

function TLBDBCurrencyEdit.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TLBDBCurrencyEdit.SetDataSource(Value: TDataSource);
begin
  if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
    FDataLink.DataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;

function TLBDBCurrencyEdit.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

procedure TLBDBCurrencyEdit.SetDataField(const Value: string);
begin
  FDataLink.FieldName := Value;
end;

function TLBDBCurrencyEdit.GetReadOnly: Boolean;
begin
  Result := FDataLink.ReadOnly;
end;

procedure TLBDBCurrencyEdit.SetReadOnly(Value: Boolean);
begin
  FDataLink.ReadOnly := Value;
end;

function TLBDBCurrencyEdit.GetField: TField;
begin
  Result := FDataLink.Field;
end;

procedure TLBDBCurrencyEdit.DataChange(Sender: TObject);
begin
  if (FDataLink.Field<>nil) and FDataLink.Dataset.Active then
  begin
    Value := FDataLink.Field.AsFloat;
//    if FDataLink.Editing then
//      Modified := True;
  end
  else
    Value := 0;
end;

procedure TLBDBCurrencyEdit.EditingChange(Sender: TObject);
begin
  inherited ReadOnly := not FDataLink.Editing;
end;

procedure TLBDBCurrencyEdit.UpdateData(Sender: TObject);
begin
  FDataLink.Field.AsFloat := Value;
end;

procedure TLBDBCurrencyEdit.WMKeyDown(var Message: TMessage);
begin
  with TWMKey(Message) do
    case CharCode of
      VK_ESCAPE:
        if FDataLink.Editing then
        begin
          FDataLink.Reset;
          CharCode := 0;
        end;
    end;

  inherited;
end;

procedure TLBDBCurrencyEdit.CMEnter(var Message: TCMEnter);
begin
  SetFocused(True);
  inherited;
  if FDataLink.CanModify then
    inherited ReadOnly := False;
end;

procedure TLBDBCurrencyEdit.CMExit(var Message: TCMExit);
begin
  try
    FDataLink.UpdateRecord;
  except
    SetFocus;
    raise;
  end;
  SetFocused(False);
  DoExit;
end;

procedure TLBDBCurrencyEdit.CMGetDataLink(var Message: TMessage);
begin
  Message.Result := Integer(FDataLink);
end;

function TLBDBCurrencyEdit.ExecuteAction(Action: TBasicAction): Boolean;
begin
  Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
    FDataLink.ExecuteAction(Action);
end;

function TLBDBCurrencyEdit.UpdateAction(Action: TBasicAction): Boolean;
begin
  Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
    FDataLink.UpdateAction(Action);
end;

end.