suidbctrls.pas

SUIPack v6.40.Full.Source for Delphi 5 - 2009 (实际上 2010 上也能编译通过)

        
    protected
        procedure Notification(AComponent: TComponent; Operation: TOperation); override;
        procedure Loaded(); 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;

    TsuiDBLookupComboBox = class(TDBLookupComboBox)
    private
        m_BorderColor : TColor;
        m_ButtonColor : TColor;
        m_ArrowColor : TColor;
        m_UIStyle : TsuiUIStyle;
        m_FileTheme : TsuiFileTheme;

        procedure SetBorderColor(const Value: TColor);
        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;
        procedure Paint(); 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;
        property ArrowColor : TColor read m_ArrowColor write SetArrowColor;
        property ButtonColor : TColor read m_ButtonColor write SetButtonColor;

    end;

const
    InitRepeatPause = 400;  { pause before repeat timer (ms) }
    RepeatPause     = 100;  { pause before hint window displays (ms)}
    SpaceSize       =  5;   { size of space between special buttons }

type
    TsuiNavButton = class;
    TsuiNavDataLink = class;

    ENavClick = procedure (Sender: TObject; Button: TNavigateBtn) of object;

{ TsuiDBNavigator }

    TsuiDBNavigator = class (TCustomPanel)
    private
        m_UIStyle : TsuiUIStyle;
        m_FileTheme : TsuiFileTheme;
        m_Cursor : TCursor;

        FDataLink: TsuiNavDataLink;
        FVisibleButtons: TButtonSet;
        FHints: TStrings;
        FDefHints: TStrings;
        ButtonWidth: Integer;
        MinBtnSize: TPoint;
        FOnNavClick: ENavClick;
        FBeforeAction: ENavClick;
        FocusedButton: TNavigateBtn;
        FConfirmDelete: Boolean;
        procedure BtnMouseDown (Sender: TObject; Button: TMouseButton;
          Shift: TShiftState; X, Y: Integer);
        procedure ClickHandler(Sender: TObject);
        function GetDataSource: TDataSource;
        function GetHints: TStrings;
        procedure HintsChanged(Sender: TObject);
        procedure InitButtons;
        procedure InitHints;
        procedure SetDataSource(Value: TDataSource);
        procedure SetHints(Value: TStrings);
        procedure SetSize(var W: Integer; var H: Integer);
        procedure SetVisible(Value: TButtonSet);
        procedure WMSize(var Message: TWMSize);  message WM_SIZE;
        procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
        procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
        procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
        procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
        procedure WMWindowPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;
        procedure SetUIStyle(const Value: TsuiUIStyle);
        procedure SetFileTheme(const Value: TsuiFileTheme);
        procedure SetCursor(const Value: TCursor);
    protected
        Buttons: array[TNavigateBtn] of TsuiNavButton;
        procedure DataChanged;
        procedure EditingChanged;
        procedure ActiveChanged;
        procedure Loaded; override;
        procedure KeyDown(var Key: Word; Shift: TShiftState); override;
        procedure Notification(AComponent: TComponent;
          Operation: TOperation); override;
        procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
        procedure CalcMinSize(var W, H: Integer);

    public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
        procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
        procedure BtnClick(Index: TNavigateBtn); virtual;

    published
        property FileTheme : TsuiFileTheme read m_FileTheme write SetFileTheme;
        property UIStyle : TsuiUIStyle read m_UIStyle write SetUIStyle;

        property DataSource: TDataSource read GetDataSource write SetDataSource;
        property VisibleButtons: TButtonSet read FVisibleButtons write SetVisible
          default [nbFirst, nbPrior, nbNext, nbLast, nbInsert, nbDelete,
            nbEdit, nbPost, nbCancel, nbRefresh];
        property Cursor : TCursor read m_Cursor write SetCursor;
        property Align;
        property Anchors;
        property Constraints;
        property DragCursor;
        property DragKind;
        property DragMode;
        property Enabled;
        property Hints: TStrings read GetHints write SetHints;
        property ParentCtl3D;
        property ParentShowHint;
        property PopupMenu;
        property ConfirmDelete: Boolean read FConfirmDelete write FConfirmDelete default True;
        property ShowHint;
        property TabOrder;
        property TabStop;
        property Visible;
        property BeforeAction: ENavClick read FBeforeAction write FBeforeAction;
        property OnClick: ENavClick read FOnNavClick write FOnNavClick;
        property OnContextPopup;
        property OnDblClick;
        property OnDragDrop;
        property OnDragOver;
        property OnEndDock;
        property OnEndDrag;
        property OnEnter;
        property OnExit;
        property OnResize;
        property OnStartDock;
        property OnStartDrag;
    end;

{ TsuiNavButton }

    TsuiNavButton = class(TsuiButton)
    private
        FIndex: TNavigateBtn;
        FNavStyle: TNavButtonStyle;
        FRepeatTimer: TTimer;
        procedure TimerExpired(Sender: TObject);

    protected
        procedure Paint; override;
        procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
          X, Y: Integer); override;
        procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
          X, Y: Integer); override;
    public
        constructor Create(AOwner : TComponent); override;
        destructor Destroy; override;
        property NavStyle: TNavButtonStyle read FNavStyle write FNavStyle;
        property Index : TNavigateBtn read FIndex write FIndex;
    end;

{ TsuiNavDataLink }

    TsuiNavDataLink = class(TDataLink)
    private
        FNavigator: TsuiDBNavigator;
    protected
        procedure EditingChanged; override;
        procedure DataSetChanged; override;
        procedure ActiveChanged; override;
    public
        constructor Create(ANav: TsuiDBNavigator);
        destructor Destroy; override;
    end;

    TsuiDBGrid = class(TDBGrid)
    private
        m_BorderColor : TColor;
        m_FocusedColor : TColor;
        m_SelectedColor : TColor;
        m_UIStyle : TsuiUIStyle;
        m_FileTheme : TsuiFileTheme;
        m_MouseDown : Boolean;
        
        // 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 CMEnabledChanged(var Msg : TMessage); message CM_ENABLEDCHANGED;
        procedure CMVisibleChanged(var Msg : TMEssage); message CM_VISIBLECHANGED;
        procedure CMBIDIMODECHANGED(var Msg : TMessage); message CM_BIDIMODECHANGED;
        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 SetBorderColor(const Value: TColor);
        procedure WMEARSEBKGND(var Msg : TMessage); message WM_ERASEBKGND;
        procedure SetUIStyle(const Value: TsuiUIStyle);
        procedure SetFileTheme(const Value: TsuiFileTheme);
        procedure SetFocusedColor(const Value: TColor);
        procedure SetSelectedColor(const Value: TColor);
        function GetFontColor: TColor;
        procedure SetFontColor(const Value: TColor);
        function GetTitleFontColor: TColor;
        procedure SetTitleFontColor(const Value: TColor);
        function GetFixedBGColor: TColor;
        procedure SetFixedBGColor(const Value: TColor);
        function GetBGColor: TColor;
        procedure SetBGColor(const Value: TColor);

    protected
        procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
        procedure DrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); override;

        procedure Paint(); override;
        procedure Notification(AComponent: TComponent; Operation: TOperation); override;
        procedure Loaded(); 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;
        property FocusedColor : TColor read m_FocusedColor write SetFocusedColor;
        property SelectedColor : TColor read m_SelectedColor write SetSelectedColor;
        property FontColor : TColor read GetFontColor write SetFontColor;
        property TitleFontColor : TColor read GetTitleFontColor write SetTitleFontColor;
        property FixedBGColor : TColor read GetFixedBGColor write SetFixedBGColor;
        property BGColor : TColor read GetBGColor write SetBGColor;
        // scroll bar
        property VScrollBar : TsuiScrollBar read m_VScrollBar write SetVScrollBar;
        property HScrollBar : TsuiScrollBar read m_HScrollBar write SetHScrollBar;

    end;

implementation

uses SUIPublic, SUIProgressBar;

{ TsuiDBEdit }

constructor TsuiDBEdit.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);

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

    UIStyle := GetSUIFormStyle(AOwner);
end;

procedure TsuiDBEdit.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
    inherited Notification(AComponent, Operation);
    if (
        (Operation = opRemove) and
        (AComponent = m_FileTheme)
    )then
    begin
        m_FileTheme := nil;
        SetUIStyle(SUI_THEME_DEFAULT);
    end;
end;

procedure TsuiDBEdit.WMPaint(var Message: TWMPaint);
begin
    inherited;

    DrawControlBorder(self, m_BorderColor, Color);
end;

procedure TsuiDBEdit.WMEARSEBKGND(var Msg: TMessage);
begin
    inherited;

    DrawControlBorder(self, m_BorderColor, Color);
end;

procedure TsuiDBEdit.SetFileTheme(const Value: TsuiFileTheme);
begin
    m_FileTheme := Value;
    SetUIStyle(m_UIStyle);
end;

procedure TsuiDBEdit.SetUIStyle(const Value: TsuiUIStyle);
var
    OutUIStyle : TsuiUIStyle;
begin
    m_UIStyle := Value;
    if UsingFileTheme(m_FileTheme, m_UIStyle, OutUIStyle) then
        m_BorderColor := m_FileTheme.GetColor(SKIN2_CONTROLBORDERCOLOR)
    else
        m_BorderColor := GetInsideThemeColor(OutUIStyle, SUI_THEME_CONTROL_BORDER_COLOR);
    Repaint();
end;

procedure TsuiDBEdit.SetBorderColor(const Value: TColor);
begin
    m_BorderColor := Value;
    Repaint();
end;

{ TsuiDBMemo }

constructor TsuiDBMemo.Create(AOwner: TComponent);
begin
    inherited;
    
    ControlStyle := ControlStyle + [csOpaque];
    BorderStyle := bsNone;
    BorderWidth := 2;
    m_SelfChanging := false;
    m_UserChanging := false;
    m_MouseDown := false;
    UIStyle := GetSUIFormStyle(AOwner);
end;

procedure TsuiDBMemo.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
    inherited;

    if AComponent = nil then
        Exit;

    if (
        (Operation = opRemove) and
        (AComponent = m_HScrollBar)
    )then
    begin
        m_HScrollBar := nil;
        UpdateInnerScrollBars();
    end;

    if (
        (Operation = opRemove) and
        (AComponent = m_VScrollBar)
    )then
    begin
        m_VScrollBar := nil;
        UpdateInnerScrollBars();
    end;

    if (
        (Operation = opRemove) and
        (AComponent = m_FileTheme)
    )then
    begin
        m_FileTheme := nil;
        SetUIStyle(SUI_THEME_DEFAULT);          
    end;
end;

procedure TsuiDBMemo.WMCut(var Message: TMessage);
begin
  inherited;
  UpdateScrollBars();
end;

procedure TsuiDBMemo.WMUndo(var Message: TMessage);
begin
  inherited;
  UpdateScrollBars();
end;

procedure TsuiDBMemo.WMPaste(var Message: TMessage);
begin
  inherited;
  UpdateScrollBars();
end;

procedure TsuiDBMemo.WMPaint(var Msg : TMessage);
begin
    inherited;

    DrawControlBorder(self, m_BorderColor, Color);
end;

procedure TsuiDBMemo.SetBorderColor(const Value: TColor);
begin
    m_BorderColor := Value;
    Repaint();
end;

procedure TsuiDBMemo.WMEARSEBKGND(var Msg: TMessage);
begin