suidbctrls.pas

来自「新颖按钮控件」· PAS 代码 · 共 2,065 行 · 第 1/5 页

        procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
          X, Y: Integer); override;
        procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
        procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
          X, Y: Integer); override;
        procedure Paint; override;
        procedure UpdateListFields; override;

    public
        constructor Create(AOwner: TComponent); override;
        function ExecuteAction(Action: TBasicAction): Boolean; override;
        function UpdateAction(Action: TBasicAction): Boolean; override;
        function UseRightToLeftAlignment: Boolean; override;
        property KeyValue;
        property SelectedItem: string read FSelectedItem;
        procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;

    published
        property BorderColor : TColor read m_BorderColor write SetBorderColor;

        property Align;
        property Anchors;
        property BiDiMode;
        property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
        property Color;
        property Constraints;
        property DataField;
        property DataSource;
        property DragCursor;
        property DragKind;
        property DragMode;
        property Enabled;
        property Font;
        property ImeMode;
        property ImeName;
        property KeyField;
        property ListField;
        property ListFieldIndex;
        property ListSource;
        property NullValueKey;
        property ParentBiDiMode;
        property ParentColor;
        property ParentFont;
        property ParentShowHint;
        property PopupMenu;
        property ReadOnly;
        property RowCount: Integer read FRowCount write SetRowCount stored False;
        property ShowHint;
        property TabOrder;
        property TabStop;
        property Visible;
        property OnClick;
        property OnContextPopup;
        property OnDblClick;
        property OnDragDrop;
        property OnDragOver;
        property OnEndDock;
        property OnEndDrag;
        property OnEnter;
        property OnExit;
        property OnKeyDown;
        property OnKeyPress;
        property OnKeyUp;
        property OnMouseDown;
        property OnMouseMove;
        property OnMouseUp;
        property OnStartDock;
        property OnStartDrag;

    end;

    TsuiPopupDataList = class(TsuiDBLookupListBox)
    private
        procedure WMMouseActivate(var Message: TMessage); message WM_MOUSEACTIVATE;
    protected
        procedure CreateParams(var Params: TCreateParams); override;
    public
        constructor Create(AOwner: TComponent); override;
    end;

    TsuiDBLookupComboBox = class(TsuiDBLookupControl)
    private
        m_BorderColor : TColor;

        FDataList: TsuiPopupDataList;
        FButtonWidth: Integer;
        FText: string;
        FDropDownRows: Integer;
        FDropDownWidth: Integer;
        FDropDownAlign: TDropDownAlign;
        FListVisible: Boolean;
        FPressed: Boolean;
        FTracking: Boolean;
        FAlignment: TAlignment;
        FLookupMode: Boolean;
        FOnDropDown: TNotifyEvent;
        FOnCloseUp: TNotifyEvent;

        procedure SetBorderColor(const Value: TColor);

        procedure ListMouseUp(Sender: TObject; Button: TMouseButton;
          Shift: TShiftState; X, Y: Integer);
        procedure StopTracking;
        procedure TrackButton(X, Y: Integer);
        procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
        procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
        procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
        procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
        procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
        procedure WMCancelMode(var Message: TMessage); message WM_CANCELMODE;
        procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
        procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED;

    protected
        procedure CreateParams(var Params: TCreateParams); override;
        procedure Paint; override;
        procedure KeyDown(var Key: Word; Shift: TShiftState); override;
        procedure KeyPress(var Key: Char); override;
        procedure KeyValueChanged; override;
        procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
          X, Y: Integer); override;
        procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
        procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
          X, Y: Integer); override;
        procedure UpdateListFields; override;

    public
        constructor Create(AOwner: TComponent); override;
        procedure CloseUp(Accept: Boolean); virtual;
        procedure DropDown; virtual;
        function ExecuteAction(Action: TBasicAction): Boolean; override;
        procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
        function UpdateAction(Action: TBasicAction): Boolean; override;
        function UseRightToLeftAlignment: Boolean; override;
        property KeyValue;
        property ListVisible: Boolean read FListVisible;
        property Text: string read FText;

    published
        property BorderColor : TColor read m_BorderColor write SetBorderColor;

        property Anchors;
        property BiDiMode;
        property Color;
        property Constraints;
        property DataField;
        property DataSource;
        property DragCursor;
        property DragKind;
        property DragMode;
        property DropDownAlign: TDropDownAlign read FDropDownAlign write FDropDownAlign default daLeft;
        property DropDownRows: Integer read FDropDownRows write FDropDownRows default 7;
        property DropDownWidth: Integer read FDropDownWidth write FDropDownWidth default 0;
        property Enabled;
        property Font;
        property ImeMode;
        property ImeName;
        property KeyField;
        property ListField;
        property ListFieldIndex;
        property ListSource;
        property NullValueKey;
        property ParentBiDiMode;
        property ParentColor;
        property ParentFont;
        property ParentShowHint;
        property PopupMenu;
        property ReadOnly;
        property ShowHint;
        property TabOrder;
        property TabStop;
        property Visible;
        property OnClick;
        property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp;
        property OnContextPopup;
        property OnDragDrop;
        property OnDragOver;
        property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown;
        property OnEndDock;
        property OnEndDrag;
        property OnEnter;
        property OnExit;
        property OnKeyDown;
        property OnKeyPress;
        property OnKeyUp;
        property OnMouseDown;
        property OnMouseMove;
        property OnMouseUp;
        property OnStartDock;
        property OnStartDrag;
    end;

implementation

uses SUIPublic;

{ TsuiDBEdit }

procedure TsuiDBEdit.ResetMaxLength;
var
  F: TField;
begin
  if (MaxLength > 0) and Assigned(DataSource) and Assigned(DataSource.DataSet) then
  begin
    F := DataSource.DataSet.FindField(DataField);
    if Assigned(F) and (F.DataType in [ftString, ftWideString]) and (F.Size = MaxLength) then
      MaxLength := 0;
  end;
end;

constructor TsuiDBEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  inherited ReadOnly := True;
  ControlStyle := ControlStyle + [csReplicatable];
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnEditingChange := EditingChange;
  FDataLink.OnUpdateData := UpdateData;
  FDataLink.OnActiveChange := ActiveChange;

    ControlStyle := ControlStyle + [csOpaque];
    BorderStyle := bsNone;
    BorderWidth := 2;

    m_BorderColor := GetBorderColor(TCustomForm(AOwner));  
end;

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

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

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

function TsuiDBEdit.UseRightToLeftAlignment: Boolean;
begin
  Result := DBUseRightToLeftAlignment(Self, Field);
end;

procedure TsuiDBEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then
    FDataLink.Edit;
end;

procedure TsuiDBEdit.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
    not FDataLink.Field.IsValidChar(Key) then
  begin
    MessageBeep(0);
    Key := #0;
  end;
  case Key of
    ^H, ^V, ^X, #32..#255:
      FDataLink.Edit;
    #27:
      begin
        FDataLink.Reset;
        SelectAll;
        Key := #0;
      end;
  end;
end;

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

procedure TsuiDBEdit.Reset;
begin
  FDataLink.Reset;
  SelectAll;
end;

procedure TsuiDBEdit.SetFocused(Value: Boolean);
begin
  if FFocused <> Value then
  begin
    FFocused := Value;
    if (FAlignment <> taLeftJustify) and not IsMasked then Invalidate;
    FDataLink.Reset;
  end;
end;

procedure TsuiDBEdit.Change;
begin
  FDataLink.Modified;
  inherited Change;
end;

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

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

procedure TsuiDBEdit.SetDataField(const Value: string);
begin
  if not (csDesigning in ComponentState) then
    ResetMaxLength;
  FDataLink.FieldName := Value;
end;

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

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

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

procedure TsuiDBEdit.ActiveChange(Sender: TObject);
begin
  ResetMaxLength;
end;

procedure TsuiDBEdit.DataChange(Sender: TObject);
begin
  if FDataLink.Field <> nil then
  begin
    if FAlignment <> FDataLink.Field.Alignment then
    begin
      EditText := '';  {forces update}
      FAlignment := FDataLink.Field.Alignment;
    end;
    EditMask := FDataLink.Field.EditMask;
    if not (csDesigning in ComponentState) then
    begin
      if (FDataLink.Field.DataType in [ftString, ftWideString]) and (MaxLength = 0) then
        MaxLength := FDataLink.Field.Size;
    end;
    if FFocused and FDataLink.CanModify then
      Text := FDataLink.Field.Text
    else
    begin
      EditText := FDataLink.Field.DisplayText;
      if FDataLink.Editing then
        Modified := True;
    end;
  end else
  begin
    FAlignment := taLeftJustify;
    EditMask := '';
    if csDesigning in ComponentState then
      EditText := Name else
      EditText := '';
  end;
end;

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

procedure TsuiDBEdit.UpdateData(Sender: TObject);
begin
  ValidateEdit;
  FDataLink.Field.Text := Text;
end;

procedure TsuiDBEdit.WMUndo(var Message: TMessage);
begin
  FDataLink.Edit;
  inherited;
end;

procedure TsuiDBEdit.WMPaste(var Message: TMessage);
begin
  FDataLink.Edit;
  inherited;
end;

procedure TsuiDBEdit.WMCut(var Message: TMessage);