用delphi實現QQ的縮伸面板制作(10分)

各位DFW達人。。誰知道怎麼用個panel來現實跟QQ一樣。能夠自由伸縮阿。。就是當panel靠近屏幕上下左右邊緣的時候。。panel能自由的縮進去。。然後鼠標靠近的時候。又縮出來。。跟QQ一樣。。式調用API來實現嗎？誰能告訴我怎麼實現嗎？能提供demo嗎？十分感謝！！

大家別沉默是金阿。。

或者誰能告訴我。有沒有三方控件已經實現了這個方法阿。。能提供下載地址嗎？不過我最想知道是怎麼實現的。。畢竟學習是最重要的。。

你在盒子上下载一个控件就可以了。
www.delphibox.com
上面有一个QQF的控件（好像就是这个名字）。直接使用就可以了！它有源码的！

我也想知道

unit TaskBars;

interface
uses windows, Forms, Classes, ExtCtrls;

type
TMoveActionEnum = (ToTop, ToLeft, ToBottom, ToRight);

TTaskBar = class(TComponent)
private
FTimer: TTimer;
FFrm: TForm;
MoveAction: TMoveActionEnum;
FGoTop, FGoLeft, FGoBottom, FGoRight, FOnTop: Boolean;
FMoveLength: Integer;
FEnabled: Boolean;
procedure SetGoTop(Value: Boolean);
procedure SetGoLeft(Value: Boolean);
procedure SetGoBottom(Value: Boolean);
procedure SetGoRight(Value: Boolean);
procedure SetOnTop(Value: Boolean);
procedure SetMoveLength(Value: Integer);
procedure SetEnabled(Value: Boolean);
procedure Timer(Sender: TObject);
procedure UpForm;
procedure DownForm;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property GoTop: Boolean read FGoTop write SetGoTop;
property GoLeft: Boolean read FGoLeft write SetGoLeft;
property GoBootom: Boolean read FGoBottom write SetGoBottom;
property GoRight: Boolean read FGoRight write SetGoRight;
property OnTop: Boolean read FOnTop write SetOnTop;
property MoveLength: Integer read FMoveLength write SetMoveLength;
property Enabled: Boolean read FEnabled write SetEnabled;
end;

procedure Register;

implementation

procedure Register;
begin
//注册到组件库中
RegisterComponents('Win32', [TTaskBar]);
end;

constructor TTaskBar.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FFrm := TForm(AOwner);
FGoTop := true;
FGoLeft := true;
FGoBottom := true;
FGoRight := true;
FOnTop := false;
FMoveLength := 50;
FEnabled := true;
FTimer := TTimer.Create(AOwner);
FTimer.Interval := 1;
FTimer.OnTimer := Timer;
end;

destructor TTaskBar.Destroy;
begin
FTimer.Free;
inherited Destroy;
end;

procedure TTaskBar.Timer(Sender: TObject);
var P: TPoint;
begin
GetCursorPos(P); //获取当前鼠标位置
if ((FFrm.Left) < (P.X)) and
((P.X) < (FFrm.Left + FFrm.Width)) and
((FFrm.Top - 1) < (P.Y)) and
((P.Y) < (FFrm.Top + FFrm.Height + 1)) then //复杂的判断过程，判断鼠标是否位于窗体区域内
begin
if FFrm.Left <= 0 then
begin
MoveAction := ToLeft;
if FGoLeft = true then DownForm;
end;
if FFrm.Top <= 0 then
begin
MoveAction := ToTop;
if FGoTop = true then DownForm;
end;
if ((FFrm.Left + FFrm.Width) > (screen.Width + 1)) then
begin
MoveAction := ToRight;
if FGoRight = true then DownForm;
end;
if ((FFrm.Top + FFrm.Height) > (screen.Height + 1)) then
begin
MoveAction := ToBottom;
if FGoBottom = true then DownForm;
end;
end else
begin
if FFrm.Left <= 1 then
begin
MoveAction := ToLeft;
if FGoLeft = true then UpForm;
end;
if FFrm.Top <= 1 then
begin
MoveAction := ToTop;
if FGoTop = true then UpForm;
end;
if ((FFrm.Left + FFrm.Width) >= (screen.Width - 1)) then
begin
MoveAction := ToRight;
if FGoRight = true then UpForm;
end;
if ((FFrm.Top + FFrm.Height) >= (screen.Height - 1)) then
begin
MoveAction := ToBottom;
if FGoBottom = true then UpForm;
end;
end;
end;

procedure TTaskBar.SetGoTop(Value: Boolean);
begin
FGoTop := Value;
end;

procedure TTaskBar.SetGoLeft(Value: Boolean);
begin
FGoLeft := Value;
end;

procedure TTaskBar.SetGoBottom(Value: Boolean);
begin
FGoBottom := Value;
end;

procedure TTaskBar.SetGoRight(Value: Boolean);
begin
FGoRight := Value;
end;

procedure TTaskBar.SetOnTop(Value: Boolean);
begin
FOnTop := Value;
if FOnTop then
SetWindowPos(FFrm.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE)
else SetWindowPos(FFrm.Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
end;

procedure TTaskBar.SetMoveLength(Value: Integer);
begin
FMoveLength := Value;
end;

procedure TTaskBar.SetEnabled(Value: Boolean);
begin
FEnabled := Value;
FTimer.Enabled := FEnabled;
end;

procedure TTaskBar.UpForm;
begin //移入后事件
try
if (GetKeyState(VK_LBUTTON) and $8000) = 1 then Exit; //鼠标按下
if MoveAction = ToTop then
begin
if ((FFrm.Top) <= (FMoveLength + 1 - FFrm.Height)) then
begin
FFrm.Top := 3 - FFrm.Height;
Exit;
end else if ((FFrm.Top) < (1 - FFrm.Height)) then Exit;
FFrm.Top := FFrm.Top - FMoveLength;
end;

if MoveAction = ToLeft then
begin
if ((FFrm.Left) <= (FMoveLength + 1 - FFrm.Width)) then
begin
FFrm.Left := 3 - FFrm.Width;
Exit;
end else if ((FFrm.Left) < (1 - FFrm.Width)) then Exit;
FFrm.Left := FFrm.Left - FMoveLength;
end;

if MoveAction = ToRight then
begin
if ((FFrm.Left) > (screen.Width - FMoveLength)) then
begin
FFrm.Left := screen.Width - 3;
Exit;
end;
FFrm.Left := FFrm.Left + FMoveLength;
end;

if MoveAction = ToBottom then
begin
if ((FFrm.Top) > (screen.Height - FMoveLength)) then
begin
FFrm.Top := screen.Height - 3;
Exit;
end;
FFrm.Top := FFrm.Top + FMoveLength;
end;
except
end;
end;

procedure TTaskBar.DownForm;
begin //移出后
try
if MoveAction = ToTop then
begin
if ((FFrm.Top) >= (-FMoveLength - 1)) then
begin
FFrm.Top := -1;
Exit;
end;
FFrm.Top := FFrm.Top + FMoveLength;
end;

if MoveAction = ToLeft then
begin
if ((FFrm.Left) >= (-FMoveLength - 1)) then
begin
FFrm.Left := -1;
Exit;
end;
FFrm.Left := FFrm.Left + FMoveLength;
end;

if MoveAction = ToRight then
begin
if ((FFrm.Left) <= (screen.Width - FFrm.Width + FMoveLength + 1)) then
begin
FFrm.Left := screen.Width - FFrm.Width + 1;
Exit;
end;
FFrm.Left := FFrm.Left - FMoveLength;
end;

if MoveAction = ToBottom then
begin
if ((FFrm.Top) <= (screen.Height - FFrm.Height + FMoveLength + 1)) then
begin
FFrm.Top := screen.Height - FFrm.Height + 1;
Exit;
end;
FFrm.Top := FFrm.Top - FMoveLength;
end;
except
end;
end;

end.



//===========================================

謝謝。。我知道怎麼做了。。