sncdbcurrency.pas

只要是汽车销售管理信息系统的Delphi控件源码

{ ******************************************************************
  sncDBCurrency version 1.1
  Copyright (C) 1999 by Moore Xu.  All Rights Reserved.
  e-mail: [e-mail]
  Description: very cool component set for chinese currency input.

  LICENCE CONDITIONS

  USE OF THE ENCLOSED SOFTWARE INDICATES YOUR ASSENT TO THE FOLLOWING
  LICENCE CONDITIONS:
  1. You are free to use sncCurrency in compiled form for any purpose.
  However, use in commercial or shareware applications requires registration.
  2. The sncCurrency source code or DCU, in whole or in part, modified or
  unmodified, may not be redistributed for profit or as part of another
  commercial or shareware software package without express written permission
  from me.
  3. Software using this code must contain a visible line of credit.
  This code is distributed "as is" without any warranties, express or implied.
  4. Register fee: $10 for person and $100 for organization.

  Created:     1999.06.01
  Last change: 1999.08.06
  History:
  1.0:  Initial release
  1.1:  Fixed bug and rewrite whole component in standard code
 ****************************************************************** }

unit sncDBCurrency;


{$R-}

interface

uses Messages, SysUtils, Classes, Controls, Windows, DbTables, DB, DbCtrls, sncCurrency;

type
  TsncDBCurrencyEdit = class(TsncCustomCurrencyEdit)
  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 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;

procedure Register;

implementation

{ TsncDBCurrencyEdit }

procedure Register;
begin
  RegisterComponents('SNC DB', [TsncDBCurrencyEdit]);
end;

constructor TsncDBCurrencyEdit.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 TsncDBCurrencyEdit.Destroy;
begin
  FDataLink.Free;
  FDataLink := nil;
  inherited Destroy;
end;

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

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

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

procedure TsncDBCurrencyEdit.Reset;
begin
  FDataLink.Reset;
end;

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

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

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

procedure TsncDBCurrencyEdit.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 TsncDBCurrencyEdit.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

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

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

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

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

procedure TsncDBCurrencyEdit.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 TsncDBCurrencyEdit.EditingChange(Sender: TObject);
begin
  inherited ReadOnly := not FDataLink.Editing;
end;

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

procedure TsncDBCurrencyEdit.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 TsncDBCurrencyEdit.CMEnter(var Message: TCMEnter);
begin
  SetFocused(True);
  inherited;
  if FDataLink.CanModify then
    inherited ReadOnly := False;
end;

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

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

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

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

end.