suisidechannel.pas

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

////////////////////////////////////////////////////////////////////////////////
//
//
//  FileName    :   SUISideChannel.pas
//  Creator     :   Shen Min
//  Date        :   2002-5-13 V1-V3
//                  2003-7-11 V4
//                  2006-6-14 V6
//  Comment     :
//
//  Copyright (c) 2002-2006 Sunisoft
//  http://www.sunisoft.com
//  Email: [e-mail]
//
////////////////////////////////////////////////////////////////////////////////

unit SUISideChannel;

interface

{$I SUIPack.inc}

uses Windows, Messages, SysUtils, Classes, Controls, ExtCtrls, Buttons, Graphics,
     Forms, Math,
     SUIThemes, SUIMgr, SUI2Define;

type
    TsuiSideChannelAlign = (suiLeft, suiRight);
    TsuiSideChannelPopupMode = (suiMouseOn, suiMouseClick);

    TsuiSideChannel = class(TCustomPanel)
    private
        m_PinBtn : TSpeedButton;
        m_UIStyle : TsuiUIStyle;
        m_FileTheme : TsuiFileTheme;
        m_BorderColor : TColor;
        m_TitleBitmap : TBitmap;
        m_HandleBitmap : TBitmap;
        m_SideColor : TColor;
        m_CaptionFontColor : TColor;
        m_Poped : Boolean;
        m_ShowButton : Boolean;
        m_FromTheme : Boolean;        

        m_Timer : TTimer;

        m_nWidth : Integer;
        m_bMoving : Boolean;
        m_Align : TsuiSideChannelAlign;
        m_StayOn : Boolean;
        m_PopupMode : TsuiSideChannelPopupMode;
        m_QuickMove : Boolean;

        m_OnPop : TNotifyEvent;
        m_OnPush : TNotifyEvent;
        m_OnPin : TNotifyEvent;
        m_OnUnPin : TNotifyEvent;

        procedure OnPinClick(Sender: TObject);
        procedure OnTimerCheck(Sender: TObject);

        procedure SetWidth(NewValue : Integer);
        procedure SetSideColor(NewValue : TColor);
        function GetSideColor() : TColor;
        function GetSideWidth() : Integer;
        procedure SetAlign(const Value : TsuiSideChannelAlign);
        procedure SetStayOn(const Value : Boolean);
        procedure SetFileTheme(const Value: TsuiFileTheme);
        procedure SetUIStyle(const Value: TsuiUIStyle);
        procedure SetBorderColor(const Value: TColor);
        procedure SetCaptionFontColor(const Value: TColor);
        procedure SetSideWidth(const Value: Integer);
        procedure SetHandleBitmap(const Value: TBitmap);
        procedure SetTitleBitmap(const Value: TBitmap);
        procedure SetShowButton(const Value: Boolean);
        
        procedure WMERASEBKGND(var Msg : TMessage); message WM_ERASEBKGND;
        procedure CMTextChanged(var Msg : TMessage); message CM_TEXTCHANGED;

    protected
        procedure Paint(); override;
        procedure Resize(); override;
        function CanResize(var NewWidth, NewHeight: Integer): Boolean; override;
        procedure Notification(AComponent: TComponent; Operation: TOperation); override;
        procedure AlignControls(AControl: TControl; var Rect: TRect); override;
        procedure MouseMove(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;

        procedure Pop(bQuick : Boolean = true);
        procedure Push(bQuick : Boolean = true);

        property HandleImage : TBitmap read m_HandleBitmap write SetHandleBitmap;
        property TitleImage : TBitmap read m_TitleBitmap write SetTitleBitmap;

    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 CaptionFontColor : TColor read m_CaptionFontColor write SetCaptionFontColor;
        property ShowButton : Boolean read m_ShowButton write SetShowButton;
        property Popped : Boolean read m_Poped;
                
        property Anchors;
        property BiDiMode;            
        property Width read m_nWidth write SetWidth;
        property SideBarColor : TColor read GetSideColor write SetSideColor;
        property Caption;
        property Font;
        property Alignment;
        property Align : TsuiSideChannelAlign read m_Align write SetAlign;
        property StayOn : Boolean read m_StayOn write SetStayOn;
        property Visible;
        property Color;
        property ParentColor;
        property ParentShowHint;
        property ParentBiDiMode;
        property ParentFont;
        property PopupMenu;

        property PopupMode : TsuiSideChannelPopupMode read m_PopupMode write m_PopupMode;
        property QuickMove : Boolean read m_QuickMove write m_QuickMove;

        property OnResize;
        property OnCanResize;
        property OnPush : TNotifyEvent read m_OnPush write m_OnPush;
        property OnPop : TNotifyEvent read m_OnPop write m_OnPop;
        property OnPin : TNotifyEvent read m_OnPin write m_OnPin;
        property OnUnPin : TNotifyEvent read m_OnUnPin write m_OnUnPin;

        property OnMouseDown;
        property OnMouseMove;
        property OnMouseUp;

        // no use, only for compatibility
        property SideBarWidth : Integer read GetSideWidth write SetSideWidth;
    end;


implementation

uses SUIResDef, SUIPublic;

{ TsuiSideChannel }

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

    m_TitleBitmap := TBitmap.Create();
    m_HandleBitmap := TBitmap.Create();
    m_FromTheme := false;

    m_PinBtn := TSpeedButton.Create(self);
    m_PinBtn.Parent := self;
    m_PinBtn.Flat := true;
    m_PinBtn.Height := 16;
    m_PinBtn.Width := 20;
    m_PinBtn.GroupIndex := 1;
    m_PinBtn.AllowAllUp := true;
    m_PinBtn.Glyph.LoadFromResourceName(hInstance, 'SIDECHANNEL_BTN');
    m_PinBtn.Top := 1;
    m_PinBtn.Left := Width - m_PinBtn.Width - 1;
    m_PinBtn.OnClick := OnPinClick;
    ShowButton := true;
    
    m_Timer := TTimer.Create(self);
    m_Timer.Interval := 1000;
    m_Timer.Enabled := false;
    m_Timer.OnTimer := OnTimerCheck;

    m_bMoving := false;

    BevelOuter := bvNone;
    Align := suiLeft;
    SideBarColor := clBtnFace;
    PopupMode := suiMouseOn;
    QuickMove := false;
    Font.Name := 'Tahoma';
    m_Poped := false;

    UIStyle := GetSUIFormStyle(AOwner);
    
    if (csDesigning in ComponentState) then
        Exit;

    Push(true);
end;

destructor TsuiSideChannel.Destroy;
begin
    m_Timer.Free();
    m_PinBtn.Free();
    m_HandleBitmap.Free();
    m_TitleBitmap.Free();

    inherited;
end;

procedure TsuiSideChannel.OnTimerCheck(Sender: TObject);
var
    CurPos : TPoint;
    LeftTop : TPoint;
    RightBottum : TPoint;
begin
    if m_bMoving then
        Exit;
    LeftTop.x := 0;
    LeftTop.y := 0;
    RightBottum.x := inherited Width;
    RightBottum.y := Height;
    GetCursorPos(CurPos);

    if Parent <> nil then
    begin
        LeftTop := ClientToScreen(LeftTop);
        RightBottum := ClientToScreen(RightBottum);
    end
    else
        Push(m_QuickMove);

    if (
        (CurPos.x > LeftTop.x)      and
        (CurPos.x < RightBottum.x)  and
        (CurPos.y > LeftTop.y)      and
        (CurPos.y < RightBottum.y)
    ) then
        Exit;   // in

    // out
    Push(m_QuickMove);
end;

procedure TsuiSideChannel.Pop(bQuick : Boolean = true);
begin
    m_bMoving := true;

    m_PinBtn.Visible := true;

    if not bQuick then
    begin
        while inherited Width + 15 < m_nWidth do
        begin
            inherited Width := inherited Width + 15;
            Refresh();
            Application.ProcessMessages();
        end;
    end;
    inherited Width := m_nWidth;
    Refresh();

    m_Timer.Enabled := true;
    m_bMoving := false;
    m_Poped := true;
    Repaint();
    if Assigned (m_OnPop) then
        m_OnPop(self);
end;

procedure TsuiSideChannel.Push(bQuick : Boolean = true);
begin
    m_bMoving := true;
    m_Poped := false;    
    m_Timer.Enabled := false;

    if not bQuick then
    begin
        while inherited Width - 15 > 10 do
        begin
            inherited Width := inherited Width - 15;
            Refresh();
            Application.ProcessMessages();
        end;
    end;
    inherited Width := 10;
    Refresh();

    m_PinBtn.Visible := false;
    m_bMoving := false;
    Repaint();
    if Assigned(m_OnPush) then
        m_OnPush(self);
end;

procedure TsuiSideChannel.SetWidth(NewValue: Integer);
begin
    m_nWidth := NewValue;

    if (csDesigning in ComponentState) or m_Poped then
        inherited Width := m_nWidth;
end;

function TsuiSideChannel.GetSideColor: TColor;
begin
    Result := m_SideColor;
end;

procedure TsuiSideChannel.SetSideColor(NewValue: TColor);
begin
    m_SideColor := NewValue;
    Repaint();
end;