suidbctrls.pas

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

        property Items write SetItems;
        property ParentBiDiMode;
        property ParentColor;
        property ParentFont;
        property ParentShowHint;
        property PopupMenu;
        property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
        property ShowHint;
        property Style;
        property TabOrder;
        property TabStop;
        property Visible;

        property OnClick;
        property OnContextPopup;
        property OnDblClick;
        property OnDragDrop;
        property OnDragOver;
        property OnDrawItem;
        property OnEndDock;
        property OnEndDrag;
        property OnEnter;
        property OnExit;
        property OnKeyDown;
        property OnKeyPress;
        property OnKeyUp;
        property OnMeasureItem;
        property OnMouseDown;
        property OnMouseMove;
        property OnMouseUp;
        property OnStartDock;
        property OnStartDrag;

    end;

    TsuiDBComboBox = class(TCustomComboBox)
    private
        m_BorderColor : TColor;
        m_ButtonColor : TColor;
        m_ArrowColor : TColor;
        m_UIStyle : TsuiUIStyle;

        FDataLink: TFieldDataLink;
        FPaintControl: TPaintControl;

        procedure SetBorderColor(const Value: TColor);
        procedure WMEARSEBKGND(var Msg : TMessage); message WM_ERASEBKGND;

        procedure DrawButton();
        procedure DrawArrow(const ACanvas : TCanvas;X, Y : Integer);

        procedure SetArrowColor(const Value: TColor);
        procedure SetButtonColor(const Value: TColor);
        procedure SetUIStyle(const Value: TsuiUIStyle);

        procedure DataChange(Sender: TObject);
        procedure EditingChange(Sender: TObject);
        function GetComboText: string;
        function GetDataField: string;
        function GetDataSource: TDataSource;
        function GetField: TField;
        function GetReadOnly: Boolean;
        procedure SetComboText(const Value: string);
        procedure SetDataField(const Value: string);
        procedure SetDataSource(Value: TDataSource);
        procedure SetEditReadOnly;
        procedure SetReadOnly(Value: Boolean);
        procedure UpdateData(Sender: TObject);
        procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
        procedure CMExit(var Message: TCMExit); message CM_EXIT;
        procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
        procedure WMPaint(var Message: TWMPaint); message WM_PAINT;

    protected
        procedure SetEnabled(Value: Boolean); override;
        procedure Change; override;
        procedure Click; override;
        procedure ComboWndProc(var Message: TMessage; ComboWnd: HWnd;
          ComboProc: Pointer); override;
        procedure CreateWnd; override;
        procedure DropDown; override;
        procedure KeyDown(var Key: Word; Shift: TShiftState); override;
        procedure KeyPress(var Key: Char); override;
        procedure Loaded; override;
        procedure Notification(AComponent: TComponent;
          Operation: TOperation); override;
        procedure SetItems(const Value: TStrings); {$IFDEF SUIPACK_D6UP} override; {$ENDIF}
        procedure SetStyle(Value: TComboboxStyle); override;
        procedure WndProc(var Message: TMessage); override;

    public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
        function ExecuteAction(Action: TBasicAction): Boolean; override;
        function UpdateAction(Action: TBasicAction): Boolean; override;
        function UseRightToLeftAlignment: Boolean; override;
        property Field: TField read GetField;
        property Text;

    published
        property UIStyle : TsuiUIStyle read m_UIStyle write SetUIStyle;
        property BorderColor : TColor read m_BorderColor write SetBorderColor;
        property ArrowColor : TColor read m_ArrowColor write SetArrowColor;
        property ButtonColor : TColor read m_ButtonColor write SetButtonColor;

        property Style; {Must be published before Items}
        property Anchors;
{$IFDEF SUIPACK_D6UP}
        property AutoComplete;
        property AutoDropDown;
{$ENDIF}
        property BiDiMode;
        property CharCase;
        property Color;
        property Constraints;
        property DataField: string read GetDataField write SetDataField;
        property DataSource: TDataSource read GetDataSource write SetDataSource;
        property DragCursor;
        property DragKind;
        property DragMode;
        property DropDownCount;
        property Enabled;
        property Font;
        property ImeMode;
        property ImeName;
        property ItemHeight;
        property Items write SetItems;
        property ParentBiDiMode;
        property ParentColor;
        property ParentFont;
        property ParentShowHint;
        property PopupMenu;
        property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
        property ShowHint;
        property Sorted;
        property TabOrder;
        property TabStop;
        property Visible;

        property OnChange;
        property OnClick;
        property OnContextPopup;
        property OnDblClick;
        property OnDragDrop;
        property OnDragOver;
        property OnDrawItem;
        property OnDropDown;
        property OnEndDock;
        property OnEndDrag;
        property OnEnter;
        property OnExit;
        property OnKeyDown;
        property OnKeyPress;
        property OnKeyUp;
        property OnMeasureItem;
        property OnStartDock;
        property OnStartDrag;

    end;

    TsuiDBCheckBox = class(TsuiCheckBox)
    private
        FDataLink: TFieldDataLink;
        FValueCheck: string;
        FValueUncheck: string;
        FPaintControl: TPaintControl;
        procedure DataChange(Sender: TObject);
        function GetDataField: string;
        function GetDataSource: TDataSource;
        function GetField: TField;
        function GetFieldState: TCheckBoxState;
        function GetReadOnly: Boolean;
        procedure SetDataField(const Value: string);
        procedure SetDataSource(Value: TDataSource);
        procedure SetReadOnly(Value: Boolean);
        procedure SetValueCheck(const Value: string);
        procedure SetValueUncheck(const Value: string);
        procedure UpdateData(Sender: TObject);
        function ValueMatch(const ValueList, Value: string): Boolean;
        procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
        procedure CMExit(var Message: TCMExit); message CM_EXIT;
        procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;

    protected
        procedure Toggle; override;
        procedure KeyPress(var Key: Char); override;
        procedure Notification(AComponent: TComponent;
          Operation: TOperation); override;
        procedure WndProc(var Message: TMessage); override;

    public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
        function ExecuteAction(Action: TBasicAction): Boolean; override;
        function UpdateAction(Action: TBasicAction): Boolean; override;
        function UseRightToLeftAlignment: Boolean; override;
        property Checked;
        property Field: TField read GetField;
        property State;

    published
        property DataField: string read GetDataField write SetDataField;
        property DataSource: TDataSource read GetDataSource write SetDataSource;
        property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
        property ValueChecked: string read FValueCheck write SetValueCheck;
        property ValueUnchecked: string read FValueUncheck write SetValueUncheck;

    end;

    TsuiDBRadioGroup = class(TsuiRadioGroup)
    private
        FDataLink: TFieldDataLink;
        FValue: string;
        FValues: TStrings;
        FInSetValue: Boolean;
        FOnChange: TNotifyEvent;

        procedure DataChange(Sender: TObject);
        procedure UpdateData(Sender: TObject);
        function GetDataField: string;
        function GetDataSource: TDataSource;
        function GetField: TField;
        function GetReadOnly: Boolean;
        function GetButtonValue(Index: Integer): string;
        procedure SetDataField(const Value: string);
        procedure SetDataSource(Value: TDataSource);
        procedure SetReadOnly(Value: Boolean);
        procedure SetValue(const Value: string);
        procedure SetItems(Value: TStrings);
        procedure SetValues(Value: TStrings);
        procedure CMExit(var Message: TCMExit); message CM_EXIT;
        procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;

    protected
        procedure Change; dynamic;        
        procedure Click; override;
        procedure KeyPress(var Key: Char); override;
        function CanModify: Boolean;
        procedure Notification(AComponent: TComponent;
          Operation: TOperation); override;
        property DataLink: TFieldDataLink read FDataLink;

      public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
        function ExecuteAction(Action: TBasicAction): Boolean; override;
        function UpdateAction(Action: TBasicAction): Boolean; override;
        function UseRightToLeftAlignment: Boolean; override;
        property Field: TField read GetField;
        property ItemIndex;
        property Value: string read FValue write SetValue;

      published
        property DataField: string read GetDataField write SetDataField;
        property DataSource: TDataSource read GetDataSource write SetDataSource;
        property Items write SetItems;
        property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
        property Values: TStrings read FValues write SetValues;

        property OnChange: TNotifyEvent read FOnChange write FOnChange;

    end;

    TsuiDBLookupControl = class;

    TsuiDataSourceLink = class(TDataLink)
    private
        FDBLookupControl: TsuiDBLookupControl;
    protected
        procedure FocusControl(Field: TFieldRef); override;
        procedure ActiveChanged; override;
        procedure LayoutChanged; override;
        procedure RecordChanged(Field: TField); override;
    public
        constructor Create;
    end;

    TsuiListSourceLink = class(TDataLink)
    private
        FDBLookupControl: TsuiDBLookupControl;
    protected
      procedure ActiveChanged; override;
        procedure DataSetChanged; override;
        procedure LayoutChanged; override;
    public
        constructor Create;
    end;

    TsuiDBLookupControl = class(TCustomControl)
    private
        FLookupSource: TDataSource;
        FDataLink: TsuiDataSourceLink;
        FListLink: TsuiListSourceLink;
        FDataFieldName: string;
        FKeyFieldName: string;
        FListFieldName: string;
        FListFieldIndex: Integer;
        FDataField: TField;
        FMasterField: TField;
        FKeyField: TField;
        FListField: TField;
        FListFields: TList;
        FKeyValue: Variant;
        FSearchText: string;
        FLookupMode: Boolean;
        FListActive: Boolean;
        FHasFocus: Boolean;
        FNullValueKey: TShortCut;

        procedure CheckNotCircular;
        procedure CheckNotLookup;
        procedure DataLinkRecordChanged(Field: TField);
        function GetDataSource: TDataSource;
        function GetKeyFieldName: string;
        function GetListSource: TDataSource;
        function GetReadOnly: Boolean;
        procedure SetDataFieldName(const Value: string);
        procedure SetDataSource(Value: TDataSource);
        procedure SetKeyFieldName(const Value: string);
        procedure SetKeyValue(const Value: Variant);
        procedure SetListFieldName(const Value: string);
        procedure SetListSource(Value: TDataSource);
        procedure SetLookupMode(Value: Boolean);
        procedure SetReadOnly(Value: Boolean);
        procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE;
        procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
        procedure WMKillFocus(var Message: TMessage); message WM_KILLFOCUS;
        procedure WMSetFocus(var Message: TMessage); message WM_SETFOCUS;
        procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
        procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;

    protected
        function CanModify: Boolean; virtual;
        function GetBorderSize: Integer; virtual;
        function GetTextHeight: Integer; virtual;
        procedure KeyValueChanged; virtual;
        procedure ListLinkDataChanged; virtual;
        function LocateKey: Boolean; virtual;
        procedure Notification(AComponent: TComponent;
          Operation: TOperation); override;
        procedure ProcessSearchKey(Key: Char); virtual;
        procedure SelectKeyValue(const Value: Variant); virtual;
        procedure UpdateDataFields; virtual;
        procedure UpdateListFields; virtual;
        property DataField: string read FDataFieldName write SetDataFieldName;
        property DataLink: TsuiDataSourceLink read FDataLink;
        property DataSource: TDataSource read GetDataSource write SetDataSource;
        property HasFocus: Boolean read FHasFocus;
        property KeyField: string read GetKeyFieldName write SetKeyFieldName;
        property KeyValue: Variant read FKeyValue write SetKeyValue;
        property ListActive: Boolean read FListActive;
        property ListField: string read FListFieldName write SetListFieldName;
        property ListFieldIndex: Integer read FListFieldIndex write FListFieldIndex default 0;
        property ListFields: TList read FListFields;
        property ListLink: TsuiListSourceLink read FListLink;
        property ListSource: TDataSource read GetListSource write SetListSource;
        property NullValueKey: TShortCut read FNullValueKey write FNullValueKey default 0;
        property ParentColor default False;
        property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
        property SearchText: string read FSearchText write FSearchText;
        property TabStop default True;

    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 FDataField;

    end;

    TsuiDBLookupListBox = class(TsuiDBLookupControl)
    private
        m_BorderColor : TColor;

        FRecordIndex: Integer;
        FRecordCount: Integer;
        FRowCount: Integer;
        FBorderStyle: TBorderStyle;
        FPopup: Boolean;
        FKeySelected: Boolean;
        FTracking: Boolean;
        FTimerActive: Boolean;
        FLockPosition: Boolean;
        FMousePos: Integer;
        FSelectedItem: string;

        procedure SetBorderColor(const Value: TColor);
        procedure WMPAINT(var Msg : TMessage); message WM_PAINT;
        procedure WMEARSEBKGND(var Msg : TMessage); message WM_ERASEBKGND;

        function GetKeyIndex: Integer;
        procedure SelectCurrent;
        procedure SelectItemAt(X, Y: Integer);
        procedure SetBorderStyle(Value: TBorderStyle);
        procedure SetRowCount(Value: Integer);
        procedure StopTimer;
        procedure StopTracking;
        procedure TimerScroll;
        procedure UpdateScrollBar;
        procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
        procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
        procedure WMCancelMode(var Message: TMessage); message WM_CANCELMODE;
        procedure WMTimer(var Message: TMessage); message WM_TIMER;
        procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;

    protected
        procedure CreateParams(var Params: TCreateParams); override;
        procedure CreateWnd; override;
        procedure KeyDown(var Key: Word; Shift: TShiftState); override;
        procedure KeyPress(var Key: Char); override;
        procedure KeyValueChanged; override;
        procedure ListLinkDataChanged; override;