从 www.aidelphi.com 找了一段代码,你看看
-----------------------------------------------------------------
{本源码是自由程序,你可以把它用在任何地方,但不允许以任何形式把它单独用作商业用途。
本人是一个普通的打工仔,为了给朋友们献上更好的源码和控件,我需要你的支持,如果你认为本程序对你有帮助,希望你寄任意你愿意数额的RMB给我以资鼓励和支持,如果你认为不值,也希望你寄一张PostCard或者一封Email对我予以支持。
深圳市福田区联合广场41楼恒星威电子有限公司GPS部 艾真保 收
518026
mailto:Aizb@163.net
HomePage:
http://vip.6to23.com/aizb}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ToolWin, ComCtrls, Menus;
type
TForm1 = class(TForm)
CoolBar1: TCoolBar;
CoolBar2: TCoolBar;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
MainMenu1: TMainMenu;
a1: TMenuItem;
aa1: TMenuItem;
ac1: TMenuItem;
ac2: TMenuItem;
N1: TMenuItem;
Exit1: TMenuItem;
b1: TMenuItem;
ba1: TMenuItem;
bb1: TMenuItem;
bc1: TMenuItem;
bd1: TMenuItem;
c1: TMenuItem;
ca1: TMenuItem;
cb1: TMenuItem;
cc1: TMenuItem;
cd1: TMenuItem;
d1: TMenuItem;
dd1: TMenuItem;
db1: TMenuItem;
e1: TMenuItem;
ea1: TMenuItem;
eb1: TMenuItem;
f1: TMenuItem;
fa1: TMenuItem;
fb1: TMenuItem;
ec1: TMenuItem;
CoolBar3: TCoolBar;
CoolBar4: TCoolBar;
ToolBar2: TToolBar;
ToolButton7: TToolButton;
ToolButton8: TToolButton;
ToolButton9: TToolButton;
ToolButton10: TToolButton;
ToolButton11: TToolButton;
ToolButton12: TToolButton;
ToolButton13: TToolButton;
procedure Exit1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
procedure CoolBar1DockOver(Sender: TObject; Source: TDragDockObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Exit1Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.CoolBar1DockOver(Sender: TObject; Source: TDragDockObject;
X, Y: Integer; State: TDragState; var Accept: Boolean);
var
ARect: TRect;
begin
Accept := (Source.Control is TToolBar);
if Accept then
begin
ARect.TopLeft := (Sender as TCoolBar).ClientToScreen((Sender as TCoolBar).ClientRect.TopLeft);
ARect.BottomRight := (Sender as TCoolBar).ClientToScreen((Sender as TCoolBar).ClientRect.BottomRight);
Source.DockRect := ARect;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
Var P:TPoint;
begin
with CoolBar1 do
begin
AutoSize := True;
DockSite := True;//可停靠。
OnDockOver := CoolBar1DockOver;
end;
with CoolBar2 do
begin
AutoSize := True;
DockSite := True;//可停靠。
OnDockOver := CoolBar1DockOver;
end;
with CoolBar3 do
begin
AutoSize := True;
DockSite := True;//可停靠。
OnDockOver := CoolBar1DockOver;
end;
with CoolBar4 do
begin
AutoSize := True;
DockSite := True;//可停靠。
OnDockOver := CoolBar1DockOver;
end;
With ToolButton1 do
begin
Caption := 'a';
Grouped := True;
MenuItem := a1;//菜单
end;
with ToolButton2 do
begin
Caption := 'b';
Grouped := True;
MenuItem := b1;//菜单
end;
with ToolButton3 do
begin
Caption := 'c';
Grouped := True;
MenuItem := c1;//菜单
end;
with ToolButton4 do
begin
Caption := 'd';
Grouped := True;
MenuItem := d1;//菜单
end;
with ToolButton5 do
begin
Caption := 'e';
Grouped := True;
MenuItem := e1;//菜单
end;
with ToolButton6 do
begin
Caption := 'fgffgfddghdddf';
Grouped := True;
MenuItem := f1;//菜单
end;
with ToolBar1 do
begin
AutoSize:=True;
DragKind := dkDock;//可停靠在其他控件上。
DragMode := dmAutomatic; //自动拖放。
EdgeBorders := [ebTop, ebBottom];//边框
Flat := True; //浮动按钮
Indent := 15; //左边把手宽度。便于拖动。
ShowCaptions := True;
Transparent := True;
P:=ClientToScreen(Point(0,0)); //启动时便浮动。
ManualFloat(Rect(P.x,P.y,1000,1000));
end;
with ToolBar2 do
begin
AutoSize:=True;
DragKind := dkDock;
DragMode := dmAutomatic;
EdgeBorders := [ebTop, ebBottom];
Flat := True;
Indent := 15;
ShowCaptions := True;
Transparent := True;
ManualFloat(Rect(P.x,P.y+20,1000,1000));
end;
end;
end.