Delphi磁性窗口

转自我的旧博客

昨天要用到磁性窗口,就是两个窗口离得近到一个距离就吸附到一起.拖动主窗口,吸附窗体一块运动.

到网上搜了一下,基本没见到可以使用的.有个东东,还是收费的.没办法自己写了一个.

用法很简单,把你的窗口都改成从这个继承即可生效.例如

type
TForm3 = class(TCustomMagnetForm)
private
{ Private declarations }

public
{ Public declarations }
end;

var
Form3: TForm3;

不多说了,上代码

{ ******************************************************* }
{ }
{ 磁性吸附窗口 }
{ }
{ 版权所有 (C) 2011 wr960204武稀松 }
{ }
{ ******************************************************* }

unit MagnetForm;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Generics.Collections;

type
TCustomMagnetForm = class(TForm)
private type
TMagnetFormList = TList<TCustomMagnetForm>;
class var
// 吸附距离
FMagnetBuffer: Integer;

var
// 吸附子窗口容器
FMagnetClientList: TMagnetFormList;
// 相对主窗口的位置
FMagnetPosOffset: TPoint;
// 可否随主窗口移动
FEnableMagnetMoveClient: Boolean;
// 移除子窗口
procedure RemoveMagnetForm(AForm: TCustomMagnetForm);
// 添加子窗口
procedure AddMagnetForm(AForm: TCustomMagnetForm; Value: TPoint);
// 处理子窗口吸附
function ProcessClient(var ServerBound, ClientBound: TRect): Boolean;
// 处理主窗口吸附
function ProcessServer(var ServerBound, ClientBound: TRect;
AClient: TCustomMagnetForm): Boolean;
// 主窗口移动
procedure ProcessServerMove();

protected
procedure WMWindowPosChanging(var Message: TWMWindowPosChanging);
message WM_WINDOWPOSCHANGING;
procedure WMMoving(var Message: TWMMoving); message WM_MOVING;
procedure WMMove(var Message: TWMMove); message WM_MOVE;
procedure DoClose(var Action: TCloseAction); override;
procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;

public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
class property MagnetBuffer: Integer read FMagnetBuffer write FMagnetBuffer;
end;

implementation

{ TCustomMagnetForm }

constructor TCustomMagnetForm.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FMagnetClientList := TMagnetFormList.Create;
end;

destructor TCustomMagnetForm.Destroy;
begin
if Self <> Application.MainForm then
RemoveMagnetForm(Self);
FMagnetClientList.Free;
inherited Destroy;
end;

procedure TCustomMagnetForm.DoClose(var Action: TCloseAction);
begin
inherited DoClose(Action);
if Self <> Application.MainForm then
RemoveMagnetForm(Self);
end;

function TCustomMagnetForm.ProcessClient(var ServerBound,
ClientBound: TRect): Boolean;
var
lspace, rspace, tspace, bspace: Integer;
begin
Result := False;
lspace := ABS(ClientBound.Right – ServerBound.Left);
rspace := ABS(ClientBound.Left – ServerBound.Right);
tspace := ABS(ClientBound.Bottom – ServerBound.Top);
bspace := ABS(ClientBound.Top – ServerBound.Bottom);

FMagnetPosOffset := Point(ClientBound.Left – ServerBound.Left,
ClientBound.Top – ServerBound.Top);

if (ClientBound.Bottom > ServerBound.Top) and
(ClientBound.Top < ServerBound.Bottom) then
begin
if lspace < rspace then
begin
if lspace < FMagnetBuffer then
begin
AddMagnetForm(Self, Point(ClientBound.Left – ServerBound.Left,
ClientBound.Top – ServerBound.Top));
OffsetRect(ClientBound, (ServerBound.Left – ClientBound.Right), 0);
Result := True;
end;
end
else
begin
if rspace < FMagnetBuffer then
begin
AddMagnetForm(Self, Point(ClientBound.Left – ServerBound.Left,
ClientBound.Top – ServerBound.Top));
OffsetRect(ClientBound, (ServerBound.Right – ClientBound.Left), 0);
Result := True;
end;
end;
end;
if (ClientBound.Right > ServerBound.Left) and
(ClientBound.Left < ServerBound.Right) then
begin
if tspace < bspace then
begin
if tspace < FMagnetBuffer then
begin
AddMagnetForm(Self, Point(ClientBound.Left – ServerBound.Left,
ClientBound.Top – ServerBound.Top));
OffsetRect(ClientBound, 0, ServerBound.Top – ClientBound.Bottom);
Result := True;
end;
end
else
begin
if bspace < FMagnetBuffer then
begin
AddMagnetForm(Self, Point(ClientBound.Left – ServerBound.Left,
ClientBound.Top – ServerBound.Top));
OffsetRect(ClientBound, 0, ServerBound.Bottom – ClientBound.Top);
Result := True;
end;
end;
end;
end;

function TCustomMagnetForm.ProcessServer(var ServerBound, ClientBound: TRect;
AClient: TCustomMagnetForm): Boolean;
var
lspace, rspace, tspace, bspace: Integer;
begin
Result := False;
lspace := ABS(ClientBound.Right – ServerBound.Left);
rspace := ABS(ClientBound.Left – ServerBound.Right);
tspace := ABS(ClientBound.Bottom – ServerBound.Top);
bspace := ABS(ClientBound.Top – ServerBound.Bottom);

FMagnetPosOffset := Point(ClientBound.Left – ServerBound.Left,
ClientBound.Top – ServerBound.Top);

if (ClientBound.Bottom > ServerBound.Top) and
(ClientBound.Top < ServerBound.Bottom) then
begin
if lspace < rspace then
begin
if lspace < FMagnetBuffer then
begin
AddMagnetForm(AClient, Point(ClientBound.Left – ServerBound.Left,
ClientBound.Top – ServerBound.Top));
OffsetRect(ServerBound, -(ServerBound.Left – ClientBound.Right), 0);
Result := True;
end;
end
else
begin
if rspace < FMagnetBuffer then
begin
AddMagnetForm(AClient, Point(ClientBound.Left – ServerBound.Left,
ClientBound.Top – ServerBound.Top));
OffsetRect(ServerBound, -(ServerBound.Right – ClientBound.Left), 0);
Result := True;
end;
end;
end;
if (ClientBound.Right > ServerBound.Left) and
(ClientBound.Left < ServerBound.Right) then
begin
if tspace < bspace then
begin
if tspace < FMagnetBuffer then
begin
AddMagnetForm(AClient, Point(ClientBound.Left – ServerBound.Left,
ClientBound.Top – ServerBound.Top));
OffsetRect(ServerBound, 0, -(ServerBound.Top – ClientBound.Bottom));
Result := True;
end;
end
else
begin
if bspace < FMagnetBuffer then
begin
AddMagnetForm(AClient, Point(ClientBound.Left – ServerBound.Left,
ClientBound.Top – ServerBound.Top));
OffsetRect(ServerBound, 0, -(ServerBound.Bottom – ClientBound.Top));
Result := True;
end;
end;
end;
end;

procedure TCustomMagnetForm.ProcessServerMove;
var
i: Integer;
p: TPoint;
begin
Inherited;
if Self = Application.MainForm then
begin
if FMagnetClientList <> nil then
for i := 0 to FMagnetClientList.Count – 1 do
begin
if FMagnetClientList[i].FEnableMagnetMoveClient then
begin
p := FMagnetClientList[i].FMagnetPosOffset;
FMagnetClientList[i].SetBounds(Left + p.X, Top + p.Y,
FMagnetClientList[i].Width, FMagnetClientList[i].Height);
end;
end;
end;
end;

procedure TCustomMagnetForm.AddMagnetForm(AForm: TCustomMagnetForm;
Value: TPoint);
var
Index: Integer;
begin
if (Application.MainForm <> nil) and
(Application.MainForm is TCustomMagnetForm) then
with TCustomMagnetForm(Application.MainForm) do
if FMagnetClientList <> nil then
begin
AForm.FMagnetPosOffset := Value;
Index := FMagnetClientList.IndexOf(AForm);
if Index < 0 then
begin
Index := FMagnetClientList.Add(AForm);
end;
end;
end;

procedure TCustomMagnetForm.RemoveMagnetForm(AForm: TCustomMagnetForm);
begin
AForm.FEnableMagnetMoveClient := False;
if (Application.MainForm <> nil) and
(Application.MainForm is TCustomMagnetForm) then
with TCustomMagnetForm(Application.MainForm) do
if FMagnetClientList <> nil then
begin
if FMagnetClientList.IndexOf(AForm) >= 0 then
begin
FMagnetClientList.Remove(AForm);
end;
end;
end;

procedure TCustomMagnetForm.WMMove(var Message: TWMMove);
begin
ProcessServerMove;
end;

procedure TCustomMagnetForm.WMMoving(var Message: TWMMoving);
begin
ProcessServerMove;
end;

procedure TCustomMagnetForm.WMSysCommand(var Message: TWMSysCommand);
procedure SetAllClientEnableMove();
var
i: Integer;
begin
Inherited;
if Self = Application.MainForm then
begin
if FMagnetClientList <> nil then
for i := 0 to FMagnetClientList.Count – 1 do
begin
FMagnetClientList[i].FEnableMagnetMoveClient := True;
end;
end;
end;

begin
Inherited;
if (Message.CmdType and SC_MOVE) = SC_MOVE then
begin
SetAllClientEnableMove();
end;
end;

procedure TCustomMagnetForm.WMWindowPosChanging(var Message
: TWMWindowPosChanging);
var
ServerBound, ClientBound: TRect;
lspace, rspace, tspace, bspace: Integer;
MainForm: TCustomMagnetForm;
oBound: TRect;
i: Integer;
begin
inherited;

if (Message.WindowPos^.flags and SWP_NOMOVE) = SWP_NOMOVE then
begin
Exit;
end;

if (Application.MainForm = nil) or
(not(Application.MainForm is TCustomMagnetForm)) then
Exit;

if (Application.MainForm = Self) then
begin
ServerBound := Rect(Message.WindowPos^.X, Message.WindowPos^.Y,
Message.WindowPos^.X + Message.WindowPos^.cx, Message.WindowPos^.Y +
Message.WindowPos^.cy);
for i := 0 to Screen.FormCount – 1 do
begin
if (Screen.Forms[i] <> Self) and (Screen.Forms[i] is TCustomMagnetForm)
and ((FMagnetClientList.IndexOf(TCustomMagnetForm(Screen.Forms[i])) < 0)
or (not TCustomMagnetForm(Screen.Forms[i])
.FEnableMagnetMoveClient)) then
begin
ClientBound := Screen.Forms[i].BoundsRect;
TCustomMagnetForm(Screen.Forms[i]).FEnableMagnetMoveClient := False;
if ProcessServer(ServerBound, ClientBound,
TCustomMagnetForm(Screen.Forms[i])) then
begin
Message.WindowPos^.X := ServerBound.Left;
Message.WindowPos^.Y := ServerBound.Top;
Message.WindowPos^.cx := ServerBound.Right – ServerBound.Left;
Message.WindowPos^.cy := ServerBound.Bottom – ServerBound.Top;

break;
end;
end;
end;
end
else
begin

MainForm := TCustomMagnetForm(Application.MainForm);
MainForm.RemoveMagnetForm(Self);
ServerBound := Application.MainForm.BoundsRect;
ClientBound := Rect(Message.WindowPos^.X, Message.WindowPos^.Y,
Message.WindowPos^.X + Message.WindowPos^.cx, Message.WindowPos^.Y +
Message.WindowPos^.cy);
ProcessClient(ServerBound, ClientBound);
Message.WindowPos^.X := ClientBound.Left;
Message.WindowPos^.Y := ClientBound.Top;
Message.WindowPos^.cx := ClientBound.Right – ClientBound.Left;
Message.WindowPos^.cy := ClientBound.Bottom – ClientBound.Top;
FEnableMagnetMoveClient := True;
end;
end;

initialization

TCustomMagnetForm.FMagnetBuffer := 10;

finalization

end.

此条目发表在Delphi, 未分类分类目录。将固定链接加入收藏夹。

发表评论

电子邮件地址不会被公开。

您可以使用这些HTML标签和属性: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <strike> <strong>

你必须启用JavaScript