jvdocksupportcontrol.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: JvDockSupportControl.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: JvDockSupportControl.pas,v 1.28 2005/02/17 10:20:24 marquardt Exp $

unit JvDockSupportControl;

{$I jvcl.inc}

interface

uses
  {$IFDEF USEJVCL}
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$ENDIF USEJVCL}
  Messages, Windows, CommCtrl, Graphics, Controls, Forms, Classes, ExtCtrls,
  ComCtrls, ImgList,
  {$IFDEF USEJVCL}
  JvComponent, JvAppStorage,
  {$ENDIF USEJVCL}
  JvDockHashTable, JvDockTree;

type
  TJvDockDragDockObject = class(TObject)
  private
    // FDockClient:TObject;{NEW: Opaque reference to TJvDockClient}
    FMouseDeltaX: Double;
    FMouseDeltaY: Double;
    FControl: TControl;
    FDragTarget: Pointer;
    FDragPos: TPoint;
    FDropOnControl: TControl;
    FDropAlign: TAlign;
    FDragHandle: HWND;
    FDragTargetPos: TPoint;
    FCancelling: Boolean;
    FFloating: Boolean;
    FFrameWidth: Integer;
    FBrush: TBrush;
    FCtrlDown: Boolean;
    FDockRect: TRect;
    FEraseDockRect: TRect;
    procedure SetBrush(const Value: TBrush);
    procedure SetDropAlign(const Value: TAlign);
    procedure SetDropOnControl(const Value: TControl);
    function GetTargetControl: TWinControl;
    procedure SetTargetControl(const Value: TWinControl);
  protected
    procedure DefaultDockImage(Erase: Boolean); virtual;
    procedure DrawDragRect(DoErase: Boolean); virtual;
    procedure GetBrush_PenSize_DrawRect(
      var ABrush: TBrush; var PenSize: Integer; var DrawRect: TRect; Erase: Boolean); virtual;
    function GetFrameWidth: Integer; virtual;
    procedure SetFrameWidth(const Value: Integer); virtual;
    procedure MouseMsg(var Msg: TMessage); virtual;
    function CanLeave(NewTarget: TWinControl): Boolean; virtual;
  public
    constructor Create(AControl: TControl); virtual;
    destructor Destroy; override;

    procedure AdjustDockRect(const ARect: TRect); virtual;
    function Capture: HWND;
    function DragFindWindow(const Pos: TPoint): HWND; virtual;
    procedure ReleaseCapture(Handle: HWND);
    procedure EndDrag(Target: TObject; X, Y: Integer); virtual;
    procedure Finished(Target: TObject; X, Y: Integer; Accepted: Boolean); virtual;
    function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; virtual;
    function GetDragImages: TDragImageList; virtual;
    procedure DrawDragDockImage; virtual;
    procedure EraseDragDockImage; virtual;
    function GetDropCtl: TControl; virtual;

    property MouseDeltaX: Double read FMouseDeltaX write FMouseDeltaX;
    property MouseDeltaY: Double read FMouseDeltaY write FMouseDeltaY;
    property Control: TControl read FControl write FControl;
    property DockRect: TRect read FDockRect write FDockRect;
    property DragTarget: Pointer read FDragTarget write FDragTarget;
    property DragPos: TPoint read FDragPos write FDragPos;
    property DropOnControl: TControl read FDropOnControl write SetDropOnControl;
    property DropAlign: TAlign read FDropAlign write SetDropAlign;
    property DragHandle: HWND read FDragHandle write FDragHandle;
    property DragTargetPos: TPoint read FDragTargetPos write FDragTargetPos;
    property EraseDockRect: TRect read FEraseDockRect;
    property Cancelling: Boolean read FCancelling write FCancelling;
    property Floating: Boolean read FFloating write FFloating;
    property FrameWidth: Integer read GetFrameWidth write SetFrameWidth;
    property Brush: TBrush read FBrush write SetBrush;
    property CtrlDown: Boolean read FCtrlDown write FCtrlDown;
    property TargetControl: TWinControl read GetTargetControl write SetTargetControl;

    {DockClient: Opaque reference to TJvDockClient. Nil if none.}    
    // property DockClient:TObject read FDockClient write FDockClient;
  end;

  {$IFDEF USEJVCL}
  TJvDockCustomControl = class(TJvCustomControl)
  {$ELSE}
  TJvDockCustomControl = class(TCustomControl)
  {$ENDIF USEJVCL}
  private
    function GetJvDockManager: IJvDockManager;
    procedure SetJvDockManager(const Value: IJvDockManager);
  protected
    procedure WndProc(var Msg: TMessage); override;
    procedure CustomStartDock(var Source: TJvDockDragDockObject); virtual;
    procedure CustomGetSiteInfo(Source: TJvDockDragDockObject;
      Client: TControl; var InfluenceRect: TRect; MousePos: TPoint;
      var CanDock: Boolean); virtual;
    procedure CustomDockOver(Source: TJvDockDragDockObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean); virtual;
    procedure CustomPositionDockRect(Source: TJvDockDragDockObject; X, Y: Integer); virtual;
    procedure CustomDockDrop(Source: TJvDockDragDockObject; X, Y: Integer); virtual;
    procedure CustomEndDock(Target: TObject; X, Y: Integer); virtual;
    function CustomUnDock(Source: TJvDockDragDockObject; NewTarget: TWinControl; Client: TControl): Boolean; virtual;
    procedure CustomGetDockEdge(Source: TJvDockDragDockObject; MousePos: TPoint; var DropAlign: TAlign); virtual;
  public
    procedure UpdateCaption(Exclude: TControl); virtual;
    property DockManager;
    property JvDockManager: IJvDockManager read GetJvDockManager write SetJvDockManager;
  end;

  TJvDockCustomPanel = class(TJvDockCustomControl)
  protected
    function CreateDockManager: IDockManager; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property DockSite;
  end;

  TJvDockCustomTabControl = class;

  TJvDockTabStrings = class(TStrings)
  private
    FTabControl: TJvDockCustomTabControl;
  protected
    function Get(Index: Integer): string; override;
    function GetCount: Integer; override;
    function GetObject(Index: Integer): TObject; override;
    procedure Put(Index: Integer; const S: string); override;
    procedure PutObject(Index: Integer; AObject: TObject); override;
    procedure SetUpdateState(Updating: Boolean); override;
  public
    procedure Clear; override;
    procedure Delete(Index: Integer); override;
    procedure Insert(Index: Integer; const S: string); override;
  end;

  TJvDockDrawTabEvent = procedure(Control: TJvDockCustomTabControl; TabIndex: Integer;
    const Rect: TRect; Active: Boolean) of object;

  TJvDockPageControl = class;

  TJvDockCustomTabControl = class(TJvDockCustomControl)
  private
    FHotTrack: Boolean;
    FImageChangeLink: TChangeLink;
    FImages: TCustomImageList;
    FMultiLine: Boolean;
    FMultiSelect: Boolean;
    FOwnerDraw: Boolean;
    FRaggedRight: Boolean;
    FSaveTabIndex: Integer;
    FSaveTabs: TStringList;
    FScrollOpposite: Boolean;
    FStyle: TTabStyle;
    FTabPosition: TTabPosition;
    FTabs: TJvDockTabStrings;
    FTabSize: TSmallPoint;
    FUpdating: Boolean;
    FSavedAdjustRect: TRect;
    FOnChange: TNotifyEvent;
    FOnChanging: TTabChangingEvent;
    FOnDrawTab: TJvDockDrawTabEvent;
    FOnGetImageIndex: TTabGetImageEvent;
    function GetDisplayRect: TRect;
    function GetTabIndex: Integer;
    function GetTabs: TStrings;
    procedure ImageListChange(Sender: TObject);
    function InternalSetMultiLine(Value: Boolean): Boolean;
    procedure SetMultiLine(Value: Boolean);
    procedure SetMultiSelect(Value: Boolean);
    procedure SetOwnerDraw(Value: Boolean);
    procedure SetRaggedRight(Value: Boolean);
    procedure SetScrollOpposite(Value: Boolean);
    procedure SetStyle(Value: TTabStyle);
    procedure SetTabIndex(Value: Integer);
    procedure SetTabs(Value: TStrings);
    procedure SetTabWidth(Value: Smallint);
    procedure TabsChanged;
    procedure UpdateTabSize;
    procedure CMFontChanged(var Msg); message CM_FONTCHANGED;
    procedure CMSysColorChange(var Msg: TMessage); message CM_SYSCOLORCHANGE;
    procedure CMTabStopChanged(var Msg: TMessage); message CM_TABSTOPCHANGED;
    procedure CNNotify(var Msg: TWMNotify); message CN_NOTIFY;
    procedure CMDialogChar(var Msg: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CNDrawItem(var Msg: TWMDrawItem); message CN_DRAWITEM;
    procedure TCMAdjustRect(var Msg: TMessage); message TCM_ADJUSTRECT;
    procedure WMDestroy(var Msg: TWMDestroy); message WM_DESTROY;
    procedure WMNotifyFormat(var Msg: TMessage); message WM_NOTIFYFORMAT;
    procedure WMSize(var Msg: TMessage); message WM_SIZE;
  protected
    procedure AdjustClientRect(var Rect: TRect); override;
    function CanChange: Boolean; dynamic;
    function CanShowTab(TabIndex: Integer): Boolean; virtual;
    procedure Change; dynamic;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure DrawTab(TabIndex: Integer; const Rect: TRect; Active: Boolean); virtual;
    function GetImageIndex(TabIndex: Integer): Integer; virtual;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure PaintWindow(DC: HDC); override;
    procedure SetHotTrack(Value: Boolean); virtual;
    procedure SetImages(Value: TCustomImageList); virtual;
    procedure SetTabHeight(Value: Smallint); virtual;
    procedure SetTabPosition(Value: TTabPosition); virtual;
    procedure UpdateTabImages;
    property DisplayRect: TRect read GetDisplayRect;
    property HotTrack: Boolean read FHotTrack write SetHotTrack default False;
    property Images: TCustomImageList read FImages write SetImages;
    property MultiLine: Boolean read FMultiLine write SetMultiLine default False;
    property MultiSelect: Boolean read FMultiSelect write SetMultiSelect default False;
    property OwnerDraw: Boolean read FOwnerDraw write SetOwnerDraw default False;
    property RaggedRight: Boolean read FRaggedRight write SetRaggedRight default False;
    property ScrollOpposite: Boolean read FScrollOpposite
      write SetScrollOpposite default False;
    property Style: TTabStyle read FStyle write SetStyle default tsTabs;
    property TabHeight: Smallint read FTabSize.Y write SetTabHeight default 0;
    property TabIndex: Integer read GetTabIndex write SetTabIndex default -1;
    property TabPosition: TTabPosition read FTabPosition write SetTabPosition default tpTop;
    property Tabs: TStrings read GetTabs write SetTabs;
    property TabWidth: Smallint read FTabSize.X write SetTabWidth default 0;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnChanging: TTabChangingEvent read FOnChanging write FOnChanging;
    property OnDrawTab: TJvDockDrawTabEvent read FOnDrawTab write FOnDrawTab;
    property OnGetImageIndex: TTabGetImageEvent read FOnGetImageIndex write FOnGetImageIndex;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function IndexOfTabAt(X, Y: Integer): Integer;
    function GetHitTestInfoAt(X, Y: Integer): THitTests;
    function TabRect(Index: Integer): TRect;
    function RowCount: Integer;
    procedure ScrollTabs(Delta: Integer);
    property TabStop default True;
  end;

  {$IFDEF USEJVCL}
  TJvDockTabSheet = class(TJvWinControl)
  {$ELSE}
  TJvDockTabSheet = class(TWinControl)
  {$ENDIF USEJVCL}
  private
    FImageIndex: TImageIndex;
    FPageControl: TJvDockPageControl;
    FTabVisible: Boolean;
    FTabShowing: Boolean;
    FHighlighted: Boolean;
    FOnHide: TNotifyEvent;
    FOnShow: TNotifyEvent;
    function GetPageIndex: Integer;
    function GetTabIndex: Integer;
    procedure SetHighlighted(Value: Boolean);
    procedure SetImageIndex(Value: TImageIndex);
    procedure SetPageIndex(Value: Integer);
    procedure SetTabShowing(Value: Boolean);
    procedure SetTabVisible(Value: Boolean);
    procedure CMTextChanged(var Msg: TMessage); message CM_TEXTCHANGED;
    procedure CMShowingChanged(var Msg: TMessage); message CM_SHOWINGCHANGED;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure SetPageControl(APageControl: TJvDockPageControl); virtual;
    procedure ReadState(Reader: TReader); override;
    procedure DoHide; dynamic;
    procedure DoShow; dynamic;
    procedure UpdateTabShowing; dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property PageControl: TJvDockPageControl read FPageControl write SetPageControl;
    property TabIndex: Integer read GetTabIndex;
  published
    property Caption;
    property Height stored False;
    property Highlighted: Boolean read FHighlighted write SetHighlighted default False;
    property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default 0;
    property Left stored False;
    property PageIndex: Integer read GetPageIndex write SetPageIndex stored False;
    property TabVisible: Boolean read FTabVisible write SetTabVisible default True;
    property Top stored False;
    property Visible stored False;
    property Width stored False;
    property OnHide: TNotifyEvent read FOnHide write FOnHide;
    property OnShow: TNotifyEvent read FOnShow write FOnShow;
  end;

  TJvDockTabSheetClass = class of TJvDockTabSheet;

  TJvDockPageControl = class(TJvDockCustomTabControl)
  private
    FPages: TList;
    FActivePage: TJvDockTabSheet;
    FNewDockSheet: TJvDockTabSheet;
    FUndockingPage: TJvDockTabSheet;
    FTabSheetClass: TJvDockTabSheetClass;
    procedure ChangeActivePage(Page: TJvDockTabSheet);
    procedure DeleteTab(Page: TJvDockTabSheet; Index: Integer);
    function GetActivePageIndex: Integer;
    function GetPage(Index: Integer): TJvDockTabSheet;
    function GetCount: Integer;
    procedure InsertPage(Page: TJvDockTabSheet);
    procedure InsertTab(Page: TJvDockTabSheet);
    procedure MoveTab(CurIndex, NewIndex: Integer);
    procedure RemovePage(Page: TJvDockTabSheet);
    procedure SetActivePageIndex(const Value: Integer);
    procedure UpdateTab(Page: TJvDockTabSheet);
    procedure UpdateTabHighlights;
    procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST;
    procedure CMDialogKey(var Msg: TCMDialogKey); message CM_DIALOGKEY;
    procedure CMDockClient(var Msg: TCMDockClient); message CM_DOCKCLIENT;
    procedure CMDockNotification(var Msg: TCMDockNotification); message CM_DOCKNOTIFICATION;
    procedure CMUnDockClient(var Msg: TCMUnDockClient); message CM_UNDOCKCLIENT;
    procedure WMLButtonDown(var Msg: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMLButtonDblClk(var Msg: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure WMLButtonUp(var Msg: TWMLButtonUp); message WM_LBUTTONUP;
    procedure WMRButtonDown(var Msg: TWMRButtonDown); message WM_RBUTTONDOWN;
    procedure WMRButtonDblClk(var Msg: TWMRButtonDblClk); message WM_RBUTTONDBLCLK;
    procedure WMRButtonUp(var Msg: TWMRButtonUp); message WM_RBUTTONUP;
    procedure WMMButtonDown(var Msg: TWMMButtonDown); message WM_MBUTTONDOWN;
    procedure WMMButtonDblClk(var Msg: TWMMButtonDblClk); message WM_MBUTTONDBLCLK;
    procedure WMMButtonUp(var Msg: TWMMButtonUp); message WM_MBUTTONUP;
  protected
    function CanShowTab(TabIndex: Integer): Boolean; override;
    procedure Change; override;
    procedure DoAddDockClient(Client: TControl; const ARect: TRect); override;
    procedure DockOver(Source: TDragDockObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean); override;
    function DoMouseEvent(var Msg: TWMMouse; Control: TControl): TWMNCHitMessage; virtual;
    procedure DoRemoveDockClient(Client: TControl); override;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    function GetDockClientFromMousePos(MousePos: TPoint): TControl; virtual;
    function GetImageIndex(TabIndex: Integer): Integer; override;
    function GetPageFromDockClient(Client: TControl): TJvDockTabSheet;
    procedure GetSiteInfo(Client: TControl; var InfluenceRect: TRect;
      MousePos: TPoint; var CanDock: Boolean); override;
    procedure Loaded; override;
    procedure SetActivePage(Page: TJvDockTabSheet); virtual;
    procedure ShowControl(AControl: TControl); override;
    procedure UpdateActivePage; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function FindNextPage(CurPage: TJvDockTabSheet;
      GoForward, CheckTabVisible: Boolean): TJvDockTabSheet;
    procedure SelectNextPage(GoForward: Boolean; CheckTabVisible: Boolean = True);
    procedure SetChildOrder(Child: TComponent; Order: Integer); override;
    property ActivePage: TJvDockTabSheet read FActivePage write SetActivePage;
    property ActivePageIndex: Integer read GetActivePageIndex
      write SetActivePageIndex;
    property Count: Integer read GetCount;
    property Pages[Index: Integer]: TJvDockTabSheet read GetPage;
    property PageSheets: TList read FPages;
    property TabSheetClass: TJvDockTabSheetClass read FTabSheetClass write FTabSheetClass;
  end;

  TJvDockDragOperation = (dopNone, dopDrag, dopDock);

  PSiteInfoRec = ^TSiteInfoRec;
  TSiteInfoRec = record
    Site: TWinControl;
    TopParent: HWND;
  end;

  TSiteList = class(TList)
  public
    procedure AddSite(ASite: TWinControl);
    procedure Clear; override;
    function Find(ParentWnd: HWND; var Index: Integer): Boolean;
    function GetTopSite: TWinControl;
  end;

  TJvDockManager = class(TObject)
  private
    FDockServersList: TList;
    FDockClientsList: TList;
    FDockServersHash: TJvDockControlHashTable;
    FDockClientsHash: TJvDockControlHashTable;
    FDockableFormList: TList;
    FLoadCount: Integer;