cxdbedit.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 2,143 行 · 第 1/5 页

    property Visible;
    property OnClick;
{$IFDEF DELPHI5}
    property OnContextPopup;
{$ENDIF}
    property OnDblClick;
    property OnEditing;
    property OnEndDock;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
  end;

  { TcxDBRadioGroupButton }

  TcxDBRadioGroupButton = class(TcxCustomRadioGroupButton)
  private
    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  { TcxDBRadioGroup }

  TcxDBRadioGroup = class(TcxCustomRadioGroup)
  private
    function GetActiveProperties: TcxRadioGroupProperties;
    function GetDataBinding: TcxDBEditDataBinding;
    function GetProperties: TcxRadioGroupProperties;
    procedure SetDataBinding(Value: TcxDBEditDataBinding);
    procedure SetProperties(Value: TcxRadioGroupProperties);
    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
  public
    class function GetPropertiesClass: TcxCustomEditPropertiesClass; override;
    property ActiveProperties: TcxRadioGroupProperties read GetActiveProperties;
  protected
    function GetButtonInstance: TWinControl; override;
    class function GetDataBindingClass: TcxEditDataBindingClass; override;
  published
    property Align;
    property Alignment;
    property Anchors;
    property Caption;
    property Constraints;
    property Ctl3D;
    property DataBinding: TcxDBEditDataBinding read GetDataBinding
      write SetDataBinding;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property ParentBackground;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property Properties: TcxRadioGroupProperties read GetProperties
      write SetProperties;
    property ShowHint;
    property Style;
    property StyleDisabled;
    property StyleFocused;
    property StyleHot;
    property TabOrder;
    property TabStop;
    property Transparent;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEditing;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnStartDock;
    property OnStartDrag;
  end;

  { TcxDBListBox }

  TcxDBListBox = class(TcxListBox)
  private
    function GetDataBinding: TcxDBDataBinding;
    procedure SetDataBinding(Value: TcxDBDataBinding);
  protected
    function GetDataBindingClass: TcxCustomDataBindingClass; override;
  published
    property DataBinding: TcxDBDataBinding read GetDataBinding write SetDataBinding;
  end;

function GetcxDBEditDataLink(AEdit: TcxCustomEdit): TDataLink;

implementation

uses
  cxVariants, StdCtrls;

type
  TcxCustomEditAccess = class(TcxCustomEdit);

function GetcxDBEditDataLink(AEdit: TcxCustomEdit): TDataLink;
begin
  if TcxCustomEditAccess(AEdit).DataBinding is TcxDBEditDataBinding then
    Result := TcxDBEditDataBinding(TcxCustomEditAccess(AEdit).DataBinding).DataLink
  else
    Result := nil;
end;

{ TcxCustomDBEditDefaultValuesProvider }

constructor TcxCustomDBEditDefaultValuesProvider.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner);
  FFreeNotifier := TcxFreeNotificator.Create(nil);
  FFreeNotifier.OnFreeNotification := FieldFreeNotification;
end;

destructor TcxCustomDBEditDefaultValuesProvider.Destroy;
begin
  FreeAndNil(FFreeNotifier);
  inherited Destroy;
end;

function TcxCustomDBEditDefaultValuesProvider.CanSetEditMode: Boolean;
begin
  Result := (DataSource <> nil) and (DataSource.AutoEdit or
    (DataSource.State in [dsEdit, dsInsert]));
end;

function TcxCustomDBEditDefaultValuesProvider.DefaultAlignment: TAlignment;
begin
  if IsDataAvailable then
    Result := Field.Alignment
  else
    Result := inherited DefaultAlignment;
end;

function TcxCustomDBEditDefaultValuesProvider.DefaultBlobKind: TcxBlobKind;
begin
  if IsDataAvailable then
    case Field.DataType of
      ftMemo, ftFmtMemo:
        Result := bkMemo;
      ftGraphic:
        Result := bkGraphic;
      ftParadoxOle, ftDBaseOle:
        Result := bkOle;
      else
        Result := bkNone;
    end
  else
    Result := bkNone;
end;

function TcxCustomDBEditDefaultValuesProvider.DefaultCanModify: Boolean;
begin
  Result := not DefaultReadOnly and IsDataAvailable;
  Result := Result and (Field.CanModify or (Field.Lookup and CanModifyLookupField(Field)));
end;

function TcxCustomDBEditDefaultValuesProvider.DefaultDisplayFormat: string;
begin
  if IsDataAvailable and (Field is TNumericField) then
    Result := TNumericField(Field).DisplayFormat
  else
    Result := inherited DefaultDisplayFormat;
end;

function TcxCustomDBEditDefaultValuesProvider.DefaultEditFormat: string;
begin
  if IsDataAvailable and (Field is TNumericField) then
    Result := TNumericField(Field).EditFormat
  else
    Result := inherited DefaultEditFormat;
end;

function TcxCustomDBEditDefaultValuesProvider.DefaultEditMask: string;
begin
  if IsDataAvailable then
    Result := Field.EditMask
  else
    Result := inherited DefaultEditMask;
end;

function TcxCustomDBEditDefaultValuesProvider.DefaultIsFloatValue: Boolean;
begin
  if IsDataAvailable then
    Result := Field.DataType in [ftFloat, ftCurrency, ftBCD]
  else
    Result := inherited DefaultIsFloatValue;
end;

function TcxCustomDBEditDefaultValuesProvider.DefaultMaxLength: Integer;
begin
  if IsDataAvailable and (Field.DataType in [ftString{$IFDEF DELPHI4}, ftWideString{$ENDIF}]) then
    Result := Field.Size
  else
    Result := inherited DefaultMaxLength;
end;

function TcxCustomDBEditDefaultValuesProvider.DefaultMaxValue: Double;
begin
  Result := inherited DefaultMaxValue;
  if IsDataAvailable then
  begin
    if Field is TIntegerField then
      Result := TIntegerField(Field).MaxValue
    else
      if Field is TFloatField then
      begin
        Result := StrToFloat(FloatToStrF(TFloatField(Field).MaxValue, ffGeneral,
          TFloatField(Field).Precision, TFloatField(Field).Precision));
      end
    else
      if Field is TBCDField then
        Result := TBCDField(Field).MaxValue;
  end;
end;

function TcxCustomDBEditDefaultValuesProvider.DefaultMinValue: Double;
begin
  Result := inherited DefaultMinValue;
  if IsDataAvailable then
  begin
    if Field is TIntegerField then
      Result := TIntegerField(Field).MinValue
    else
      if Field is TFloatField then
      begin
        Result := StrToFloat(FloatToStrF(TFloatField(Field).MinValue, ffGeneral,
          TFloatField(Field).Precision, TFloatField(Field).Precision));
      end
    else
      if Field is TBCDField then
        Result := TBCDField(Field).MinValue;
  end;
end;

function TcxCustomDBEditDefaultValuesProvider.DefaultPrecision: Integer;
begin
  if Field is TFloatField then
    Result := TFloatField(Field).Precision
  else if Field is TBCDField then
    Result := TBCDField(Field).Precision
{$IFDEF DELPHI5}
  else if Field is TAggregateField then
    Result := TAggregateField(Field).Precision
{$ENDIF}
{$IFDEF DELPHI6}
  else if Field is TFMTBCDField then
    Result := TFMTBCDField(Field).Precision
{$ENDIF}
  else
    Result := inherited DefaultPrecision;
end;

function TcxCustomDBEditDefaultValuesProvider.DefaultReadOnly: Boolean;
begin
  if IsDataAvailable then
    Result := Field.ReadOnly
  else
    Result := inherited DefaultReadOnly;
end;

function TcxCustomDBEditDefaultValuesProvider.DefaultRequired: Boolean;
begin
  if IsDataAvailable then
    Result := Field.Required
  else
    Result := inherited DefaultRequired;
end;

function TcxCustomDBEditDefaultValuesProvider.IsBlob: Boolean;
begin
  Result := IsDataAvailable and Field.IsBlob;
end;

function TcxCustomDBEditDefaultValuesProvider.IsCurrency: Boolean;
begin
  Result := inherited IsCurrency;
  if IsDataAvailable then
    if Field is TFloatField then
      Result := TFloatField(Field).Currency
    else if Field is TBCDField then
      Result := TBCDField(Field).Currency
{$IFDEF DELPHI5}
    else if Field is TAggregateField then
      Result := TAggregateField(Field).Currency
{$ENDIF}
{$IFDEF DELPHI6}
    else if Field is TFMTBCDField then
      Result := TFMTBCDField(Field).Currency
{$ENDIF}
end;

function TcxCustomDBEditDefaultValuesProvider.IsDataAvailable: Boolean;
begin
  Result := (FField <> nil) and (FField.DataSet <> nil) and
    (FField.DataSet.State <> dsInactive);
end;

function TcxCustomDBEditDefaultValuesProvider.IsDataStorage: Boolean;
begin
  Result := True;
end;

function TcxCustomDBEditDefaultValuesProvider.IsDisplayFormatDefined(AIsCurrencyValueAccepted: Boolean): Boolean;
begin
  Result := IsDataAvailable;
  if Result and not Assigned(Field.OnGetText) then
  begin
    Result := False;
    if Field is TFloatField then
      Result := Result or TFloatField(Field).Currency and AIsCurrencyValueAccepted;
    if Field is TBCDField then
      Result := Result or TBCDField(Field).Currency and AIsCurrencyValueAccepted;
    if Field is TDateTimeField then
      Result := Result or (TDateTimeField(Field).DisplayFormat <> '');
{$IFDEF DELPHI5}
    if Field is TAggregateField then
      with TAggregateField(Field) do
        Result := Result or (DisplayFormat <> '') or Currency and AIsCurrencyValueAccepted;
{$ENDIF}
{$IFDEF DELPHI6}
    if Field is TFMTBCDField then
      Result := Result or TFMTBCDField(Field).Currency and AIsCurrencyValueAccepted;
    if Field is TSQLTimeStampField then
      Result := Result or (TSQLTimeStampField(Field).DisplayFormat <> '');
{$ENDIF}
    if Field is TNumericField then
      Result := Result or (TNumericField(Field).DisplayFormat <> '');
  end;
end;

function TcxCustomDBEditDefaultValuesProvider.IsOnGetTextAssigned: Boolean;
begin
  Result := IsDisplayFormatDefined(False) and (DefaultDisplayFormat = '');
end;

function TcxCustomDBEditDefaultValuesProvider.IsOnSetTextAssigned: Boolean;
begin
  Result := IsDataAvailable and Assigned(Field.OnSetText);
end;

function TcxCustomDBEditDefaultValuesProvider.IsValidChar(AChar: Char): Boolean;
begin
  if IsDataAvailable then
    Result := Field.IsValidChar(AChar)
  else
    Result := inherited IsValidChar(AChar);
end;

procedure TcxCustomDBEditDefaultValuesProvider.FieldFreeNotification(Sender: TComponent);
begin
  if Sender = DataSource then
    DataSource := nil
  else
    Field := nil;
end;

procedure TcxCustomDBEditDefaultValuesProvider.SetDataSource(Value: TDataSource);
begin
  if Value <> FDataSource then
  begin
    if FDataSource <> nil then
      FFreeNotifier.RemoveSender(FDataSource);
    FDataSource := Value;
    if FDataSource <> nil then
      FFreeNotifier.AddSender(FDataSource);
  end;
end;

procedure TcxCustomDBEditDefaultValuesProvider.SetField(Value: TField);
begin
  if Value <> FField then
  begin
    if FField <> nil then
      FFreeNotifier.RemoveSender(FField);
    FField := Value;
    if FField <> nil then
      FFreeNotifier.AddSender(FField);
  end;
end;

{ TcxDBFieldDataLink }

procedure TcxDBFieldDataLink.FocusControl(Field: TFieldRef);
var
  AVisualControl: TWinControl;
begin
  if not(DataBinding.VisualControl is TWinControl) then
    Exit;
  AVisualControl := TWinControl(DataBinding.VisualControl);
  if (Field^ <> nil) and (Field^ = Self.Field) and AVisualControl.CanFocus then
  begin
    Field^ := nil;
    AVisualControl.SetFocus;
  end;
end;

procedure TcxDBFieldDataLink.VisualControlChanged;
begin
  VisualControl := DataBinding.VisualControl is TWinControl;
end;

procedure TcxDBFieldDataLink.UpdateRightToLeft;
var
  AIsRightAligned: Boolean;
  AUseRightToLeftAlignment: Boolean;
  AVisualControl: TWinControl;
begin
  if DataBinding.VisualControl is TWinControl then
  begin
    AVisualControl := TWinControl(DataBinding.VisualControl);
    if AVisualControl.IsRightToLeft then
    begin
      AIsRightAligned :=
        (GetWindowLong(AVisualControl.Handle, GWL_EXSTYLE) and WS_EX_RIGHT) = WS_EX_RIGHT;
      AUseRightToLeftAlignment := DBUseRightToLeftAlignment(AVisualControl, Field);
      if AIsRightAligned and not AUseRightToLeftAlignment or