实现QQ的自动隐藏功能

{ ***************可以实现类似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.

文章分类目录:

添加新评论

Only text

  • 不允许HTML标记。
  • 自动断行和分段。

Plain text

  • 不允许HTML标记。
  • 自动将网址与电子邮件地址转变为链接。
  • 自动断行和分段。
CAPTCHA
请输入下面的验证码再提交评论,不区分大小写。
Image CAPTCHA
Enter the characters shown in the image.