关于dock的问题，300分！！！(300分)

如何在窗口docking完后头部两条横线上如何写caption和画按纽
我做成象vc那样的在dock窗口关闭按纽旁边放其它的一个按纽

大概知道要从 TDockTree(在 Controls.pas 中) 派生，然后运行时将 DockHost 的
DockManager 换成你自己的 DockTree。
How to subclass the default Delphi dockmanager

After a lot of trial and error, I finally figured out how to properly subclass
the default Delphi DockManager so that you can take control of how the docked
controls/forms look. Here are the details:

First, create your own dockmanager implementation, inheriting from the Delphi
default:

uses
Windows, Graphics, Controls;
type
TMyDockTree = class(TDockTree)
protected
procedure PaintDockFrame(Canvas: TCanvas; Control: TControl; const ARect:
TRect); override;
end;

In this case, I want to override the drawing behavior, so I will supply my own
PaintDockFrame routine. But you can override any of the default implementation
sections that you want.

OK, now, here is the trick. The control that you want to dock into (like a
TPanel), needs to have the UseDockManager property in the Object Inspector set
to FALSE. Then, in the FormCreate routine, you assign your custom dockmanager
to the control and turn the UseDockManager property on:

procedure TForm1.FormCreate(Sender: TObject);
begin
Panel1.DockManager := TMyDockTree.Create( Panel1);
Panel1.UseDockManager := true;
end;

In this case, I'm using a Panel as my dock site. The DockSite property of the
panel is turned on in the object inspector.

That's it! The trick was turning off UseDockManager to avoid Delphi assigning
the default dockmanager, and turning it on manually in the form creator.

希望得到向信息!我也想要,谢谢啦!

我倒是把button画上去了，可是却无法响应，并且原来双击那两条横线可以
undock，现在也没有反应了。

怎么办，谢谢

我是用Delphi的例子做的测试
在TMainForm.FormCreate中加上

LeftDockPanel.DockManager := TMyDockTree.Create( LeftDockPanel);
LeftDockPanel.UseDockManager := true;

在TMyDockTree.PaintDockFrame中
仅有一条inherited语句，
运行后不但那个区域没有响应消息，连原来的分格条都不起作用了

我踢

我试了 TMyDockTree.PaintDockFrame中仅有一条inherited语句的时候可以的，但设计时
或在 LeftDockPanel.DockManager := TMyDockTree.Create( LeftDockPanel); 之前要把
LeftDockPanel.UseDockManager 设为 False。你添加的按钮要能相应事件，必须修改
TDockTree 的 WindowProc 和 HitTest 方法，但 WindowProc 是 Private 的，DockTree
在 Create 时用它去替换 DockSite 的 WindowProc 过程以截获 DockSite 的消息，因此
你也可以在Inherited Create; 之后再用你自己的 WindowProc 去替换 DockSite 的
WindowProc，就在 DockTree 缺省的消息处理过程之前截获 DockSite 的消息了。

bbkxjy,你的思路到是有一点理解,好像挺有道理的,有没有实际的例子可供参考?

这是我从raize上找到的

Docking Managers
Docking support in Delphi 4 is quite powerful, indeed. However, I am not
particularly fond of the grabber bars that are displayed when a client is
docked as shown in Figure 3. The bars are fine for toolbars, but for forms
and other controls, I would prefer to see a small caption describing the
contents of the docked control.

Figure 3: Delphi's default docking manager.

Fortunately, Delphi provides the means to alter this behavior, although it
is not a trivial process. The trick is to create a custom docking manager.
The default docking manager, which is implemented in the TDockTree class,
is responsible for displaying the grabber bars for docked controls. By
creating a custom docking manager and instructing a component to use it,
we can customize the appearance of docked controls. For example, Figure 4
shows a sample form utilizing the custom manager that comes with Raize
Components.



Figure 4: An example of a custom docking manager.

Unfortunately, I don't have enough room to describe the details of creating
your own custom docking manager. The basic technique is to create a descendant
of TDockTree and override the appropriate methods. For example, to replace the
grabber bars with tiny captions, you override the PaintDockFrame method.

However, creating a descendant of TDockTree is only part of the solution.
You must instruct your dock site component to use your new docking manager.
This can be accomplished in two ways. The first is to create an instance of
your docking manager and assign it to the DockManager property of the dock
site. However, this usually only works for very basic managers.

Generally, you will create a docking manager for a specific type of component.
In this case, you will need to create a descendant of the component you wish
to use as your dock site. You then override the dock site's Create DockManager
method and return an instance of your new custom docking manager class.

忙乎了半天，这里有我想要的东西，但是只是试用版，那位能帮我弄到source or crack
另有重谢

http://gavina-software.com/dockmanager/

找到另一个东西，无论如何还得感谢bbkxjy 300分送上
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
unit DockManagerPro;

{TDockManagerPro -- Version 1.01, December 21, 1999

By: Christopher Sansone, Meteor Technologies Inc.
ChrisSansone@Rocketmail.com

Tired of Delphi's boring dock bars? While Delphi's implementation is adequate
for docking toolbars, the functionality is lacking when docking other controls.
TDockManagerPro creates a new DockManager to replace Delphi's DockManager.
Rather than displaying only two grab-bars and a close button, TDockManagerPro
also displays a gradient background, text, and has a fully customizable
appearance!

To use it, simply drop a TDockManagerPro onto a form and set the Control
property to the control that will become the dock site. After that, select
the other properties:

Font: the font of the caption
CaptionStartColor: the starting background color for the caption bar
CaptionEndColor: the ending background color for the cpation bar.
TransparentButton: whether the close button should be transparent or not

The text displayed in the caption bar of the control is the control's Hint.
To change the text, simply change the Hint property.

The Refresh method re-paints the dock site. You will need to call this if
you change the Hint property and want to update the caption bar.

There is one issue of which I am aware:

-- When the caption bar appears vertically (i.e. the dock site is aligned to
alTop or alBottom), some fonts are not painted vertically. This is a
limitation of those fonts and not of TDockManagerPro. If you know of a way
to test each font, please let me know! If I could test for this, the font
can simply be set to a font that is known to work properly (e.g. Arial).

This component is PRAYER-WARE: if you use it, just say a prayer for me! Never
underestimate the power of prayer! This has been released in thanksgiving to
all those developers who have made my life easier by generously sharing their
components. You may distribute and modify it as you please, but please let me
know if you fix any bugs or add any additional features. This component may be
used royalty-free in any application, but you may not sell these components,
its source code, or any derivitive components thereof.

TDockManagerPro has been verified to work in Delphi 4 and above. It cannot
work in versions before Delphi 4, since the docking capabilities were not
introduced until version 4. It has not been tested in C++Builder, but it
should work--let me know either way!

Use at your own risk. The developer(s) hereby assume no responsibility for
damage directly or indirectly caused by this unit.

Special thanks to Mike Potter for sharing his discovery of overriding the
default DockManager!

Revision History:

1.0: Initial Release

1.01:
--Fixed calculation that caused the splitter not to split if it was
clicked within one pixel of the splitter's edge
--Fixed calculation that would incorrectly resize a control when it was
split a small amount
}

interface

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

type
TcmsDockTree = class(TDockTree)
protected
FNewDockSite: TWinControl;
FBtnDown, FMouseIn, FSplitting, FPaintCloseButtonOnly: Boolean;
FGrabberHeight, FOldControlCount: Integer;
FSplit: TPoint;
FOldWindowProc: TWndMethod;
FCurrentControl, FCloseButtonControl: TControl;

FFont: TFont;
FCaptionStartColor, FCaptionEndColor: TColor;
FTransparentButton: Boolean;

procedure SetCaptionStartColor(Value: TColor);
procedure SetCaptionEndColor(Value: TColor);
procedure SetTransparentButton(Value: Boolean);
procedure PaintDockFrame(Canvas: TCanvas; Control: TControl;
const ARect: TRect); override;
procedure AdjustDockRect(Control: TControl; var ARect: TRect); override;
procedure UnAdjustDockRect(Control: TControl; var ARect: TRect);
procedure WindowProc(var Message: TMessage);
procedure PaintCloseButton(Canvas: TCanvas; ARect: TRect;
MouseIn, BtnDown: Boolean);
function GetCloseButtonRect(ARect: TRect): TRect;
function GetGrabberRect(Control: TControl; Adjust: Boolean): TRect;
function IsMouseInCloseButton(Control: TControl; MousePos: TPoint): Boolean;
function IsMouseInCaption(Control: TControl; MousePos: TPoint): Boolean;
procedure VerticalText(Canvas: TCanvas; Rect: TRect; AText: String);
function GetShortenedText(Canvas: TCanvas; Rect: TRect;
AText: String): String;
procedure FontChanged(Sender: TObject);
function HorizontalGrabber: Boolean;
procedure PaintGradientBackground(Canvas: TCanvas; Control: TControl;
ARect: TRect);
public
procedure RefreshControl(Control: TControl);
function HitTest(const MousePos: TPoint;
out HTFlag: Integer): TControl; override;
procedure PaintSite(DC: HDC); override;
procedure Refresh;
constructor Create(ADockSite: TWinControl);
destructor Destroy; override;
property Font: TFont read FFont;
property CaptionStartColor: TColor read FCaptionStartColor
write SetCaptionStartColor;
property CaptionEndColor: TColor read FCaptionEndColor
write SetCaptionEndColor;
property TransparentButton: Boolean read FTransparentButton
write SetTransparentButton;
end;

TDockManagerPro = class(TComponent)
private
FDockTree: TcmsDockTree;
FControl: TWinControl;
FFont: TFont;
FCaptionStartColor, FCaptionEndColor: TColor;
FTransparentButton: Boolean;
procedure SetCaptionStartColor(Value: TColor);
procedure SetCaptionEndColor(Value: TColor);
procedure SetTransparentButton(Value: Boolean);
procedure SetControl(Value: TWinControl);
procedure SetFont(Value: TFont);
procedure CreateDockTree;
procedure FontChanged(Sender: TObject);
protected
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Refresh;
published
property Font: TFont read FFont write SetFont;
property CaptionStartColor: TColor read FCaptionStartColor
write SetCaptionStartColor;
property CaptionEndColor: TColor read FCaptionEndColor
write SetCaptionEndColor;
property TransparentButton: Boolean read FTransparentButton
write SetTransparentButton;
property Control: TWinControl read FControl write SetControl;
end;

procedure Register;

implementation

const
InvalidType = '%s cannot contain a TDockManagerPro control.';
DMAlready = '%s already has a TDockManagerPro associated with it.';


{------------ TcmsDockTree processing methods ----------------}

constructor TcmsDockTree.Create(ADockSite: TWinControl);
{method to create the dock tree--Initializes variables
--ADockSite is the dock site where the new dock tree will be used}
begin
inherited Create(ADockSite); //call the inherited creation
FNewDockSite := ADockSite; //store the dock site
FCaptionStartColor := clBtnFace; //initialize the start color to clBtnFace
FCaptionEndColor := clBtnFace; //initialize the end color to clBtnFace

FFont := TFont.Create; //create the font
With FFont do begin
OnChange := FontChanged; //refresh the site when the font changes
Name := 'Arial'; //initialize font--Arial can be painted vertically
Size := 8; //initialize the font size
end;

FTransparentButton := True; //initialize--close button will be transparent
FSplitting := False; //initialize--no controls are being resized
FPaintCloseButtonOnly := False; //initialize--paint entire caption bars

If not (csDesigning in FNewDockSite.ComponentState) then begin
FOldWindowProc := FNewDockSite.WindowProc; //store site's old window process
FNewDockSite.WindowProc := WindowProc; //override the site's window process
end;
end;

destructor TcmsDockTree.Destroy;
{Occurs when the dock tree is destroyed--
Destroy variables and reset the dock site's dock manager}
begin
FFont.Free; //destroy the font
FCurrentControl := nil; //unassign the current control
FCloseButtonControl := nil; //unassign the close button control

If Assigned(FNewDockSite) then begin //new dock site exists
If @FOldWindowProc <> nil then //the control's old window process is stored
FNewDockSite.WindowProc := FOldWindowProc; //reset site's window process

//Typecast FNewDockSite as TPanel, because DockManager and UseDockManager
//are protected in TControl. Is there a better way to do this?
With TPanel(FNewDockSite) do begin
DockManager := nil; //unassign the dock site's manager
UseDockManager := False; //set UseDockManager to false
//setting UseDockManager to True again will create a new default DockTree
end;
end;

Inherited Destroy; //call the inherited destroy method
end;

procedure TcmsDockTree.WindowProc(var Message: TMessage);
{The dock site calls this method every time a message is passed to it--
intercept the messages, process them, and pass them to the original handler}
var
P: TPoint;
HTFlag: Integer;
BtnDown, MouseIn: Boolean;
Msg: TMsg;
NewCurrentControl: TControl;
begin
P := SmallPointToPoint(TWMMouse(Message).Pos); //get the mouse's position
NewCurrentControl := HitTest(P, HTFlag); //get the current control
If Assigned(NewCurrentControl) then //the mouse is in a control
FCurrentControl := NewCurrentControl; //store the current control
If FNewDockSite.ControlCount = 0 then //no controls are in the dock site
FCurrentControl := nil; //unassign the stored current control

Case Message.Msg of
CM_DOCKNOTIFICATION: ResetBounds(True); //reset the control bounds

WM_LBUTTONUP: //the user lifted the left mouse button
begin
If FSplitting = True then begin //a control is being split
FSplitting := False; //not splitting anymore, so reset the value

//Delphi has hard-coded the grab-bar height to 11, so the splitter
//will stop splitting once it reaches another grab bar. Now that the
//caption bars are larger, the splitter must stop before then. So,
//the code checks if the caption bar is being overlapped, and if it
//is, it will alter the mouse position to below the caption bar and
// send a WM_MOUSEMOVE message to the dock site.

If HorizontalGrabber then begin //the caption bar is horizontal
//check to see if the mouse is above of the control (in caption) --
//the six pixels includes the splitter bar
If (P.Y < FSplit.Y) and (P.Y < FCurrentControl.Top + 6) then
//mouse is in the above control's caption area
With TWMMouse(Message).Pos do begin
Y := FCurrentControl.Top + 6; //move mouse down
SendMessage(FNewDockSite.Handle, WM_MOUSEMOVE, MK_LBUTTON,
(X) or (Y shl 16)); //send the mouse move message
end;
end
else begin //the caption bar is vertical
//check to see if the mouse is left of the control (in caption)
If (P.X < FSplit.X) and (P.X < FCurrentControl.Left + 6) then
//mouse is in left control's caption area
With TWMMouse(Message).Pos do begin
X := FCurrentControl.Left{ - FGrabberHeight} + 6; //move right
SendMessage(FNewDockSite.Handle, WM_MOUSEMOVE, MK_LBUTTON,
(X) or (Y shl 16)); //send the mouse move message
end;
end;
end

else if (HTFlag = HTCLOSE) and (FBtnDown) then begin //inside button
If FCurrentControl is TCustomForm then //control is a form
TCustomForm(FCurrentControl).Close //close the form
else //the close is not a form
FCurrentControl.Visible := False; //hide the control -- can't close
FBtnDown := False; //the button is no longer down
Refresh; //refresh the dock site
Exit; //finished--do not continue processing the message!
end;
end;

WM_LBUTTONDBLCLK: //the user double-clicked the left mouse button
If HTFlag = HTCAPTION then begin //inside caption -- undock control
FCurrentControl.ManualDock(nil, nil, alTop); //undock the control
Exit; //finished--do not continue processing the message!
end;

WM_LBUTTONDOWN: //the user pressed the left mouse button
begin
BtnDown := FBtnDown; //get the previous button position
//if the mouse is in the close button, press the button
FBtnDown := IsMouseInCloseButton(FCurrentControl, P);
If FBtnDown <> BtnDown then begin //the button state has changed
FPaintCloseButtonOnly := True; //only paint the close button
RefreshControl(FCurrentControl); //repaint the control
FPaintCloseButtonOnly := False; //resume caption bar painting
end;
If FBtnDown then //the button is pressed
Exit; //finished--do not continue processing the message!

if HTFlag = HTCAPTION then begin //the mouse is in the caption
If (not PeekMessage(Msg, FNewDockSite.Handle, WM_LBUTTONDBLCLK,
WM_LBUTTONDBLCLK, PM_NOREMOVE)) and
(FCurrentControl is TWinControl) then
//the control is a TWinControl and is not being double-clicked
With TPanel(FCurrentControl) do begin
SetFocus; //give the control the focus
if (DragKind = dkDock) and (DragMode = dmAutomatic) then
FCurrentControl.BeginDrag(False); //start docking
Exit; //finished--do not continue processing the message!
end;
end
else if HTFlag = HTBORDER then begin //the cursor is on the splitter
FSplitting := True; //remember that it is being split
FSplit := P; //store the mouse position where the split was started
end;
end;

WM_MOUSEMOVE, CM_MOUSEENTER: //the mouse is moved or entered the control
begin
MouseIn := FMouseIn; //get the previous MouseIn state
If (Assigned(FCurrentControl)) and //the mouse is over a control
((FTransparentButton) or (FBtnDown)) then begin
//the button is either transparent is is down--may have to repaint
//check to see if the mouse is now inside the close button
FMouseIn := IsMouseInCloseButton(FCurrentControl,
SmallPointToPoint(TWMMouse(Message).Pos));
If (MouseIn <> FMouseIn) then begin //MouseIn state has changed
If not FMouseIn then //the mouse is not in the close button
FBtnDown := False; //the button is no longer down
FPaintCloseButtonOnly := True; //only paint the close button
RefreshControl(FCurrentControl); //repaint the control
FPaintCloseButtonOnly := False; //resume painting of caption bar
end;
end;
end;

CM_MOUSELEAVE: //the mouse left the control--
//because the close button is close to the edge of the control,
//it may not receive a mouse leaving the close button--
//capture the MouseLeave message to repaint with the button up
begin
FCloseButtonControl := nil; //the mouse is not in any close button now
FBtnDown := False; //the close button is not down anymore
If Assigned(FCurrentControl) then begin //there is a current control
FPaintCloseButtonOnly := True; //only paint the close button
RefreshControl(FCurrentControl); //refresh the current control
FPaintCloseButtonOnly := False; //resume painting of the caption bar
end;
end;

WM_DESTROY:
//This DockTree must be unassigned from the control before it is
//destroyed, because it should be destroyed by its creator.
With TPanel(FNewDockSite) do begin
DockManager := nil; //let the TDockManagerPro free it
UseDockManager := False; //set UseDockManager to False
end;
end;
FOldWindowProc(Message); //call the original processing message
end;


{------------ TcmsDockTree property handling methods ----------------}

procedure TcmsDockTree.SetCaptionStartColor(Value: TColor);
{Occurs when the CaptionStartColor property is set--
store the new CaptionStartColor and refresh the dock site}
begin
FCaptionStartColor := Value; //store the new value
Refresh; //refresh the dock site
end;

procedure TcmsDockTree.SetCaptionEndColor(Value: TColor);
{Occurs when the CaptionEndColor property is set--
store the new CaptionEndColor and refresh the dock site}
begin
FCaptionEndColor := Value; //store the new value
Refresh; //refresh the dock site
end;

procedure TcmsDockTree.SetTransparentButton(Value: Boolean);
{Occurs when the TransparentButton property is set--
store the new TransparentButton and refresh the dock site}
begin
FTransparentButton := Value; //store the new value
FPaintCloseButtonOnly := True; //only paint the close button
Refresh; //refresh the dock site
FPaintCloseButtonOnly := False; //resume painting of entire caption bar
end;

procedure TcmsDockTree.FontChanged(Sender: TObject);
{Occurs when the font has been changed--
Calculate the new caption bar height and refresh the dock site}
var
Canvas: TControlCanvas;
begin
Canvas := TControlCanvas.Create; //create a control canvas
try //calculate the size of the caption bar
Canvas.Control := FNewDockSite; //set the canvas's control to the dock site
Canvas.Font.Assign(FFont); //assign the canvas's font

//calculate the new caption bar height--
//margins: 3 pixels above and 4 pixels below the text
FGrabberHeight := Canvas.TextHeight('Wg') + 7;
If FGrabberHeight < 11 then //the calculated height is less than 11
FGrabberHeight := 11; //set 11 to the minimum value (original value)
finally
Canvas.Free; //destroy the canvas
Refresh; //refresh the dock site
end;
end;


{------------ TcmsDockTree calculation methods ----------------}

function TcmsDockTree.HorizontalGrabber: Boolean;
{Returns True if the caption bar will be painted horizontally--
Returns False if the caption bar will be painted vertically}
begin
Result := FNewDockSite.Align in [alLeft, alRight, alClient, alNone];
end;

procedure TcmsDockTree.AdjustDockRect(Control: TControl; var ARect: TRect);
{Shrink the control to make room for the caption bar}
begin
if HorizontalGrabber then //caption bar is horizontal
Inc(ARect.Top, FGrabberHeight) //move the control down to make room
else //caption bar is vertical
Inc(ARect.Left, FGrabberHeight); //move the control left to make room
end;

procedure TcmsDockTree.UnadjustDockRect(Control: TControl; var ARect: TRect);
{Adjust the rectangle of the control to include the caption bar}
begin
if HorizontalGrabber then //caption bar is horizontal
Dec(ARect.Top, FGrabberHeight) //move the rect up to include caption bar
else //caption bar is vertical
Dec(ARect.Left, FGrabberHeight); //move rect left to include caption bar
end;

function TcmsDockTree.GetGrabberRect(Control: TControl; Adjust: Boolean): TRect;
{Returns the rectangle of the caption bar}
var
R: TRect;
begin
R := Control.BoundsRect; //get the control's rectangle
If Adjust then //adjust the dock rect
AdjustDockRect(Control, R); //make room for the caption bar

//adjust the rectangle to provide for the border width
Dec(R.Left, 2 * (R.Left - Control.Left)); //left
Dec(R.Top, 2 * (R.Top - Control.Top)); //top
Dec(R.Right, 2 * (Control.Width - (R.Right - R.Left))); //right
Dec(R.Bottom, 2 * (Control.Height - (R.Bottom - R.Top))); //bottom

Result := R; //return the caption bar rectangle
end;

function TcmsDockTree.GetCloseButtonRect(ARect: TRect): TRect;
{Returns the rectangle of the close button --
ARect is the rectangle of the caption bar}
var
BtnHeight: Integer;
begin
BtnHeight := FGrabberHeight - 4; //get button height
With ARect do
If HorizontalGrabber then begin //caption bar is horizontal
Result := Rect(Right - BtnHeight - 6, Top + 3, Right - 3,
Top + BtnHeight + 1);
If Left > Result.Left then //the control is smaller than the button
Result.Left := Left + 3; //shrink the button
end
else begin //the caption bar is vertical
Result := Rect(Left + 4, Top + 3, Left + BtnHeight + 1, Top + BtnHeight);
If Bottom < Result.Bottom then //the control is smaller than the button
Result.Bottom := Bottom - 3; //shrink the button
end;
end;

function TcmsDockTree.IsMouseInCloseButton(Control: TControl;
MousePos: TPoint): Boolean;
{Returns true if the mouse is in the close button of the current control--
Returns false if otherwise}
var
R, CloseButtonRect: TRect;
TopLeft, BottomRight, NewMousePos: TPoint;
begin
Result := False; //initialize the result to false
FCloseButtonControl := nil; //initialize the close button control

if (Assigned(Control)) and (Control.Visible) then begin //check the control
R := Control.BoundsRect; //get the control's rectangle
UnadjustDockRect(Control, R); //include control's caption bar
CloseButtonRect := GetCloseButtonRect(R); //get control's close button rect

//get button's top-left and bottom-right corners
TopLeft := Control.ClientToScreen(CloseButtonRect.TopLeft);
BottomRight := Control.ClientToScreen(CloseButtonRect.BottomRight);
NewMousePos := Control.ClientToScreen(MousePos); //adjust mouse position

With NewMousePos do //check to see if the mouse is between the two corners
Result := (X >= TopLeft.X) and (X <= BottomRight.X) and
(Y >= TopLeft.Y) and (Y <= BottomRight.Y);
end;
If Result then //the mouse is in the close button of this control
FCloseButtonControl := Control; //store the new close button control
end;

function TcmsDockTree.IsMouseInCaption(Control: TControl;
MousePos: TPoint): Boolean;
{Returns True if the mouse is in the control's caption--
Returns False if otherwise}
var
GrabberRect: TRect;
ATopLeft, ABottomRight, NewMousePos: TPoint;
begin
Result := False; //initialize the result
if (Assigned(Control)) and (Control.Visible) then begin //check the control
GrabberRect := GetGrabberRect(Control, False); //get the caption bar rect

With GrabberRect do begin
UnadjustDockRect(Control, GrabberRect); //unadjust the dock rectangle
//get the top-left and bottom-right corners of the caption
ATopLeft := FNewDockSite.ClientToScreen(TopLeft);
ABottomRight := FNewDockSite.ClientToScreen(BottomRight);
end;

NewMousePos := FNewDockSite.ClientToScreen(MousePos); //adjust mouse pos
With NewMousePos do //check if the mouse pos is in the caption bar
//**Fix in v1.01: all <= and >= were changed to < and > because the edge
//was interfering with the splitter
Result := (X > ATopLeft.X) and (X < ABottomRight.X) and
(Y > ATopLeft.Y) and (Y < ABottomRight.Y);
end;
end;

function TcmsDockTree.HitTest(const MousePos: TPoint;
out HTFlag: Integer): TControl;
{Overridden method--check to see where the current mouse position is--
Returns the control the mouse is over and sets HTFlag}
var
i: Integer;
NewMousePos: TPoint;
begin
NewMousePos := MousePos; //initialize temporary MousePos

Result := Inherited HitTest(NewMousePos, HTFlag); //call inherited method

//The MousePos may be in the larger caption bar or close button,
//so possibly override the existing result
With FNewDockSite do
For i := 0 to ControlCount - 1 do //loop through each control
If IsMouseInCloseButton(Controls, NewMousePos) then begin
//the mouse is in the close button
HTFlag := HTCLOSE; //set the proper HTFlag
Result := Controls; //return the current control
Break; //already found, so break out of the loop
end
else if IsMouseInCaption(Controls, NewMousePos) then begin
//the mouse is in the caption
HTFlag := HTCAPTION; //set the proper HTFlag
Result := Controls; //return the current control
Break; //already found, so break out of the loop
end;
end;

function TcmsDockTree.GetShortenedText(Canvas: TCanvas; Rect: TRect;
AText: String): String;
{Returns a truncated string that will fit into Rect--insert an ellipses at end}
const
Ellipses = '...';
var
MaxWidth, EWidth: Integer;
NeedEllipses: Boolean;
begin
NeedEllipses := False; //initialize -- do not need the ellipses yet
EWidth := Canvas.TextWidth(Ellipses); //get the width of the text
Result := AText; //initialize the result

repeat
If HorizontalGrabber then begin //the caption bar is horizontal
//get the maximum width inside the rect
If NeedEllipses then //already need ellipses--subtract width of ellipses
MaxWidth := Rect.Right - Rect.Left - FGrabberHeight - 10 - EWidth
else //do not need ellipses yet--do not subtract ellipses width
MaxWidth := Rect.Right - Rect.Left - 10 - FGrabberHeight;
end
else begin //the caption bar is vertical
If NeedEllipses then //already need ellipses--subtract ellipses width
MaxWidth := Rect.Bottom - Rect.Top - FGrabberHeight - EWidth
else //do not need ellipses yet--do not subtract ellipses width
MaxWidth := Rect.Bottom - Rect.Top - FGrabberHeight;
end;

If MaxWidth <= 0 then begin //the maximum width is less than 1
Result := ''; //no room for any text, so return null
Break; //finished--break out of the loop
end
else if Canvas.TextWidth(Result) > MaxWidth then begin
//the width of the text is bigger than the maximum width
Delete(Result, Length(Result), 1); //delete the last character
NeedEllipses := True; //ellipses are needed now
end;
until //until the width of the text is less than the maximum width
Canvas.TextWidth(Result) <= MaxWidth; //until the text fits

If NeedEllipses then //ellipses are needed
Result := Result + Ellipses; //return the shortened text plus the ellipses
end;


{------------ TcmsDockTree painting methods ----------------}

procedure TcmsDockTree.PaintSite(DC: HDC);
{Overridden method--Paints the entire dock site}
var
Canvas: TControlCanvas;
Control: TControl;
I: Integer;
R: TRect;
begin
Canvas := TControlCanvas.Create; //create a control canvas
try
Canvas.Control := FNewDockSite; //set the canvas's control to the dock site
Canvas.Lock; //suspend painting of the canvas -- reduces flicker
try
Canvas.Handle := DC; //set the canvas's handle to the passed HDC

try //loop through all controls and repaint each one
for I := 0 to FNewDockSite.ControlCount - 1 do begin
Control := FNewDockSite.Controls; //set current control
if Control.Visible then begin //the control is visible
R := GetGrabberRect(Control, True); //get the caption bar rect
PaintDockFrame(Canvas, Control, R); //paint the control's caption
end;
end;
finally
Canvas.Handle := 0; //unassign the canvas's handle
end;
finally
Canvas.Unlock; //resue painting of the canvas
end;
finally
Canvas.Free; //destroy the canvas
end;
end;

procedure TcmsDockTree.PaintDockFrame(Canvas: TCanvas; Control: TControl;
const ARect: TRect);
{Overridden method--Paints the caption bar of the passed control--
ARect is the rectangle of the caption bar}
var
R, NewR: TRect;
MouseIn: Boolean;
AText: String;

begin
If not Control.Visible then Exit; //control is invisible, so do not paint
Canvas.Lock;
try
With ARect do //set R to the caption bar portion of the control
If HorizontalGrabber then //caption bar is horizontal
R := Rect(Left, Top, Right, Top + FGrabberHeight) //caption bar height
else //caption bar is vertical
R := Rect(Left, Top, Left + FGrabberHeight, Bottom); //width=bar height

If not FPaintCloseButtonOnly then begin //paint the entire caption bar

//paint the background color of the caption bar
Canvas.Brush.Color := FCaptionStartColor; //set the canvas's brush color
InflateRect(R, -1, -1); //give a 2-pixel margin
PaintGradientBackground(Canvas, Control, R); //paint the background
InflateRect(R, 1, 1); //reset the rect -- remove the margin

With Canvas do
SetBkMode(Handle, Transparent); //set background mode to transparent

//paint the text
if HorizontalGrabber then begin //the caption bar is horizontal
With ARect do //adjust the rectangle to provide margins
NewR := Rect(Left + 2, Top + 2, Right + 1, Top + 4);

Canvas.Font.Assign(FFont); //assign the canvas's font
AText := GetShortenedText(Canvas, NewR, Control.Hint); //get fitted text
Canvas.TextOut(NewR.Left + 3, NewR.Top + 2, AText); //paint the text
end
else begin //the caption bar is vertical
With ARect do //adjust the rectangle to provide margins
NewR := Rect(Left + 2, Top + 2, Left + 4, Bottom + 1);
AText := GetShortenedText(Canvas, NewR, Control.Hint); //get fitted text
VerticalText(Canvas, R, AText); //paint the vertical text
end;
end;

MouseIn := FCloseButtonControl = Control; //check if mouse in close button
PaintCloseButton(Canvas, R, MouseIn, MouseIn and FBtnDown); //paint button
If not FPaintCloseButtonOnly then //paint entire caption bar
DrawEdge(Canvas.Handle, R, EDGE_ETCHED, BF_RECT); //draw border around bar
finally
Canvas.Unlock;
end;
end;

procedure TcmsDockTree.PaintCloseButton(Canvas: TCanvas; ARect: TRect;
MouseIn, BtnDown: Boolean);
{Paints the close button inside ARect with the various options}
var
CloseButtonRect: TRect;
BtnFaceBrush: HBRUSH;
begin
CloseButtonRect := GetCloseButtonRect(ARect); //get the close button rect
If not FTransparentButton then begin //standard button border
If BtnDown then //the button is down -- paint a "pushed" border
DrawFrameControl(Canvas.Handle, CloseButtonRect, DFC_CAPTION,
DFCS_CAPTIONCLOSE or DFCS_PUSHED)
else //the button is up -- paint a standard border
DrawFrameControl(Canvas.Handle, CloseButtonRect, DFC_CAPTION,
DFCS_CAPTIONCLOSE);
end
else begin //the button is transparent
//draw a "flat" border -- single mono-color border around
DrawFrameControl(Canvas.Handle, CloseButtonRect, DFC_CAPTION,
DFCS_CAPTIONCLOSE or DFCS_FLAT);
If BtnDown then //the button is down -- paint a sunken border
DrawEdge(Canvas.Handle, CloseButtonRect, BDR_SUNKENOUTER, BF_RECT)
else if MouseIn then //the mouse is in and button is up -- raised border
DrawEdge(Canvas.Handle, CloseButtonRect, BDR_RAISEDINNER, BF_RECT)
else begin //mouse is out -- no border
//must draw over the "flat" border with clBtnFace -- invisible
BtnFaceBrush := GetSysColorBrush(COLOR_BTNFACE); //get the Windows brush
FrameRect(Canvas.Handle, CloseButtonRect, BtnFaceBrush); //paint rect
end;
end;
end;

procedure TcmsDockTree.PaintGradientBackground(Canvas: TCanvas;
Control: TControl; ARect: TRect);
{Paints the caption bar's background color(s)}
const
D = 256; //will divide the gradient into 256 colors
var
X, C1, C2, R1, G1, B1, W: Integer;
DR, DG, DB, DH: Real;

procedure InitRGBValues(C1, C2: Integer);
{Sets the initial values for each color}
begin
R1:= GetRValue(C1); //store the red value of FCaptionStartColor
G1:= GetGValue(C1); //store the green value of FCaptionStartColor
B1:= GetBValue(C1); //store the blue value of FCaptionStartColor
DR:= (GetRValue(C2) - R1 {+1}) / D; //store the red increment
DG:= (GetGValue(C2) - G1 {+1}) / D; //store the green increment
DB:= (GetBValue(C2) - B1 {+1}) / D; //store the blue increment
end;

begin
if (not Assigned(Control)) or (not Control.Visible) then Exit; //nothing to do

With Canvas do begin
Lock; //suspend painting of the canvas
try
Brush.Style := bsSolid; //set the brush style to paint solid strokes

if FCaptionStartColor <> FCaptionEndColor then begin //colors differ
C1 := ColorToRgb(FCaptionStartColor); //get RGB value of Start Color
C2 := ColorToRgb(FCaptionEndColor); //get RGB value of End Color

InitRGBValues(C1, C2); //get the initial values for the variables

If HorizontalGrabber then //caption bar is horizontal
DH := (ARect.Right - ARect.Left) / D //get width of each small rect
else //caption bar is vertical
DH := (ARect.Bottom - ARect.Top) / D; //get height of each small rect

for X := 0 to 255 do begin //paint 256 small rects
Brush.Color := RGB(R1 + Round(DR*X), G1 + Round(DG*X),
B1 + Round(DB*X)); //get brush color for this rect
With ARect do
If HorizontalGrabber then begin //caption bar is horizontal
//add five to the width of each to prevent rounding problems
If Right <= Left + Round((X+1)*DH){ + 5} then //at the right edge
W := Right //set the width to the right edge--won't over-paint
else //not at the right edge
W := Left + Round((X+1)*DH) {+ 5}; //set normal width

FillRect(Rect(Left + Round(X*DH), Top, W, Bottom)) //paint rect
end
else begin //caption bar is vertical
If Bottom > Bottom - Round((X)*DH) {+ 5 }then //not at bottom edge
W := Bottom - Round((X)*DH) {+ 5} //set normal height
else //at the bottom edge
W := Bottom; //set height to the bottom edge--won't over-paint

FillRect(Rect(Left, Bottom - Round((X+1)*DH), Right, W)); //paint
end;
end;
end

else begin //the start and end colors are identical--just paint normally
Brush.Color := FCaptionStartColor; //set the brush's color
FillRect(ARect); //paint the rect
end;

finally
Unlock; //resume painting of the canvas
end;
end;
end;

procedure TcmsDockTree.VerticalText(Canvas: TCanvas; Rect: TRect; AText: String);
{Paints AText vertically on Canvas starting at Rect--
***PROBLEM -- not all fonts are able to be painted vertically}
var
lf: TLogFont;
hfnt, holdfnt: HFont;
begin
With Canvas do begin
Font := FFont; //set the canvas font

GetObject(Font.Handle, SizeOf(lf), Addr(lf)); //get the LogFont control

FillChar(lf, SizeOf(lf), 0); // initialize the TLogFont structure
If FFont.Name = 'MS Sans Serif' then //cannot be painted vertically
StrPCopy(lf.lfFaceName, 'Arial') //change the font to Arial
else //the font MAY be able to be painted vertically
StrPCopy(lf.lfFaceName, FFont.Name); //set the font name

lf.lfCharSet := FFont.Charset; //set the character set
lf.lfHeight := FFont.Height; //set the height

if fsBold in FFont.Style then //the font is bold
lf.lfWeight := fw_Bold //set the weight to Bold
else //the font is not bold
lf.lfWeight := fw_Normal; //set the weight to Normal

lf.lfItalic := Integer(fsItalic in FFont.Style); //set italics
lf.lfUnderline := Integer(fsUnderline in FFont.Style); //set underline
lf.lfStrikeOut := Integer(fsStrikeout in FFont.Style); //set strike out

lf.lfEscapement := 900; //rotate 90 degrees
lf.lfOrientation := 900; //rotate 90 degrees

hfnt := CreateFontIndirect(lf); //create a font
holdfnt := SelectObject(Handle, hfnt); //select the font

SetTextColor(Handle, ColorToRgb(FFont.Color)); //set the text color
SetBkMode(Handle, Transparent); //set the background mode to transparent
TextOut(Rect.Left + 3, Rect.Bottom - 5, AText); //paint the text

SelectObject(Handle, holdfnt); //select the font
DeleteObject(hfnt); //delete the font object
end;
end;

procedure TcmsDockTree.Refresh;
{Repaints the entire dock site}
var
Canvas: TControlCanvas;
begin
UpdateAll; //reset the dimensions of the controls
Canvas := TControlCanvas.Create; //create a control canvas
try
Canvas.Control := FNewDockSite; //set the canvas's control to the dock site
PaintSite(Canvas.Handle); //paint the entire site
finally
Canvas.Free; //destroy the canvas
end;
end;

procedure TcmsDockTree.RefreshControl(Control: TControl);
{Refreshes the passed Control}
var
Canvas: TControlCanvas;
NewRect: TRect;
begin
Canvas := TControlCanvas.Create; //create a control canvas
try
Canvas.Control := FNewDockSite; //set the canvas's control to the dock site
NewRect := GetGrabberRect(FCurrentControl, True); //get caption bar rect
PaintDockFrame(Canvas, FCurrentControl, NewRect); //repaint the caption bar
finally
Canvas.Free; //destroy the canvas
end;
end;






{------------ TDockManagerPro methods ----------------}

constructor TDockManagerPro.Create(AOwner: TComponent);
{Creates the control and initialize variables}
begin
Inherited Create(AOwner); //call the inherited Create method
FFont := TFont.Create; //create the stored font
FFont.Name := 'Arial'; //set the font to Arial (can be painted vertically)
FFont.OnChange := FontChanged; //refresh the dock site when font changes
FCaptionStartColor := clBtnFace; //initialize the caption color to clBtnFace
FCaptionEndColor := clBtnFace; //initialize the caption color to clBtnFace
end;

destructor TDockManagerPro.Destroy;
{Destroys the control and frees variables}
begin
//FDockTree must be destroyed only if both FControl and FDockTree are assigned
If (Assigned(FControl)) and (Assigned(FDockTree)) then
FDockTree.Free; //destroy the dock tree

Control := nil; //unassign the control
FFont.Free; //destroy the stored font
Inherited Destroy; //call the inherited Destroy method
end;

procedure TDockManagerPro.Notification(AComponent: TComponent;
Operation:TOperation);
{checks to see if FControl has been destroyed}
begin
inherited;
if (Operation = opRemove) and (AComponent = FControl) then //destroyed
Control := nil; //unassign FControl
end;

procedure TDockManagerPro.CreateDockTree;
{Creates and initializes the FDockTree--then assigns it to the dock site}
begin
If Assigned(FDockTree) then //a dock tree has already been created
FDockTree.Free; //destroy the dock tree -- start from scratch

FDockTree := TcmsDockTree.Create(FControl); //create a new dock tree

FDockTree.Font.Assign(FFont); //assign the font
FDockTree.TransparentButton := FTransparentButton; //assign the button state
FDockTree.CaptionStartColor := FCaptionStartColor; //assign the caption color
FDockTree.CaptionEndColor := FCaptionEndColor; //assign the caption color
end;

procedure TDockManagerPro.FontChanged(Sender: TObject);
{Occurs when the font has been modified--
Assign the new font to the FDockTree}
begin
If Assigned(FDockTree) then //FDockTree has been created
FDockTree.Font.Assign(FFont); //assign the new font to the dock manager
end;

procedure TDockManagerPro.SetCaptionStartColor(Value: TColor);
{Occurs when the CaptionStartColor property has been set--
Store the new CaptionStartColor and assign it to the FDockTree}
begin
FCaptionStartColor := Value; //store the new ColorCaption
If Assigned(FDockTree) then //FDockTree has been created
FDockTree.CaptionStartColor := Value; //assign the new color to FDockTree
end;

procedure TDockManagerPro.SetCaptionEndColor(Value: TColor);
{Occurs when the CaptionEndColor property has been set--
Store the new CaptionEndColor and assign it to the FDockTree}
begin
FCaptionEndColor := Value; //store the new ColorCaption
If Assigned(FDockTree) then //FDockTree has been created
FDockTree.CaptionEndColor := Value; //assign the new color to FDockTree
end;

procedure TDockManagerPro.SetTransparentButton(Value: Boolean);
{Occurs when the TransparentButton property has been set--
Store the new TransparentButton property and assign it to the FDockTree}
begin
FTransparentButton := Value; //store the new TransparentButton
If Assigned(FDockTree) then //FDockTree has been created
FDockTree.TransparentButton := Value; //assign new state to dock manager
end;

procedure TDockManagerPro.SetFont(Value: TFont);
{Occurs when the Font property has been set--
assigns the values to the stored font}
begin
FFont.Assign(Value); //store the new font values
end;

procedure TDockManagerPro.SetControl(Value: TWinControl);
{Occurs when the user sets the Control property--
validates that the control may be used and assigns it to the FDockTree}
var
i: Integer;
begin
If Assigned(FControl) then //the control has been set before
With TPanel(FControl) do begin //cast it because properties are protected
DockManager := nil; //unassign the control's DockManager
UseDockManager := False; //set UseDockManager to False
//a standard DockManager will be created when UseDockManager becomes True
end;

If Assigned(Value) then //a control has been passed
//make sure the current control does not have another TDockManagerPro
//associated with it
With Owner do //loop through all components
For i := 0 to ComponentCount - 1 do
If (Components is TDockManagerPro) and
(TDockManagerPro(Components).Control = Value) then begin
//this control is a TDockManagerPro, and it's control is the control
//that was just passed--fobidden!
FControl := nil; //unassign FControl
raise Exception.CreateFmt(DMAlready, [Value.Name]); //error message
Exit; //nothing left to do, so exit out of the method
end
else //FControl has been unassigned, so unassign FDockTree
FDockTree := nil; //unassign FDockTree

FControl := Value; //control is okay--store it

try
If (Assigned(FControl)) and not (csDesigning in ComponentState) then
//must typecast it as a TPanel, because the DockManager and UseDockManager
//properties of TWinControl are protected--is there a better way to check?
With TPanel(FControl) do begin
UseDockManager := False; //set UseDockManager to False
DockManager := nil; //unassign the DockManager
CreateDockTree; //create and initialize the dock tree
DockSite := True; //set the control to be a dock site
DockManager := FDockTree; //assign the dock tree to the control
UseDockManager := True; //use the new dock manager
end;
except //the control cannot be cast as a Panel--must not be a dock site
FControl := nil; //unassign the control
raise Exception.CreateFmt(InvalidType, [Value.Name]); //raise error
end;
end;

procedure TDockManagerPro.Refresh;
{Refreshes the dock site}
begin
If (Assigned(FControl)) and (Assigned(FDockTree)) then
FDockTree.Refresh; //refresh the dock site
end;

procedure Register;
begin
RegisterComponents ('Win32', [TDockManagerPro]);
end;


end.

接受答案了.

我这里有这样的控件

to aqi:
刚试试派生了一个 TMyDockTree，可以多画出一个按钮，也可以响应一个 TNotifyEvent
事件，但设计时 Panel 的 UseDockManager 必须设为 False(不知原因)，否则就象你说的
，DockBar没有反应。原准备贴上来的，却发现你已经找到了更好的方案。 BTW: Raise
的网站在哪里？按 "www.raise.com" 却说 "Host not found"? 另 Raise2.52 在
www.51delphi.com (窑洞) 可以下载。"控件下载" -> "套件" 中。

对不起，应该是raize 原文如下

http://www.raize.com/DelphiByDesign/DbD56.htm