实现QQ的自动隐藏功能

mianfeiziyuan

{  ***************可以实现类似QQ窗体的隐藏效果*******************  }
{                        Design:  Kevin　　  　　　　　　　　　　  }

unit QQForm;

interface

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

{$R QQfrm.res}

type
TQQForm = class(TComponent)
private
   { Private declarations }
   fActive:Boolean;
   fOldWndMethod:TWndMethod;
   fForm:TForm;
   ftimer:TTimer;
   fAnchors: TAnchors;
protected
   { Protected declarations }
public
   { Public declarations }
   constructor Create(AOwner:TComponent); override;
   destructor Destroy; override;
   procedure WndProc(var Message: TMessage);
   procedure WMMoving(var Msg: TMessage);
   procedure fOnTimer(Sender: TObject);
   function FindParHWMD(Pos :TPoint):THandle;
published
   { Published declarations }
   property Active:boolean  read fActive  write fActive;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Kevin', [TQQForm]);
end;

{ TQQForm }

constructor TQQForm.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
fActive:=True;
fTimer:=TTimer.Create(self);
fForm:=TForm(AOwner);
fForm.FormStyle := fsStayOnTop;
fTimer.Enabled := True;
fTimer.OnTimer := fOnTimer;
fTimer.Interval := 200;
fOldWndMethod:=fForm.WindowProc;
fForm.WindowProc:=WndProc;
end;

destructor TQQForm.Destroy;
begin
FreeAndNil(fTimer);
fForm.WindowProc:=fOldWndMethod;
inherited Destroy;
end;

function TQQForm.FindParHWMD(Pos: TPoint): THandle;
var
WControl :TWinControl;
begin
WControl := FindVCLWindow(Pos);
if WControl <> nil then
begin
   while not (WControl.Parent = nil) do
   begin
     WControl := WControl.Parent;
   end;
   Result := WControl.Handle;
end else Result := 0;
end;

procedure TQQForm.fOnTimer(Sender: TObject);
const
coffset = 3;
var
ParHandle :THandle;
begin
ParHandle := FindParHWMD(Mouse.CursorPos);
if ParHandle = fForm.Handle then
begin
   if akLeft in FAnchors then fForm.Left := 0;
   if akTop in FAnchors then fForm.Top := 0;
   if akRight in FAnchors then fForm.Left := Screen.Width - fForm.Width;
   if akBottom in FAnchors then fForm.Top := Screen.Height - fForm.Height;
end else
begin
   if akLeft in FAnchors then fForm.Left := -fForm.width + coffset;
   if akTop in FAnchors then fForm.Top := -fForm.Height + coffset;
   if akRight in FAnchors then fForm.Left := Screen.Width - coffset;
   if akBottom in FAnchors then fForm.Top := Screen.Height - coffset;
end;
end;

procedure TQQForm.WMMoving(var Msg: TMessage);
begin
inherited;
with PRect(msg.LParam)^ do
begin
   Left := Min(Max(0,Left),Screen.Width - fForm.Width);
   Top := Min(Max(0,Top),Screen.Height - fForm.Height);
   Right := Min(Max(fForm.Width,Right),Screen.Width);
   Bottom := Min(Max(fForm.Height,Bottom),Screen.Height);

   FAnchors := [];
   if Left = 0 then Include(FAnchors,akLeft);

   if Right = Screen.Width then Include(FAnchors,akRight);

   if (Top = 0) and (Left <> 0) and (Right <> Screen.Width) then
   begin
     Include(FAnchors,akTop);
   end else
   if Left = 0 then
   begin
     Include(FAnchors,akLeft);
   end else
   if Right = Screen.Width then
   begin
     Include(FAnchors,akRight);
   end;

   if Bottom = Screen.Height then Include(FAnchors,akBottom);

   fTimer.Enabled := FAnchors <> [];
end;
end;

procedure TQQForm.WndProc(var Message: TMessage);
begin
if not fActive then
begin
   fOldwndMethod(Message);
   Exit;
end;
if (CsDesigning in ComponentState) then fOldwndMethod(Message)
else
   case Message.Msg of
     WM_MOVING : WMMoving(Message);
   else fOldwndMethod(Message);
end;
end;

end.



///////////////////////////////////////////////////////////////////////////



这是伴水老大的帖子，你看看


USE MATH

unit  Unit1;  

interface  

uses  
Windows,  Messages,  SysUtils,  Variants,  Classes,  Graphics,  Controls,  Forms,  
Dialogs,  StdCtrls,  ExtCtrls;  

type  
TForm1  =  class(TForm)  
     Timer1:  TTimer;  
     procedure  FormCreate(Sender:  TObject);  
     procedure  Timer1Timer(Sender:  TObject);  
private  
     {  Private  declarations  }  
     FAnchors:  TAnchors;  
     procedure  WMMOVING(var  Msg:  TMessage);  message  WM_MOVING;  
public  
     {  Public  declarations  }  
end;  

var  
Form1:  TForm1;  

implementation  

{$R  *.dfm}  

uses  Math;  

{  TForm1  }  

procedure  TForm1.WMMOVING(var  Msg:  TMessage);  
begin  
inherited;  
with  PRect(Msg.LParam)^  do  begin  
     Left  :=  Min(Max(0,  Left),  Screen.Width  -  Width);  
     Top  :=  Min(Max(0,  Top),  Screen.Height  -  Height);  
     Right  :=  Min(Max(Width,  Right),  Screen.Width);  
     Bottom  :=  Min(Max(Height,  Bottom),  Screen.Height);  
     FAnchors  :=  [];  
     if  Left  =  0  then  Include(FAnchors,  akLeft);  
     if  Right  =  Screen.Width  then  Include(FAnchors,  akRight);  
     if  Top  =  0  then  Include(FAnchors,  akTop);  
     if  Bottom  =  Screen.Height  then  Include(FAnchors,  akBottom);  
     Timer1.Enabled  :=  FAnchors  <>  [];  
end;  
end;  

procedure  TForm1.FormCreate(Sender:  TObject);  
begin  
Timer1.Enabled  :=  False;  
Timer1.Interval  :=  200;  
FormStyle  :=  fsStayOnTop;  
end;  

procedure  TForm1.Timer1Timer(Sender:  TObject);  
const  
cOffset  =  2;  
begin  
if  WindowFromPoint(Mouse.CursorPos)  =  Handle  then  begin  
     if  akLeft  in  FAnchors  then  Left  :=  0;  
     if  akTop  in  FAnchors  then  Top  :=  0;  
     if  akRight  in  FAnchors  then  Left  :=  Screen.Width  -  Width;  
     if  akBottom  in  FAnchors  then  Top  :=  Screen.Height  -  Height;  
end  else  begin  
     if  akLeft  in  FAnchors  then  Left  :=  -Width  +  cOffset;  
     if  akTop  in  FAnchors  then  Top  :=  -Height  +  cOffset;  
     if  akRight  in  FAnchors  then  Left  :=  Screen.Width  -  cOffset;  
     if  akBottom  in  FAnchors  then  Top  :=  Screen.Height  -  cOffset;  
end;  
end;  

end.