suidbctrls.pas

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

PAS
2,065
字号
////////////////////////////////////////////////////////////////////////////////
//
//
//  FileName    :   SUIDBCtrls.pas
//  Creator     :   Shen Min
//  Date        :   2003-01-19
//  Comment     :
//
//  Copyright (c) 2002-2003 Sunisoft
//  http://www.sunisoft.com
//  Email: support@sunisoft.com
//
////////////////////////////////////////////////////////////////////////////////

unit SUIDBCtrls;

interface

{$I SUIPack.inc}

uses Windows, Messages, Classes, DBCtrls, Graphics, Controls, Forms, DB,
     Mask, SysUtils, StdCtrls, Clipbrd, Menus,
{$IFDEF SUIPACK_D6UP}
     Types, Variants,
{$ENDIF}
     SUIThemes, SUIButton, SUIRadioGroup;

type
    TsuiDBEdit = class(TCustomMaskEdit)
    private
        m_BorderColor : TColor;

        FDataLink: TFieldDataLink;
        FCanvas: TControlCanvas;
        FAlignment: TAlignment;
        FFocused: Boolean;

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

        procedure ActiveChange(Sender: TObject);
        procedure DataChange(Sender: TObject);
        procedure EditingChange(Sender: TObject);
        function GetDataField: string;
        function GetDataSource: TDataSource;
        function GetField: TField;
        function GetReadOnly: Boolean;
        function GetTextMargins: TPoint;
        procedure ResetMaxLength;
        procedure SetDataField(const Value: string);
        procedure SetDataSource(Value: TDataSource);
        procedure SetFocused(Value: Boolean);
        procedure SetReadOnly(Value: Boolean);
        procedure UpdateData(Sender: TObject);
        procedure WMCut(var Message: TMessage); message WM_CUT;
        procedure WMPaste(var Message: TMessage); message WM_PASTE;
        procedure WMUndo(var Message: TMessage); message WM_UNDO;
        procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
        procedure CMExit(var Message: TCMExit); message CM_EXIT;
        procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
        procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
    protected
        procedure Change; override;
        function EditCanModify: Boolean; 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 Reset; 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;

    published
        property BorderColor : TColor read m_BorderColor write SetBorderColor;

        property DataField: string read GetDataField write SetDataField;
        property DataSource: TDataSource read GetDataSource write SetDataSource;
        property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;

        property Anchors;
        property AutoSelect;
        property AutoSize;
        property BiDiMode;
        property CharCase;
        property Color;
        property Constraints;
        property DragCursor;
        property DragKind;
        property DragMode;
        property Enabled;
        property Font;
        property ImeMode;
        property ImeName;
        property MaxLength;
        property ParentBiDiMode;
        property ParentColor;
        property ParentFont;
        property ParentShowHint;
        property PasswordChar;
        property PopupMenu;
        property ShowHint;
        property TabOrder;
        property TabStop;
        property Visible;

        property OnChange;
        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;

    TsuiDBMemo = class(TCustomMemo)
    private
        m_BorderColor : TColor;

        FDataLink: TFieldDataLink;
        FAutoDisplay: Boolean;
        FFocused: Boolean;
        FMemoLoaded: Boolean;
        FPaintControl: TPaintControl;

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

        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 SetReadOnly(Value: Boolean);
        procedure SetAutoDisplay(Value: Boolean);
        procedure SetFocused(Value: Boolean);
        procedure UpdateData(Sender: TObject);
        procedure WMCut(var Message: TMessage); message WM_CUT;
        procedure WMPaste(var Message: TMessage); message WM_PASTE;
        procedure WMUndo(var Message: TMessage); message WM_UNDO;
        procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
        procedure CMExit(var Message: TCMExit); message CM_EXIT;
        procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
        procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
        procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;

    protected
        procedure Change; 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 WndProc(var Message: TMessage); override;

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

    published
        property BorderColor : TColor read m_BorderColor write SetBorderColor;

        property Align;
        property Alignment;
        property Anchors;
        property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
        property BiDiMode;
        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 Enabled;
        property Font;
        property HideSelection;
        property ImeMode;
        property ImeName;
        property MaxLength;
        property ParentBiDiMode;
        property ParentColor;
        property ParentFont;
        property ParentShowHint;
        property PopupMenu;
        property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
        property ScrollBars;
        property ShowHint;
        property TabOrder;
        property TabStop;
        property Visible;
        property WantReturns;
        property WantTabs;
        property WordWrap;

        property OnChange;
        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;

    TsuiDBImage = class(TCustomControl)
    private
        m_BorderColor : TColor;

        FDataLink: TFieldDataLink;
        FPicture: TPicture;
        FBorderStyle: TBorderStyle;
        FAutoDisplay: Boolean;
        FStretch: Boolean;
        FCenter: Boolean;
        FPictureLoaded: Boolean;
        FQuickDraw: Boolean;

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

        procedure DataChange(Sender: TObject);
        function GetDataField: string;
        function GetDataSource: TDataSource;
        function GetField: TField;
        function GetReadOnly: Boolean;
        procedure PictureChanged(Sender: TObject);
        procedure SetAutoDisplay(Value: Boolean);
        procedure SetCenter(Value: Boolean);
        procedure SetDataField(const Value: string);
        procedure SetDataSource(Value: TDataSource);
        procedure SetPicture(Value: TPicture);
        procedure SetReadOnly(Value: Boolean);
        procedure SetStretch(Value: Boolean);
        procedure UpdateData(Sender: TObject);
        procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
        procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
        procedure CMExit(var Message: TCMExit); message CM_EXIT;
        procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
        procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
        procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
        procedure WMCut(var Message: TMessage); message WM_CUT;
        procedure WMCopy(var Message: TMessage); message WM_COPY;
        procedure WMPaste(var Message: TMessage); message WM_PASTE;
        procedure WMSize(var Message: TMessage); message WM_SIZE;

    protected
        procedure CreateParams(var Params: TCreateParams); override;
        function GetPalette: HPALETTE; override;
        procedure KeyDown(var Key: Word; Shift: TShiftState); override;
        procedure KeyPress(var Key: Char); override;
        procedure Notification(AComponent: TComponent;
          Operation: TOperation); override;
        procedure Paint; override;

    public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
        procedure CopyToClipboard;
        procedure CutToClipboard;
        function ExecuteAction(Action: TBasicAction): Boolean; override;
        procedure LoadPicture;
        procedure PasteFromClipboard;
        function UpdateAction(Action: TBasicAction): Boolean; override;
        property Field: TField read GetField;
        property Picture: TPicture read FPicture write SetPicture;

    published
        property BorderColor : TColor read m_BorderColor write SetBorderColor;

        property Align;
        property Anchors;
        property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
        property Center: Boolean read FCenter write SetCenter default True;
        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 Enabled;
        property Font;
        property ParentColor default False;
        property ParentFont;
        property ParentShowHint;
        property PopupMenu;
        property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
        property QuickDraw: Boolean read FQuickDraw write FQuickDraw default True;
        property ShowHint;
        property Stretch: Boolean read FStretch write SetStretch default False;
        property TabOrder;
        property TabStop default True;
        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;

    TsuiDBListBox = class(TCustomListBox)
    private
        m_BorderColor : TColor;

        FDataLink: TFieldDataLink;

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

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

    protected
        procedure Click; override;
        procedure KeyDown(var Key: Word; Shift: TShiftState); override;
        procedure KeyPress(var Key: Char); override;
        procedure Notification(AComponent: TComponent;
          Operation: TOperation); 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;

    published
        property BorderColor : TColor read m_BorderColor write SetBorderColor;

        property Align;
        property Anchors;
{$IFDEF SUIPACK_D6UP}
        property AutoComplete;
{$ENDIF}
        property BiDiMode;
        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 Enabled;
        property Font;
        property ImeMode;
        property ImeName;
        property IntegralHeight;
        property ItemHeight;

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?