suidbctrls.pas

SUIPack是一款为Delphi和C++Builder开发的所见即所得的界面增强VCL组件

////////////////////////////////////////////////////////////////////////////////
//
//
//  FileName    :   SUIDBCtrls.pas
//  Creator     :   Shen Min
//  Date        :   2003-01-19 V1-V3
//                  2003-07-15 V4
//                  2006-06-16 V6
//  Comment     :
//
//  Copyright (c) 2002-2006 Sunisoft
//  http://www.sunisoft.com
//  Email: [e-mail]
//
////////////////////////////////////////////////////////////////////////////////

unit SUIDBCtrls;

interface

{$I SUIPack.inc}

uses Windows, Messages, Classes, DBCtrls, Graphics, Controls, Forms, DB,
     Mask, SysUtils, StdCtrls, Clipbrd, Menus, ExtCtrls, Math, Dialogs,
     DBGrids, Grids,
{$IFDEF SUIPACK_D6UP}
     Types, Variants,
{$ENDIF}
     SUIThemes, SUIButton, SUIRadioGroup, SUIScrollBar, SUIMgr, SUI2Define;

resourcestring
{$IFDEF LANG_CHS}
    SFirstRecord = '第一条记录';
    SPriorRecord = '前一条记录';
    SNextRecord = '下一条记录';
    SLastRecord = '最后一条记录';
    SInsertRecord = '插入记录';
    SDeleteRecord = '删除记录';
    SEditRecord = '修改记录';
    SPostEdit = '提交修改';
    SCancelEdit = '取消修改';
    SConfirmCaption = '确认';
    SRefreshRecord = '刷新数据';
    SDeleteRecordQuestion = '删除记录？';
    SDeleteMultipleRecordsQuestion = '删除所有选中的记录？';
    SDataSourceFixed = 'DBCtrlGrid不允许执行该操作';
    SNotReplicatable = '该控件不能在DBCtrlGridControl中使用';
    SPropDefByLookup = '该属性已经在查找字段中被定义';
    STooManyColumns = 'Grid被要求显示超过256列';
{$ELSE}
    SFirstRecord = 'First record';
    SPriorRecord = 'Prior record';
    SNextRecord = 'Next record';
    SLastRecord = 'Last record';
    SInsertRecord = 'Insert record';
    SDeleteRecord = 'Delete record';
    SEditRecord = 'Edit record';
    SPostEdit = 'Post edit';
    SCancelEdit = 'Cancel edit';
    SConfirmCaption = 'Confirm';
    SRefreshRecord = 'Refresh data';
    SDeleteRecordQuestion = 'Delete record?';
    SDeleteMultipleRecordsQuestion = 'Delete all selected records?';
    SDataSourceFixed = 'Operation not allowed in a DBCtrlGrid';
    SNotReplicatable = 'Control cannot be used in a DBCtrlGrid';
    SPropDefByLookup = 'Property already defined by lookup field';
    STooManyColumns = 'Grid requested to display more than 256 columns';
{$ENDIF}

type
{$IFDEF SUIPACK_D10}
    TButtonSet = TNavButtonSet;
{$ENDIF}
    TsuiDBEdit = class(TDBEdit)
    private
        m_BorderColor : TColor;
        m_UIStyle : TsuiUIStyle;
        m_FileTheme : TsuiFileTheme;
        
        procedure SetBorderColor(const Value: TColor);
        procedure SetFileTheme(const Value: TsuiFileTheme);
        procedure SetUIStyle(const Value: TsuiUIStyle);
        procedure WMEARSEBKGND(var Msg : TMessage); message WM_ERASEBKGND;
        procedure WMPaint(var Message: TWMPaint); message WM_PAINT;

    protected
        procedure Notification(AComponent: TComponent;
          Operation: TOperation); override;

    public
        constructor Create(AOwner: TComponent); override;

    published
        property FileTheme : TsuiFileTheme read m_FileTheme write SetFileTheme;
        property UIStyle : TsuiUIStyle read m_UIStyle write SetUIStyle;
        property BorderColor : TColor read m_BorderColor write SetBorderColor;

    end;

    TsuiDBMemo = class(TDBMemo)
    private
        m_BorderColor : TColor;
        m_MouseDown : Boolean;
        m_UIStyle : TsuiUIStyle;
        m_FileTheme : TsuiFileTheme;
        
        // scroll bar
        m_VScrollBar : TsuiScrollBar;
        m_HScrollBar : TsuiScrollBar;
        m_SelfChanging : Boolean;
        m_UserChanging : Boolean;
        
        procedure SetHScrollBar(const Value: TsuiScrollBar);
        procedure SetVScrollBar(const Value: TsuiScrollBar);
        procedure OnHScrollBarChange(Sender : TObject);
        procedure OnVScrollBarChange(Sender : TObject);
        procedure UpdateScrollBars();
        procedure UpdateScrollBarsPos();
        procedure UpdateInnerScrollBars();

        procedure CMEnabledChanged(var Msg : TMessage); message CM_ENABLEDCHANGED;
        procedure CMVisibleChanged(var Msg : TMessage); message CM_VISIBLECHANGED;
        procedure WMSIZE(var Msg : TMessage); message WM_SIZE;
        procedure WMMOVE(var Msg : TMessage); message WM_MOVE;
        procedure WMCut(var Message: TMessage); message WM_Cut;
        procedure WMPaste(var Message: TMessage); message WM_PASTE;
        procedure WMClear(var Message: TMessage); message WM_CLEAR;
        procedure WMUndo(var Message: TMessage); message WM_UNDO;
        procedure WMLBUTTONDOWN(var Message: TMessage); message WM_LBUTTONDOWN;
        procedure WMLButtonUp(var Message: TMessage); message WM_LBUTTONUP;
        procedure WMMOUSEWHEEL(var Message: TMessage); message WM_MOUSEWHEEL;
        procedure WMSetText(var Message:TWMSetText); message WM_SETTEXT;
        procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
        procedure WMMOUSEMOVE(var Message: TMessage); message WM_MOUSEMOVE;
        procedure WMVSCROLL(var Message: TWMVScroll); message WM_VSCROLL;
        procedure WMHSCROLL(var Message: TWMHScroll); message WM_HSCROLL;

        procedure WMPAINT(var Msg : TMessage); message WM_PAINT;
        procedure WMEARSEBKGND(var Msg : TMessage); message WM_ERASEBKGND;

        procedure SetBorderColor(const Value: TColor);
        procedure SetFileTheme(const Value: TsuiFileTheme);
        procedure SetUIStyle(const Value: TsuiUIStyle);
        
    protected
        procedure Notification(AComponent: TComponent; Operation: TOperation); override;

    public
        constructor Create(AOwner: TComponent); override;

    published
        property FileTheme : TsuiFileTheme read m_FileTheme write SetFileTheme;                    
        property UIStyle : TsuiUIStyle read m_UIStyle write SetUIStyle;
        property BorderColor : TColor read m_BorderColor write SetBorderColor;

        // scroll bar
        property VScrollBar : TsuiScrollBar read m_VScrollBar write SetVScrollBar;
        property HScrollBar : TsuiScrollBar read m_HScrollBar write SetHScrollBar;

    end;

    TsuiDBImage = class(TDBImage)
    private
        m_BorderColor : TColor;
        m_UIStyle : TsuiUIStyle;
        m_FileTheme : TsuiFileTheme;

        procedure SetFileTheme(const Value: TsuiFileTheme);
        procedure SetUIStyle(const Value: TsuiUIStyle);

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

    protected
        procedure Notification(AComponent: TComponent;
          Operation: TOperation); override;

    public
        constructor Create(AOwner: TComponent); override;

    published
        property FileTheme : TsuiFileTheme read m_FileTheme write SetFileTheme;
        property UIStyle : TsuiUIStyle read m_UIStyle write SetUIStyle;
        property BorderColor : TColor read m_BorderColor write SetBorderColor;

    end;

    TsuiDBListBox = class(TDBListBox)
    private
        m_BorderColor : TColor;
        m_UIStyle : TsuiUIStyle;
        m_FileTheme : TsuiFileTheme;

        // scroll bar
        m_VScrollBar : TsuiScrollBar;
        m_MouseDown : Boolean;
        m_SelfChanging : Boolean;
        procedure SetVScrollBar(const Value: TsuiScrollBar);
        procedure OnVScrollBarChange(Sender : TObject);
        procedure UpdateScrollBars();
        procedure UpdateScrollBarsPos();

        procedure CMEnabledChanged(var Msg : TMessage); message CM_ENABLEDCHANGED;
        procedure CMVisibleChanged(var Msg : TMEssage); message CM_VISIBLECHANGED;
        procedure WMSIZE(var Msg : TMessage); message WM_SIZE;
        procedure WMMOVE(var Msg : TMessage); message WM_MOVE;
        procedure WMMOUSEWHEEL(var Message: TMessage); message WM_MOUSEWHEEL;
        procedure WMLBUTTONDOWN(var Message: TMessage); message WM_LBUTTONDOWN;
        procedure WMLButtonUp(var Message: TMessage); message WM_LBUTTONUP;
        procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
        procedure LBADDSTRING(var Msg : TMessage); message LB_ADDSTRING;
        procedure LBDELETESTRING(var Msg : TMessage); message LB_DELETESTRING;
        procedure LBINSERTSTRING(var Msg : TMessage); message LB_INSERTSTRING;
        procedure LBSETCOUNT(var Msg : TMessage); message LB_SETCOUNT;
        procedure LBNSELCHANGE(var Msg : TMessage); message LBN_SELCHANGE;
        procedure LBNSETFOCUS(var Msg : TMessage); message LBN_SETFOCUS;
        procedure WMDELETEITEM(var Msg : TMessage); message WM_DELETEITEM;
        procedure WMMOUSEMOVE(var Message: TMessage); message WM_MOUSEMOVE;
        procedure WMVSCROLL(var Message: TWMVScroll); message WM_VSCROLL;
        procedure WMHSCROLL(var Message: TWMHScroll); message WM_HSCROLL;

        procedure WMPAINT(var Msg : TMessage); message WM_PAINT;
        procedure WMEARSEBKGND(var Msg : TMessage); message WM_ERASEBKGND;

        procedure SetBorderColor(const Value: TColor);
        procedure SetFileTheme(const Value: TsuiFileTheme);
        procedure SetUIStyle(const Value: TsuiUIStyle);
        
    protected
        procedure Notification(AComponent: TComponent; Operation: TOperation); override;

    public
        constructor Create(AOwner : TComponent); override;

    published
        property FileTheme : TsuiFileTheme read m_FileTheme write SetFileTheme;                    
        property UIStyle : TsuiUIStyle read m_UIStyle write SetUIStyle;
        property BorderColor : TColor read m_BorderColor write SetBorderColor;

        // scroll bar
        property VScrollBar : TsuiScrollBar read m_VScrollBar write SetVScrollBar;

    end;

    TsuiDBComboBox = class(TDBComboBox)
    private
        m_BorderColor : TColor;
        m_ButtonColor : TColor;
        m_ArrowColor : TColor;
        m_UIStyle : TsuiUIStyle;
        m_FileTheme : TsuiFileTheme;

        procedure SetBorderColor(const Value: TColor);
        procedure WMPAINT(var Msg : TMessage); message WM_PAINT;
        procedure WMEARSEBKGND(var Msg : TMessage); message WM_ERASEBKGND;
{$IFDEF SUIPACK_D5}
        procedure CBNCloseUp(var Msg : TWMCommand); message CN_COMMAND;
{$ENDIF}
        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 SetFileTheme(const Value: TsuiFileTheme);

    protected
        procedure SetEnabled(Value: Boolean); override;
        procedure Notification(AComponent: TComponent; Operation: TOperation); override;        
{$IFDEF SUIPACK_D5}
        procedure CloseUp(); virtual;
{$ENDIF}

    public
        constructor Create(AOwner : TComponent); override;

    published
        property FileTheme : TsuiFileTheme read m_FileTheme write SetFileTheme;
        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;
    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 NewClick; override;
        procedure KeyPress(var Key: Char); override;
        function CanModify: Boolean; override;
        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;
        property TabStop;
        property TabOrder;

    end;

    TsuiDBLookupListBox = class(TDBLookupListBox)
    private
        m_BorderColor : TColor;
        m_UIStyle : TsuiUIStyle;
        m_FileTheme : TsuiFileTheme;

        // scroll bar
        m_VScrollBar : TsuiScrollBar;
        m_MouseDown : Boolean;
        m_SelfChanging : Boolean;
        procedure SetVScrollBar(const Value: TsuiScrollBar);
        procedure OnVScrollBarChange(Sender : TObject);
        procedure UpdateScrollBars();
        procedure UpdateScrollBarsPos();

        procedure CMEnabledChanged(var Msg : TMessage); message CM_ENABLEDCHANGED;
        procedure WMSIZE(var Msg : TMessage); message WM_SIZE;
        procedure WMMOVE(var Msg : TMessage); message WM_MOVE;
        procedure WMMOUSEWHEEL(var Message: TMessage); message WM_MOUSEWHEEL;
        procedure WMLBUTTONDOWN(var Message: TMessage); message WM_LBUTTONDOWN;
        procedure WMLButtonUp(var Message: TMessage); message WM_LBUTTONUP;
        procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
        procedure LBADDSTRING(var Msg : TMessage); message LB_ADDSTRING;
        procedure LBDELETESTRING(var Msg : TMessage); message LB_DELETESTRING;
        procedure LBINSERTSTRING(var Msg : TMessage); message LB_INSERTSTRING;
        procedure LBSETCOUNT(var Msg : TMessage); message LB_SETCOUNT;
        procedure LBNSELCHANGE(var Msg : TMessage); message LBN_SELCHANGE;
        procedure LBNSETFOCUS(var Msg : TMessage); message LBN_SETFOCUS;
        procedure WMDELETEITEM(var Msg : TMessage); message WM_DELETEITEM;
        procedure WMMOUSEMOVE(var Message: TMessage); message WM_MOUSEMOVE;
        procedure WMVSCROLL(var Message: TWMVScroll); message WM_VSCROLL;
        procedure WMHSCROLL(var Message: TWMHScroll); message WM_HSCROLL;

        procedure WMPAINT(var Msg : TMessage); message WM_PAINT;
        procedure WMEARSEBKGND(var Msg : TMessage); message WM_ERASEBKGND;

        procedure SetBorderColor(const Value: TColor);
        procedure SetFileTheme(const Value: TsuiFileTheme);
        procedure SetUIStyle(const Value: TsuiUIStyle);
        
    protected