如何做磁性窗体啊?(50分)

  • 主题发起人 heihei_76
  • 开始时间
H

heihei_76

Unregistered / Unconfirmed
GUEST, unregistred user!
如何做磁性窗体啊?我在网上找得有很多遗漏。请告诉指点!
var
Form1: TForm1;
LastX, LastY: Integer; //记录前一次的坐标
WinampRect:TRect; //保存Winamp窗口的矩形区域
hwnd_Winamp:HWND; //Winamp窗口的控制句柄

implementation

{$R *.dfm}

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
const
//ClassName='Winamp v1.x'; //Winamp主窗口的类名
ClassName='TAppBuilder';//如果改成你就会发现连Delphi也有引力啦!
begin
//记录当前坐标
LastX := X;
LastY := Y;
//查找Winamp
hwnd_Winamp := FindWindow(ClassName,nil);
if hwnd_Winamp>0 then //找到的话,记录其窗口区域
GetWindowRect(hwnd_Winamp, WinampRect);
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
nLeft,nTop:integer; //记录新位置的临时变量
begin
//检查鼠标左键是否按下
if HiWord(GetAsyncKeyState(VK_LBUTTON)) > 0 then
begin
//计算新坐标
nleft := Left + X - LastX;
nTop := Top + Y - LastY;
//如果找到Winamp,就修正以上坐标,产生“磁化”效果
if hwnd_Winamp>0 then
Magnetize(nleft,ntop);
//重设窗口位置
SetBounds(nLeft,nTop,width,height);
end;
end;

procedure TForm1.Magnetize(var nl,nt:integer);
//内嵌两个比大小的函数
function Min(a,b:integer):integer;
begin
if a>b then result:=b else result:=a;
end;
function Max(a,b:integer):integer;
begin
if a<b then result:=a else result:=b;
end;
var
H_Overlapped,V_Overlapped:boolean; //记录投影线是否重叠
tw,ww,wh:integer; //临时变量
aa:Trect;
const
MagneticForce:integer=20; //“磁力”的大小。
//准确的说,就是控制窗口边缘至多相距多少像素时需要修正坐标
//为了演示,这里用一个比较夸张的数字——50。
//一般可以用20左右,那样比较接近Winamp的效果
begin
//判断水平方向是否有重叠投影
ww := WinampRect.Right-WinampRect.Left;
tw := Max(WinampRect.Right,nl+Width)-Min(WinampRect.Left,nl);
H_Overlapped := tw<=(Width+ww);
//再判断垂直方向
wh := WinampRect.Bottom-WinampRect.Top;
tw := Max(WinampRect.Bottom,nt+Height)-Min(WinampRect.Top,nt);
V_Overlapped := tw<=(Height+wh);
//足够接近的话就调整坐标[gold][/gold]这一步怎么处理啊
aa:=form1.BoundsRect;
if H_Overlapped then
if Abs(WinampRect.Bottom-nt)<MagneticForce then
aa.top:=WinampRect.Bottom
else
if Abs(nt+Height-WinampRect.Top)<MagneticForce then
aa.Bottom:=WinampRect.Top;

if V_Overlapped then
left:=Abs(WinampRect.Right-nl)
else
left:=Abs(nl+Width-WinampRect.Left);

end;
 
磁性窗体是什么?
 
delphibox.com的控件,安装就可以了

unit Magnetic;

interface

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

type
TMagOption = class (TPersistent)
private
fMagTray:boolean;
fMagExplorer:boolean;
fMagCustom:boolean;
public
constructor Create;
destructor Destroy;override;
published
property MagTray:boolean read fMagTray write fMagTray;
property MagExplorer:boolean read fMagExplorer write fMagExplorer;
property MagCustom:boolean read fMagCustom write fMagCustom;
end;

type
TMagnetic = class(TComponent)
private
fActive:Boolean;
fCanResize:Boolean;
fOldPoint:TPoint; {old mouse point}
fNewPoint:TPoint; {moved point}
fMagEffect:Integer; {magnetic effect default 10pix}
fMagOption:TMagOption;
fForm:TForm;
fOldTWndMethod:TWndMethod;
HWnd_Tray,HWnd_Explorer:HWND;
RWnd_Tray,RWnd_Explorer,RWnd_Custrom:TRect;
procedure Magnetic(var MagPoint:TPoint);
procedure WndProc(var Message: TMessage);
procedure WMMouseMove(var Msg:TMessage);
procedure WMLButtonDown(var Msg:TMessage);
procedure WMNCHitTest(var Msg: TMessage);
{ private declarations }
protected
procedure SetMagOption(Value:TMagOption);
{ protected declarations }
public
CustomMagWnd:HWND;
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
{ public declarations }
published
property Active:boolean read fActive write fActive;
property CanResize:boolean read fCanResize write fCanResize;
property MagOption:TMagOption read fMagOption write SetMagOption;
property MagEffect:Integer read fMagEffect write fMagEffect;
{ published declarations }
end;


procedure Register;

implementation

constructor TMagOption.Create;
begin
inherited Create;
fMagTray:=True;
fMagExplorer:=False;
fMagCustom:=False;
end;

destructor TMagOption.Destroy;
begin
inherited Destroy;
end;

constructor TMagnetic.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
fActive:=True;
fMagEffect:=10;
fMagOption:=TMagOption.Create;
fForm:=TForm(AOwner);
fOldTWndMethod:=fForm.WindowProc;
fForm.WindowProc:=WndProc;
if fForm.BorderStyle=bsNone then fCanResize:=true;
end;

destructor TMagnetic.Destroy;
begin
fMagOption.Free;
fForm.WindowProc:=fOldTWndMethod;
inherited Destroy;
end;

procedure TMagnetic.WndProc(var Message: TMessage);
begin
{ disable during Delphi IDE }
if (CsDesigning in ComponentState) then fOldTwndMethod(Message)
else
case Message.Msg of
WM_LBUTTONDOWN : WMLButtonDown(Message);
WM_MOUSEMOVE : WMMouseMove(Message);
WM_NCHITTEST : WMNCHitTest(Message);
else fOldTwndMethod(Message);
end;
end;

procedure TMagnetic.WMMouseMove(var Msg:TMessage);
var
pt:TPoint;
begin
fOldTWndMethod(Msg);
if not fActive then exit;
{whether can move}
if (fForm.WindowState<>wsNormal)and not fActive then exit;
{whether mouse left button}
if HiWord(GetAsyncKeyState(VK_LBUTTON))>0 then
begin
pt:=Point(TWMMouseMove(Msg).XPos,TWMMouseMove(Msg).YPos);
{calculate new point}
fNewPoint:=Point(fForm.left+pt.x-fOldPoint.x,fForm.top+pt.y-fOldPoint.y);
Magnetic(fNewPoint); {do magnetic}
fForm.SetBounds(fNewpoint.X,fNewpoint.Y,fForm.Width,fForm.Height);
end;
end;

procedure TMagnetic.WMLButtonDown(var Msg: TMessage);
begin
fOldTWndMethod(Msg);
if not fActive then exit;
fOldPoint:=Point(TWMLButtonDown(Msg).XPos,TWMLButtonDown(Msg).YPos);
if MagOption.fMagCustom and (CustomMagWnd>0) then
GetWindowRect(CustomMagWnd, RWnd_Custrom); { get custom rect }
if MagOption.fMagExplorer then
HWnd_Explorer:=FindWindow('CabinetWClass',nil);{ get explorer handle }
if HWnd_Explorer>0 then
GetWindowRect(HWnd_Explorer, RWnd_Explorer); { get explorer rect }
if MagOption.fMagTray then
HWnd_Tray:=FindWindow('Shell_TrayWnd',nil); { get traybar handle }
if HWnd_Tray>0 then
GetWindowRect(HWnd_Tray, RWnd_Tray); { get taskbar rect }
end;

procedure TMagnetic.WMNCHitTest(var Msg:TMessage);
var
pt:TPoint;
begin
fOldTWndMethod(Msg);
{if windowstate not normal and not can resize then exit}
if (fForm.WindowState<>wsNormal) or not fCanResize then exit;
{get form's edges and change it's size}
pt:=Point(TWMNCHitTest(Msg).XPos,TWMNCHitTest(Msg).YPos);
pt:=fForm.ScreenToClient(pt);
if (pt.x<5) and (pt.y<5) then Msg.Result:=htTopLeft
else if (pt.x>fForm.Width-5) and (pt.y<5) then Msg.Result:=htTopRight
else if (pt.x>fForm.Width-5) and (pt.y>fForm.Height-5) then Msg.Result:=htBottomRight
else if (pt.x<5) and (pt.y>fForm.Height-5) then Msg.Result:=htBottomLeft
else if (pt.x<5) then Msg.Result:=htLeft
else if (pt.y<5) then Msg.Result:=htTop
else if (pt.x>fForm.Width-5) then Msg.Result:=htRight
else if (pt.y>fForm.Height-5) then Msg.Result:=htBottom;
end;

procedure TMagnetic.Magnetic(var MagPoint:TPoint);
begin
if not fActive then exit;

if MagOption.fMagCustom and (CustomMagWnd>0) then
begin
{ mangetize custrom}
if Abs(RWnd_Custrom.Bottom-MagPoint.Y)<fMagEffect then MagPoint.Y:=RWnd_Custrom.Bottom
else if Abs(MagPoint.Y+fForm.Height-RWnd_Custrom.Top)<fMagEffect then MagPoint.Y:=RWnd_Custrom.Top-fForm.Height;
if Abs(RWnd_Custrom.Right-MagPoint.X)<fMagEffect then MagPoint.X:=RWnd_Custrom.Right
else if Abs(MagPoint.X+fForm.Width-RWnd_Custrom.Left)<fMagEffect then MagPoint.X:=RWnd_Custrom.Left-fForm.Width;
end;

if MagOption.fMagExplorer and (HWnd_Explorer>0) then
begin
{ mangetize explorer}
if Abs(RWnd_Explorer.Bottom-MagPoint.Y)<fMagEffect then MagPoint.Y:=RWnd_Explorer.Bottom
else if Abs(MagPoint.Y+fForm.Height-RWnd_Explorer.Top)<fMagEffect then MagPoint.Y:=RWnd_Explorer.Top-fForm.Height;
if Abs(RWnd_Explorer.Right-MagPoint.X)<fMagEffect then MagPoint.X:=RWnd_Explorer.Right
else if Abs(MagPoint.X+fForm.Width-RWnd_Explorer.Left)<fMagEffect then MagPoint.X:=RWnd_Explorer.Left-fForm.Width;
end;

if MagOption.fMagTray and (HWnd_Tray>0) then
begin
{ mangetize tray}
if Abs(RWnd_Tray.Bottom-MagPoint.Y)<fMagEffect then MagPoint.Y:=RWnd_Tray.Bottom
else if Abs(MagPoint.Y+fForm.Height-RWnd_Tray.Top)<fMagEffect then MagPoint.Y:=RWnd_Tray.Top-fForm.Height;
if Abs(RWnd_Tray.Right-MagPoint.X)<fMagEffect then MagPoint.X:=RWnd_Tray.Right
else if Abs(MagPoint.X+fForm.Width-RWnd_Tray.Left)<fMagEffect then MagPoint.X:=RWnd_Tray.Left-fForm.Width;
end;

{ magnetize screen }
if MagPoint.X<fMagEffect then MagPoint.X:=0;
if MagPoint.X>Screen.Width-fForm.Width-fMagEffect then MagPoint.X:=Screen.Width-fForm.Width;
if MagPoint.Y<fMagEffect then MagPoint.Y:=0;
if MagPoint.Y>Screen.Height-fForm.Height-fMagEffect then MagPoint.Y:=Screen.Height-fForm.Height;
{ end screen }

end;

procedure TMagnetic.SetMagOption(Value:TMagOption);
begin
FMagOption.Assign(Value);
end;

procedure Register;
begin
RegisterComponents('Samples', [TMagnetic]);
end;

end.
 
To bubble:
你说的是哪个控件?
 
procedure TChatMainFm.Panel1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
//记录当前坐标
Canmove := true;
LastX := X;
LastY := Y;
end;

procedure TChatMainFm.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Canmove := false;
end;

procedure TChatMainFm.Panel1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var
nLeft,nTop:integer; //记录新位置的临时变量
begin
if not Canmove then exit;
nLeft := Left;
nTop := Top;
//计算新坐标
nleft := Left + (X - LastX);
nTop := Top + (Y - LastY);
//修正坐标,产生“磁化”效果
if LockWin > 0 then //LockWin:被吸附的窗体
Magnetize(nleft, ntop);

//重设窗口位置
Left := nLeft;
Top := nTop;
end;

procedure TChatMainFm.Magnetize(var nl, nt: integer);
function Min(a,b:integer):integer;
begin
if a > b then
result := b
else
result := a;
end;
function Max(a,b:integer):integer;
begin
if a < b then
result := b
else
result := a;
end;
var
H_Overlapped,V_Overlapped:boolean; //记录投影线是否重叠
tw,ww,wh:integer; //临时变量
const
MagneticForce:integer=20; //“磁力”的大小。
begin
PasteNow := 0;
PasteChat := 0;
//判断水平方向是否有重叠投影
ww := WinRect.Right-WinRect.Left;
tw := Max(WinRect.Right,nl+Width)-Min(WinRect.Left,nl);
H_Overlapped := tw<=(Width+ww);
//再判断垂直方向
wh := WinRect.Bottom-WinRect.Top;
tw := Max(WinRect.Bottom,nt+Height)-Min(WinRect.Top,nt);
V_Overlapped := tw<=(Height+wh);

//足够接近的话就调整坐标
if H_Overlapped then begin
if (0 < Abs(WinRect.Bottom-nt)) and
(Abs(WinRect.Bottom -nt) < MagneticForce) then begin
nt := WinRect.Bottom;
end
else
if (0 < Abs(nt+Height-WinRect.Top)) and
(Abs(nt+Height-WinRect.Top) < MagneticForce) then begin
nt := WinRect.Top - Height;
end;
end;


if V_Overlapped then begin
if (0 < Abs(WinRect.Right-nl)) and
(Abs(WinRect.Right-nl) < MagneticForce) then begin
nl := WinRect.Right;
end
else
if (0 < Abs(nl+Width-WinRect.Left)) and
(Abs(nl+Width-WinRect.Left) < MagneticForce) then begin
nl := WinRect.Left - Width;
end;
end;

//add by panjf
case PasteNow of
1, 3: begin
if Abs(nt - WinRect.Top) < MagneticForce then
nt := WinRect.Top;
if Abs(nt + Height - WinRect.Bottom) < MagneticForce then
nt := WinRect.Bottom - Height;
tTop := nt - WinRect.Top;
end;
2, 4: begin
if Abs(nl - WinRect.Left) < MagneticForce then
nl := WinRect.Left;
if Abs(nl + Width - WinRect.Right) < MagneticForce then
nl := WinRect.Right - Width;
tLeft := nl - WinRect.Left;
end;
end;
end;
 
先新建一应用程序项目,把主窗口Form1适当改小些,并将BorderStyle设为bsNone。放一个按钮元件,双击它并在OnClick事件中写“Close;”。待会儿就按它来结束程序。现在切换到代码编辑区,定义几个全局变量。
  var
   Form1: TForm1; //“磁性”窗口
   LastX, LastY: Integer; //记录前一次的坐标
   WinampRect:TRect; //保存Winamp窗口的矩形区域
   hwnd_Winamp:HWND; //Winamp窗口的控制句柄
  接着编写Form1的OnMouseDown和OnMouseMove事件。
  procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
  const
   ClassName=‘Winamp v1.x’; //Winamp主窗口的类名
   //如果改成ClassName=‘TAppBuilder’,你就会发现连Delphi也有引力啦!
  begin
  //记录当前坐标
  LastX := X;
  LastY := Y;
  //查找Winamp
  hwnd_Winamp := FindWindow(ClassName,nil);
  if hwnd_Winamp>0 then //找到的话,记录其窗口区域
  GetWindowRect(hwnd_Winamp, WinampRect);
  end;
  procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
   Y: Integer);
  var
   nLeft,nTop:integer; //记录新位置的临时变量
  begin
  //检查鼠标左键是否按下
   if HiWord(GetAsyncKeyState(VK_LBUTTON)) > 0 then
   begin
   //计算新坐标
   nleft := Left + X - LastX;
   nTop := Top + Y - LastY;
   //如果找到Winamp,就修正以上坐标,产生“磁化”效果
   if hwnd_Winamp>0 then
   Magnetize(nleft,ntop);
   //重设窗口位置
   SetBounds(nLeft,nTop,width,height);
   end;
  end;
  别急着,看Magnetize()过程,先来了解一下修正坐标的原理。根据对Winamp实现效果的观察,我斗胆给所谓“磁化”下一个简单的定义,就是“在原窗口与目标窗口接近到某种预定程度,通过修正原窗口的坐标,使两窗口处于同一平面且具有公共边的过程”。依此定义,我设计了以下的“磁化”步骤。第一步,判断目标窗口(即Winamp)和我们的Form1在水平及垂直方向上的投影线是否重叠。“某方向投影线有重叠”是“需要进行坐标修正”的必要非充分条件。判断依据是两投影线段最右与最左边界的差减去它们宽度和的值的正负。第二步,判断两窗口对应边界是否靠得足够近了。肯定的话就让它们合拢。
  好了,下面便是“神秘”的Magnetize过程了……
  procedure TForm1.Magnetize(var nl,nt:integer);
   //内嵌两个比大小的函数
   function Min(a,b:integer):integer;
   begin
   if a>b then result:=b else result:=a;
   end;
   function Max(a,b:integer):integer;
   begin
   if a    end;
  var
   H_Overlapped,V_Overlapped:boolean; //记录投影线是否重叠
   tw,ww,wh:integer; //临时变量
  const
   MagneticForce:integer=50; //“磁力”的大小。
   //准确的说,就是控制窗口边缘至多相距多少像素时需要修正坐标
   //为了演示,这里用一个比较夸张的数字——50。
   //一般可以用20左右,那样比较接近Winamp的效果
  begin
  //判断水平方向是否有重叠投影
  ww := WinampRect.Right-WinampRect.Left;
  tw := Max(WinampRect.Right,nl+Width)-Min(WinampRect.Left,nl);
  H_Overlapped := tw<=(Width+ww);
  //再判断垂直方向
  wh := WinampRect.Bottom-WinampRect.Top;
  tw := Max(WinampRect.Bottom,nt+Height)-Min(WinampRect.Top,nt);
  V_Overlapped := tw<=(Height+wh);
  //足够接近的话就调整坐标
  if H_Overlapped then
   begin
   if Abs(WinampRect.Bottom-nt)   
else if Abs(nt+Height-WinampRect.Top)   
end;
  if V_Overlapped then
   begin
   if Abs(WinampRect.Right-nl)   
else if Abs(nl+Width-WinampRect.Left)   
end;
  end;
 
http://www.pigtwo.com/CtrlData/WebSite/DockPresident.exe
 
顶部