jvdockvsnetstyle.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvDockVSNetStyle.pas, released on 2003-12-31.

The Initial Developer of the Original Code is luxiaoban.
Portions created by luxiaoban are Copyright (C) 2002,2003 luxiaoban.
All Rights Reserved.

Contributor(s):

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvDockVSNetStyle.pas,v 1.51 2005/02/17 10:20:25 marquardt Exp $

unit JvDockVSNetStyle;

{$I jvcl.inc}

interface

uses
  {$IFDEF USEJVCL}
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$ENDIF USEJVCL}
  Windows, Messages, Classes, Graphics, Controls, Forms, ExtCtrls,
  JvDockControlForm, JvDockSupportControl, JvDockTree, JvDockVIDStyle;

type
  TJvDockVSNETConjoinServerOption = class(TJvDockVIDConjoinServerOption)
  protected
    procedure SetDefaultSystemCaptionInfo; override;
  public
    constructor Create(ADockStyle: TJvDockBasicStyle); override;
  end;

  TJvDockVSNETTabServerOption = class(TJvDockVIDTabServerOption)
  public
    constructor Create(ADockStyle: TJvDockBasicStyle); override;
  end;

  TJvDockVSNETChannelOption = class(TJvDockBasicServerOption)
  private
    FActivePaneSize: Integer;
    FShowImage: Boolean;
    FMouseleaveHide: Boolean;
    FHideHoldTime: Integer;
    FTabColor: TColor;
    procedure SetActivePaneSize(const Value: Integer);
    procedure SetShowImage(const Value: Boolean);
    procedure SetHideHoldTime(const Value: Integer);
    procedure SetMouseleaveHide(const Value: Boolean);
  protected
    procedure ResetDockControlOption; override;
    procedure ResetDockServerOption(ADockServer: TJvDockServer); override;
    procedure ResetDockClientOption(ADockClient: TJvDockClient); override;
  public
    constructor Create(ADockStyle: TJvDockBasicStyle); override;
  published
    property ActivePaneSize: Integer read FActivePaneSize write SetActivePaneSize;
    property ShowImage: Boolean read FShowImage write SetShowImage;
    property MouseleaveHide: Boolean read FMouseleaveHide write SetMouseleaveHide default True;
    property HideHoldTime: Integer read FHideHoldTime write SetHideHoldTime;
    property TabColor: TColor read FTabColor write FTabColor default clBtnFace;
  end;

  TJvDockVSNETChannelOptionClass = class of TJvDockVSNETChannelOption;

  TJvDockVSBlock = class;
  TJvDockVSChannel = class;
  TJvDockVSNETPanel = class;
  TJvDockVSPopupPanel = class;
  TJvDockVSPopupPanelSplitter = class;

  TJvDockVSPane = class(TObject)
  private
    FBlock: TJvDockVSBlock;
    FDockForm: TForm;
    FIndex: Integer;
    FWidth: Integer;
    FActive: Boolean;
    FVisible: Boolean;
  public
    constructor Create(ABlock: TJvDockVSBlock; AForm: TForm; AWidth: Integer; AIndex: Integer); virtual;
  end;

  TJvDockBlockType = (btConjoinBlock, btTabBlock);

  TJvDockVSBlock = class(TObject)
  private
    FVSChannel: TJvDockVSChannel;
    FVSPaneList: TList;
    FActiveBlockWidth: Integer;
    FInactiveBlockWidth: Integer;
    FActiveDockControl: TWinControl;
    FBlockType: TJvDockBlockType;
    FImageList: TImageList;
    FBlockStartPos: Integer;
    function GetVSPane(Index: Integer): TJvDockVSPane;
    function GetVSPaneCount: Integer;
    procedure SetActiveDockControl(ADockControl: TWinControl);
  protected
    procedure ResetActiveBlockWidth;
    procedure AddPane(AControl: TControl; const AWidth: Integer);
    procedure DeletePane(Index: Integer);
    procedure UpdateActiveDockControl(StartIndex: Integer);
    { Pane with ActiveDockControl as FDockControl has size ActiveBlockWidth.. }
    property ActiveBlockWidth: Integer read FActiveBlockWidth write FActiveBlockWidth;
    { ..other panes have size InactiveBlockWidth }
    property InactiveBlockWidth: Integer read FInactiveBlockWidth write FInactiveBlockWidth;
    { Free Notification? }
    property ActiveDockControl: TWinControl read FActiveDockControl write SetActiveDockControl;
    property BlockType: TJvDockBlockType read FBlockType;
    { Owner }
    property VSChannel: TJvDockVSChannel read FVSChannel;
  public
    constructor Create(Owner: TJvDockVSChannel); virtual;
    destructor Destroy; override;
    procedure AddDockControl(Control: TWinControl);
    procedure RemoveDockControl(Control: TWinControl);
    function GetTotalWidth: Integer;
    property VSPaneCount: Integer read GetVSPaneCount;
    property VSPanes[Index: Integer]: TJvDockVSPane read GetVSPane;
  end;

  TJvDockChannelState = (csShow, csHide);

  TJvDockPoppupPanelAnimateStyle = (pasShow, pasHide);

  {
     TJvDockServer
       |
       |----- TJvDockVSNETPanel (4x per server)
                |
                |----- TJvDockVSChannel
                             |
                             |----    TJvDockVSPopupPanel
                             |
                             |----    TJvDockVSPopupPanelSplitter

     -------- = maintains/creates

  }

  TJvDockVSChannel = class(TCustomControl)
  private
    FAnimationStartTimer: TTimer;
    FActiveDockForm: TForm;
    FActivePane: TJvDockVSPane;
    FVSNETDockPanel: TJvDockVSNETPanel; { Owner }
    FCurrentPos: Integer;
    FDockServer: TJvDockServer;
    FBlockList: TList; { Change to TObjectList }
    FChannelWidth: Integer;
    FBlockStartOffset: Integer;
    FBlockUpOffset: Integer;
    FBlockInterval: Integer;
    FVSPopupPanel: TJvDockVSPopupPanel;
    FVSPopupPanelSplitter: TJvDockVSPopupPanelSplitter;
    FActivePaneSize: Integer;
    function GetBlockCount: Integer;
    function GetBlocks(Index: Integer): TJvDockVSBlock;
    procedure GetBlockRect(Block: TJvDockVSBlock; Index: Integer; var ARect: TRect);
    function GetDockFormWithMousePos(MousePos: TPoint): TJvDockVSPane;
    procedure SetBlockStartOffset(const Value: Integer);
    procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
    procedure FreeBlockList;
    procedure SetActivePaneSize(const Value: Integer);
    procedure AnimationStartTimerOnTimerHandler(Sender: TObject);
  protected
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure ResetFontAngle; virtual;
    procedure ResetBlock; virtual;
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure SetVSPopupPanelSplitterPosition;
    property ChannelWidth: Integer read FChannelWidth;
    property BlockStartOffset: Integer read FBlockStartOffset write SetBlockStartOffset;
    property BlockUpOffset: Integer read FBlockUpOffset;
    property BlockInterval: Integer read FBlockInterval;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetPaneWithControl(AControl: TControl): TJvDockVSPane;
    procedure CreateVSPopupPanel(DockStyle: TComponent);
    procedure DestroyVSPopupPanel;
    procedure ResetPosition;
    procedure AddDockControl(Control: TWinControl);
    procedure RemoveDockControl(Control: TWinControl);
    function FindDockControl(Control: TWinControl; var BlockIndex: Integer;
      var PaneIndex: Integer): Boolean;
    function FindPane(Control: TWinControl): TJvDockVSPane;
    { Slides the window into view }
    procedure PopupDockForm(Pane: TJvDockVSPane); overload;
    procedure PopupDockForm(Control: TWinControl); overload;
    { Disables auto-hide }
    procedure ShowPopupPanel(Pane: TJvDockVSPane); overload;
    procedure ShowPopupPanel(Control: TWinControl); overload;
    { Hides the window by sliding it to the edge of the form }
    procedure HidePopupPanel(Pane: TJvDockVSPane); overload;
    procedure HidePopupPanel(Control: TWinControl); overload;
    procedure HidePopupPanelWithAnimate;
    procedure ResetActivePaneWidth;
    procedure ResetPopupPanelHeight;
    procedure RemoveAllBlock;
    procedure DeleteBlock(Index: Integer);
    procedure AnimatePopupPanel(AnimateStyle: TJvDockPoppupPanelAnimateStyle);
    property DockServer: TJvDockServer read FDockServer write FDockServer;
    property BlockCount: Integer read GetBlockCount;
    property Blocks[Index: Integer]: TJvDockVSBlock read GetBlocks;
    property VSPopupPanel: TJvDockVSPopupPanel read FVSPopupPanel;
    property VSPopupPanelSplitter: TJvDockVSPopupPanelSplitter read FVSPopupPanelSplitter;
    { Free Notification? }
    property ActiveDockForm: TForm read FActiveDockForm;
    property ActivePaneSize: Integer read FActivePaneSize write SetActivePaneSize;
  end;

  TJvDockVSChannelClass = class of TJvDockVSChannel;

  TJvDockVSNetStyle = class(TJvDockVIDStyle)
  private
    FMouseleaved: Boolean;
    FTimer: TTimer;
    FDockServerList: TList;
    FCurrentTimer: Integer;
    FChannelOption: TJvDockVSNETChannelOption;
    FChannelOptionClass: TJvDockVSNETChannelOptionClass;
    procedure Timer(Sender: TObject);
    function GetChannelOption: TJvDockVSNETChannelOption;
    procedure SetChannelOption(const Value: TJvDockVSNETChannelOption);
  protected
    procedure CreateConjoinServerOption(var Option: TJvDockBasicConjoinServerOption); override;
    procedure CreateTabServerOption(var Option: TJvDockBasicTabServerOption); override;
    function DockServerWindowProc(DockServer: TJvDockServer; var Msg: TMessage): Boolean; override;
    function DockClientWindowProc(DockClient: TJvDockClient; var Msg: TMessage): Boolean; override;
    procedure AddDockBaseControl(ADockBaseControl: TJvDockBaseControl); override;
    procedure RemoveDockBaseControl(ADockBaseControl: TJvDockBaseControl); override;
    procedure CreateServerOption; override; { AfterConstruction }
    procedure FreeServerOption; override; { Destroy }
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    {$IFNDEF USEJVCL}
    function GetControlName: string; override;
    {$ENDIF !USEJVCL}
    procedure SetDockFormVisible(ADockClient: TJvDockClient; AVisible: Boolean);
    procedure ShowDockForm(ADockClient: TJvDockClient); override;
    procedure HideDockForm(ADockClient: TJvDockClient); override;
    function GetDockFormVisible(ADockClient: TJvDockClient): Boolean; override;
    procedure RestoreClient(DockClient: TJvDockClient); override;
    class procedure SetAnimationInterval(const Value: Integer);
    class function GetAnimationInterval: Integer;
    class function GetAnimationStartInterval: Integer;
    class procedure SetAnimationMoveWidth(const Value: Integer);
    class function GetAnimationMoveWidth: Integer;
  published
    property ChannelOption: TJvDockVSNETChannelOption read GetChannelOption write SetChannelOption;
  end;

  TJvDockVSNETSplitter = class(TJvDockVIDSplitter);

  { A 'pure' TJvDockVSNETPanel maintains a TJvDockVSChannel (A TJvDockVSPopupPanel
    component that is a TJvDockVSNETPanel descendant does NOT, see
    TJvDockVSNETPanel.AddDockServer)
  }
  TJvDockVSNETPanel = class(TJvDockVIDPanel)
  private
    FVSChannelClass: TJvDockVSChannelClass;
    FVSChannel: TJvDockVSChannel;
  protected
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure AddDockServer(ADockServer: TJvDockServer); override;
    procedure RemoveDockServer(ADockServer: TJvDockServer); override;
    procedure CustomDockDrop(Source: TJvDockDragDockObject; X, Y: Integer); override;
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure CreateVSChannel(DockStyle: TComponent);
    procedure DestroyVSChannel;
    procedure DoAutoHideControl(Control: TWinControl);
    procedure DoHideControl(Control: TWinControl);
    procedure DoShowControl(Control: TWinControl);
    property VSChannel: TJvDockVSChannel read FVSChannel;
  end;

  TJvDockVSPopupPanel = class(TJvDockVSNETPanel)
  private
    FDockStyle: TComponent; {Actually of type TJvDockBasicStyle }
    FVSNETDockPanel: TJvDockVSNETPanel;
    {procedure SetVSNETDockPanel(const Value: TJvDockVSNETPanel);}
    function GetVSChannel: TJvDockVSChannel;
  protected
    function CreateDockManager: IDockManager; override;
    procedure SetParent(AParent: TWinControl); override;
  public
    // Can't put 'override' this one because signature is different!
    // But it MUST have DockStyle in the constructor now! -Wpostma!
    constructor Create(AOwner: TComponent); override; 

    procedure ShowDockPanel(MakeVisible: Boolean; Client: TControl;
      PanelSizeFrom: TJvDockSetDockPanelSizeFrom); override;
    { Dirty override; solve with virtual method? }
    property VSChannel: TJvDockVSChannel read GetVSChannel;
    { Owner }
    property VSNETDockPanel: TJvDockVSNETPanel read FVSNETDockPanel {write SetVSNETDockPanel};
    { Dock Style }
    property DockStyle: TComponent read FDockStyle write FDockStyle; {Actually of type TJvDockBasicStyle }
  end;

  TJvDockVSNETConjoinPanel = class(TJvDockVIDConjoinPanel);

  TJvDockBtnState = (bsUp, bsNormal, bsDown);

  TJvDockVSNETZone = class(TJvDockVIDZone)
  private
    FAutoHideBtnDown: Boolean;
    FAutoHideBtnState: TJvDockBtnState;
    FCloseBtnState: TJvDockBtnState;
    FVSPaneVisible: Boolean;
    procedure SetAutoHideBtnState(const Value: TJvDockBtnState);
    procedure SetCloseBtnState(const Value: TJvDockBtnState);
    procedure SetAutoHideBtnDown(const Value: Boolean);
    procedure SetVSPaneVisible(const Value: Boolean);
  protected
    procedure DoCustomSetControlName; override;
    procedure SetChildControlVisible(Client: TControl; AVisible: Boolean); override;
    property AutoHideBtnDown: Boolean read FAutoHideBtnDown write SetAutoHideBtnDown;
    property AutoHideBtnState: TJvDockBtnState read FAutoHideBtnState write SetAutoHideBtnState;
    property CloseBtnState: TJvDockBtnState read FCloseBtnState write SetCloseBtnState;
    property VSPaneVisible: Boolean read FVSPaneVisible write SetVSPaneVisible;
  public
    constructor Create(Tree: TJvDockTree); override;

  end;

  TJvDockVSNETTree = class(TJvDockVIDTree)
  private
    FAutoHideZone: TJvDockVSNETZone;
  protected
    procedure IgnoreZoneInfor(Stream: TMemoryStream); override;
    procedure BeginDrag(Control: TControl;
      Immediate: Boolean; Threshold: Integer = -1); override;
    function DoLButtonDown(var Msg: TWMMouse;
      var Zone: TJvDockZone; out HTFlag: Integer): Boolean; override;
    procedure DoLButtonUp(var Msg: TWMMouse;
      var Zone: TJvDockZone; out HTFlag: Integer); override;
    procedure DoLButtonDbClk(var Msg: TWMMouse;
      var Zone: TJvDockZone; out HTFlag: Integer); override;
    procedure DoMouseMove(var Msg: TWMMouse;
      var AZone: TJvDockZone; out HTFlag: Integer); override;
    procedure DoHideZoneChild(AZone: TJvDockZone); override;
    function GetTopGrabbersHTFlag(const MousePos: TPoint;
      out HTFlag: Integer; Zone: TJvDockZone): TJvDockZone; override;
    procedure DrawDockGrabber(Control: TControl; const ARect: TRect); override;
    procedure PaintDockGrabberRect(Canvas: TCanvas; Control: TControl;
      const ARect: TRect; PaintAlways: Boolean = False); override;
    procedure DrawCloseButton(Canvas: TCanvas; Zone: TJvDockZone;
      Left, Top: Integer); override;
    procedure DrawAutoHideButton(Zone: TJvDockZone;
      Left, Top: Integer); virtual;
    procedure GetCaptionRect(var Rect: TRect); override;
    procedure DoOtherHint(Zone: TJvDockZone;
      HTFlag: Integer; var HintStr: string); override;
    procedure CustomSaveZone(Stream: TStream;
      Zone: TJvDockZone); override;
    procedure CustomLoadZone(Stream: TStream;
      var Zone: TJvDockZone); override;
    property AutoHideZone: TJvDockVSNETZone read FAutoHideZone
      write FAutoHideZone;
  public
    constructor Create(DockSite: TWinControl; DockZoneClass: TJvDockZoneClass;
      ADockStyle: TComponent {TJvDockBasicStyle}); override;
  end;

  TJvDockVSNETTabSheet = class(TJvDockVIDTabSheet)
  private
    FOldVisible: Boolean;
    procedure SetOldVisible(const Value: Boolean);
  public
    constructor Create(AOwner: TComponent); override;
    property OldVisible: Boolean read FOldVisible write SetOldVisible;
  end;

  TJvDockVSNETTabPanel = class(TJvDockTabPanel)