suisidechannel.pas

来自「新颖按钮控件」· PAS 代码 · 共 430 行

////////////////////////////////////////////////////////////////////////////////
//
//
//  FileName    :   SUISideChannel.pas
//  Creator     :   Shen Min
//  Date        :   2002-5-13
//  Comment     :
//
//  Copyright (c) 2002-2003 Sunisoft
//  http://www.sunisoft.com
//  Email: [e-mail]
//
////////////////////////////////////////////////////////////////////////////////

unit SUISideChannel;

interface

uses Windows, Messages, SysUtils, Classes, Controls, ExtCtrls, Buttons, Graphics,
     Forms,
     SUIButton;

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

    TsuiSideChannel = class(TCustomPanel)
    private
        m_MousePanel : TPanel;
        m_TopBarPanel : TPanel;

        m_PinBtn : TSpeedButton;
        m_BarBtn : TsuiButton;

        m_Timer : TTimer;

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

        m_OnResize : TNotifyEvent;
        m_OnCanResize : Controls.TCanResizeEvent;
        m_OnPop : TNotifyEvent;
        m_OnPush : TNotifyEvent;

        procedure OnMouseIn(Sender: TObject; Shift: TShiftState; X, Y: Integer);
        procedure OnLeftBarClick(Sender : TObject);
        procedure OnTopPanelResize(Sender: TObject);
        procedure OnPinClick(Sender: TObject);
        procedure OnTimerCheck(Sender: TObject);
        procedure OnSelfResize(Sender: TObject);
        procedure OnSelfCanResize(Sender: TObject; var NewWidth, NewHeight: Integer; var Resize: Boolean);

        procedure SetWidth(NewValue : Integer);
        procedure SetSideColor(NewValue : TColor);
        function GetSideColor() : TColor;
        procedure SetSideWidth(NewValue : Integer);
        function GetSideWidth() : Integer;
        procedure SetCaption(NewValue : TCaption);
        procedure SetAlignment(NewValue : TAlignment);
        function GetAlignment() : TAlignment;
        procedure SetAlign(const Value : TsuiSideChannelAlign);
        procedure SetStayOn(const Value : Boolean);
        procedure CMFONTCHANGED(var Msg : TMessage); message CM_FONTCHANGED;        

    public
        constructor Create(AOwner : TComponent); override;
        destructor Destroy(); override;

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

    published
        property Anchors;
        property BiDiMode;            
        property Width read m_nWidth write SetWidth;
        property SideBarColor : TColor read GetSideColor write SetSideColor;
        property SideBarWidth : Integer read GetSideWidth write SetSideWidth;
        property Caption read m_Caption write SetCaption;
        property Font;
        property Alignment read GetAlignment write SetAlignment;
        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 PopupMode : TsuiSideChannelPopupMode read m_PopupMode write m_PopupMode;
        property QuickMove : Boolean read m_QuickMove write m_QuickMove;

        property OnResize read m_OnResize write m_OnResize;
        property OnCanResize read m_OnCanResize write m_OnCanResize;
        property OnPush : TNotifyEvent read m_OnPush write m_OnPush;
        property OnPop : TNotifyEvent read m_OnPop write m_OnPop;
    end;


implementation

uses SUIResDef, SUIPublic, SUIThemes;

{ TsuiSideChannel }

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

    m_MousePanel := TPanel.Create(self);
    m_TopBarPanel := TPanel.Create(self);

    m_PinBtn := TSpeedButton.Create(self);

    m_BarBtn := TsuiButton.Create(self);

    InsertControl(m_TopBarPanel);
    m_TopBarPanel.Align := alTop;
    m_TopBarPanel.Height := 16;
    m_TopBarPanel.BevelInner := bvNone;
    m_TopBarPanel.BevelOuter := bvNone;
    m_TopBarPanel.OnMouseMove := OnMouseIn;
    m_TopBarPanel.OnResize := OnTopPanelResize;

    InsertControl(m_MousePanel);
    m_MousePanel.Align := alLeft;
    m_MousePanel.Width := 10;
    m_MousePanel.BevelInner := bvNone;
    m_MousePanel.BevelOuter := bvNone;
    m_MousePanel.OnMouseMove := OnMouseIn;
    m_MousePanel.OnClick := OnLeftBarClick;

    m_TopBarPanel.InsertControl(m_PinBtn);
    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_NOONTOP');
    m_PinBtn.Left := m_TopBarPanel.Width - m_PinBtn.Width;
    m_PinBtn.OnClick := OnPinClick;

    m_BarBtn.Parent := m_MousePanel;
    m_BarBtn.Top := 0;
    m_BarBtn.Left := 0;
    m_BarBtn.UIStyle := Custom;
    m_BarBtn.ResHandle := 0;
    m_BarBtn.PicNormalResName := 'SIDECHANNEL_BAR_NORMAL';
    m_BarBtn.PicMouseOnResName := 'SIDECHANNEL_BAR_MOUSEON';
    m_BarBtn.PicMouseDownResName := 'SIDECHANNEL_BAR_MOUSEON';
    m_BarBtn.TabStop := false;
    m_BarBtn.AutoSize := true;
    m_BarBtn.OnMouseMove := OnMouseIn;
    m_BarBtn.OnClick := OnLeftBarClick;

    m_Timer := TTimer.Create(self);
    m_Timer.Interval := 500;
    m_Timer.Enabled := false;
    m_Timer.OnTimer := OnTimerCheck;

    m_bMoving := false;

    BevelOuter := bvNone;
    Align := suiLeft;
    inherited OnResize := OnSelfResize;
    inherited OnCanResize := OnSelfCanResize;
    inherited Caption := ' ';
    SideBarColor := clBtnFace;
    PopupMode := suiMouseOn;
    QuickMove := false;

    Color := GetSUIFormColor(TCustomForm(AOwner));
    SideBarColor := Color;

    if (csDesigning in ComponentState) then
        Exit;

    Push(true);
end;

destructor TsuiSideChannel.Destroy;
begin
    m_Timer.Free();

    m_PinBtn.Free();

    m_TopBarPanel.Free();
    m_MousePanel.Free();

    inherited;
end;

procedure TsuiSideChannel.OnMouseIn(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
    if (
        (inherited Width > m_MousePanel.Width) or
        (m_PopupMode <> suiMouseOn)
    ) then
        Exit;

    Pop(m_QuickMove);
end;

procedure TsuiSideChannel.OnTopPanelResize(Sender: TObject);
begin
    m_PinBtn.Left := m_TopBarPanel.Width - m_PinBtn.Width;
end;

procedure TsuiSideChannel.OnTimerCheck(Sender: TObject);
var
    CurPos : TPoint;
    LeftTop : TPoint;
    RightBottum : TPoint;
begin
    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_TopBarPanel.Caption := m_Caption;

    if Assigned (m_OnPop) then
        m_OnPop(self);
end;

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

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

    m_PinBtn.Visible := false;
    m_TopBarPanel.Caption := '';

    m_bMoving := false;

    if Assigned(m_OnPush) then
        m_OnPush(self);
end;

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

    if csDesigning in ComponentState then
        inherited Width := m_nWidth;
end;

procedure TsuiSideChannel.OnSelfResize(Sender: TObject);
begin
    if (
        (not m_bMoving) and
        (inherited Width > m_MousePanel.Width)
    ) then
        m_nWidth := inherited Width;

    if Assigned(m_OnResize) then
        m_OnResize(Sender);
end;

function TsuiSideChannel.GetSideColor: TColor;
begin
    Result := m_MousePanel.Color;
end;

procedure TsuiSideChannel.SetSideColor(NewValue: TColor);
begin
    m_MousePanel.Color := NewValue;
    m_TopBarPanel.Color := NewValue;
end;

procedure TsuiSideChannel.OnPinClick(Sender: TObject);
begin
    m_Timer.Enabled := not m_PinBtn.Down;

    if m_PinBtn.Down then
        m_PinBtn.Glyph.LoadFromResourceName(hInstance, 'SIDECHANNEL_BTN_ONTOP')
    else
        m_PinBtn.Glyph.LoadFromResourceName(hInstance, 'SIDECHANNEL_BTN_NOONTOP');
    m_StayOn := m_PinBtn.Down;
end;

procedure TsuiSideChannel.OnSelfCanResize(Sender: TObject; var NewWidth,
  NewHeight: Integer; var Resize: Boolean);
begin
    if Assigned(m_OnCanResize) then
        m_OnCanResize(Sender, NewWidth, NewHeight, Resize);

    if (
        (not m_bMoving) and
        (m_PinBtn.Visible) and
        (NewWidth < 50)
    ) then
        Resize := false;
end;

function TsuiSideChannel.GetAlignment: TAlignment;
begin
    Result := m_TopBarPanel.Alignment;
end;

procedure TsuiSideChannel.SetAlignment(NewValue: TAlignment);
begin
    m_TopBarPanel.Alignment := NewValue;
end;

procedure TsuiSideChannel.SetCaption(NewValue: TCaption);
begin
    m_Caption := NewValue;

    m_TopBarPanel.Caption := NewValue;
end;

function TsuiSideChannel.GetSideWidth: Integer;
begin
    Result := m_MousePanel.Width;
end;

procedure TsuiSideChannel.SetSideWidth(NewValue: Integer);
begin
    m_MousePanel.Width := NewValue;

    if not (csDesigning in ComponentState) then
        Push(true);
end;

procedure TsuiSideChannel.SetAlign(const Value: TsuiSideChannelAlign);
begin
    m_Align := Value;

    if m_Align = suiLeft then
        inherited Align := alLeft
    else
        inherited Align := alRight;
end;

procedure TsuiSideChannel.SetStayOn(const Value: Boolean);
begin
    m_StayOn := Value;

    if Value then
    begin
        if not (csDesigning in ComponentState) then
            Pop(m_QuickMove);
        m_PinBtn.Down := true;
    end
    else
    begin
        m_PinBtn.Down := false;
        if not (csDesigning in ComponentState) then
            Push(true);
    end;

    if not (csDesigning in ComponentState) then
        m_PinBtn.Click();
end;

procedure TsuiSideChannel.OnLeftBarClick(Sender: TObject);
begin
    if m_PopupMode <> suiMouseClick then
        Exit;

    Pop(m_QuickMove);
end;

procedure TsuiSideChannel.CMFONTCHANGED(var Msg: TMessage);
begin
    m_TopBarPanel.Font.Assign(Font);
end;

end.