{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
[url]http://www.mozilla.org/MPL/MPL-1.1.html[/url]

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvMagnet.PAS, released on 2001-02-28.

The Initial Developer of the Original Code is Sébastien Buysse [sbuysse att buypin dott com]
Portions created by Sébastien Buysse are Copyright (C) 2001 Sébastien Buysse.
All Rights Reserved.

Contributor(s): Michael Beck [mbeck att bigfoot dott com].

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at [url]http://jvcl.sourceforge.net[/url]

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvFormMagnet.pas 11729 2008-02-20 14:49:30Z obones $

unit JvFormMagnet;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, Messages, SysUtils, Classes, Controls, Forms,
  JvComponentBase, MultiMon;

type
  TJvFormMagnet = class(TJvComponent)
  private
    FForm: TForm;
    FActive: Boolean;
    FScreenMagnet: Boolean;
    FFormGlue: Boolean;
    FArea: Cardinal;
    FMainFormMagnet: Boolean;
    FLastRightDock: TDateTime;
    FLastLeftDock: TDateTime;
    FLastTopDock: TDateTime;
    FLastBottomDock: TDateTime;
    function NewWndProc(var Msg: TMessage): Boolean;
    procedure MagnetScreen(OldRect: TRect; var FormRect: TRect; ScreenRect: TRect);
    procedure GlueForms(var FormRect: TRect);
    procedure MagnetToMain(OldRect: TRect; var FormRect: TRect; MainRect: TRect);
  public
    procedure MoveTo(var SrcRect, Rect: TRect);
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Active: Boolean read FActive write FActive default False;
    property ScreenMagnet: Boolean read FScreenMagnet write FScreenMagnet default True;
    property Area: Cardinal read FArea write FArea default 15;
    property FormGlue: Boolean read FFormGlue write FFormGlue default True;
    property MainFormMagnet: Boolean read FMainFormMagnet write FMainFormMagnet default False;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$URL: [url]https://jvcl.svn.sourceforge.net/svnroot/jvcl/branches/JVCL3_34_PREPARATION/run/JvFormMagnet.pas[/url] $';
    Revision: '$Revision: 11729 $';
    Date: '$Date: 2008-02-20 15:49:30 +0100 (mer., 20 févr. 2008) $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  JvWndProcHook;

constructor TJvFormMagnet.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FActive := False;
  FScreenMagnet := True;
  FArea := 15;
  FFormGlue := True;
  FMainFormMagnet := False;

  FLastRightDock := 0.0;
  FLastLeftDock := 0.0;
  FLastTopDock := 0.0;
  FLastBottomDock := 0.0;

  FForm := TForm(GetParentForm(TControl(AOwner)));
  if not (csDesigning in ComponentState) and (FForm <> nil) then
    RegisterWndProcHook(FForm, NewWndProc, hoBeforeMsg);
end;

destructor TJvFormMagnet.Destroy;
begin
  if not (csDesigning in ComponentState) and (FForm <> nil) then
    UnregisterWndProcHook(FForm, NewWndProc, hoBeforeMsg);
  inherited Destroy;
end;

procedure TJvFormMagnet.MagnetScreen(OldRect: TRect; var FormRect: TRect; ScreenRect: TRect);
var
  FormWidth, FormHeight: Integer;

  function MovingToLeft: Boolean;
  begin
    Result := OldRect.Left > FormRect.Left;
  end;

  function MovingToRight: Boolean;
  begin
    Result := OldRect.Left < FormRect.Left;
  end;

  function MovingToTop: Boolean;
  begin
    Result := OldRect.Top > FormRect.Top;
  end;

  function MovingToBottom: Boolean;
  begin
    Result := OldRect.Top < FormRect.Top;
  end;

  function OkayForAll(var Value: TDateTime): Boolean;
  begin
    Result := Abs(Value - Now) > EncodeTime(0, 0, 0, 250);
  end;

  function OkayForRight: Boolean;
  begin
    Result := OkayForAll(FLastRightDock);
  end;

  function OkayForLeft: Boolean;
  begin
    Result := OkayForAll(FLastLeftDock);
  end;

  function OkayForTop: Boolean;
  begin
    Result := OkayForAll(FLastTopDock);
  end;

  function OkayForBottom: Boolean;
  begin
    Result := OkayForAll(FLastBottomDock);
  end;

  procedure DockOnLeft;
  begin
    FormRect.Left := ScreenRect.Left;
    FormRect.Right := FormRect.Left + FormWidth;
    FLastLeftDock := Now;
  end;

  procedure UndockOnLeftOutside;
  begin
    FormRect.Left := ScreenRect.Left - Integer(FArea);
    FormRect.Right := FormRect.Left + FormWidth;
    FLastLeftDock := Now;
  end;

  procedure UndockOnLeftInside;
  begin
    FormRect.Left := ScreenRect.Left + Integer(FArea);
    FormRect.Right := FormRect.Left + FormWidth;
    FLastLeftDock := Now;
  end;

  procedure DockOnRight;
  begin
    FormRect.Left := ScreenRect.Right - FormWidth;
    FormRect.Right := ScreenRect.Right;
    FLastRightDock := Now;
  end;

  procedure UndockOnRightOutside;
  begin
    FormRect.Left := ScreenRect.Right - FormWidth + Integer(FArea);
    FormRect.Right := ScreenRect.Right + Integer(FArea);
    FLastRightDock := Now;
  end;

  procedure UndockOnRightInside;
  begin
    FormRect.Left := ScreenRect.Right - FormWidth - Integer(FArea);
    FormRect.Right := ScreenRect.Right - Integer(FArea);
    FLastRightDock := Now;
  end;

  procedure DockOnTop;
  begin
    FormRect.Top := ScreenRect.Top;
    FormRect.Bottom := FormRect.Top + FormHeight;
    FLastTopDock := Now;
  end;

  procedure UndockOnTopOutside;
  begin
    FormRect.Top := ScreenRect.Top - Integer(FArea);
    FormRect.Bottom := FormRect.Top + FormHeight;
    FLastTopDock := Now;
  end;

  procedure UndockOnTopInside;
  begin
    FormRect.Top := ScreenRect.Top + Integer(FArea);
    FormRect.Bottom := FormRect.Top + FormHeight;
    FLastTopDock := Now;
  end;

  procedure DockOnBottom;
  begin
    FormRect.Top := ScreenRect.Bottom - FormHeight;
    FormRect.Bottom := ScreenRect.Bottom;
    FLastBottomDock := Now;
  end;

  procedure UndockOnBottomInside;
  begin
    FormRect.Top := ScreenRect.Bottom - FormHeight - Integer(FArea);
    FormRect.Bottom := ScreenRect.Bottom - Integer(FArea);
    FLastBottomDock := Now;
  end;

  procedure UndockOnBottomOutside;
  begin
    FormRect.Top := ScreenRect.Bottom - FormHeight + Integer(FArea);
    FormRect.Bottom := ScreenRect.Bottom + Integer(FArea);
    FLastBottomDock := Now;
  end;

begin
  FormWidth := FormRect.Right - FormRect.Left;
  FormHeight := FormRect.Bottom - FormRect.Top;

  // Magnet/UnMagnet Left, Magnet/UnMagnet Right
  if MovingToLeft then
    if OkayForLeft then
    begin
      if ((FormRect.Left - ScreenRect.Left) in [2..FArea]) or
        (Abs(FormRect.Left - ScreenRect.Left) = 1) then
        DockOnLeft
      else
      if Abs(FormRect.Left - ScreenRect.Left) in [2..FArea] then
        UndockOnLeftOutside
      else
      if (ScreenRect.Right - FormRect.Right) in [2..FArea] then
        UndockOnRightInside
      else
      if Abs(ScreenRect.Right - FormRect.Right) in [1..FArea] then
        DockOnRight;
    end
    else
    if Abs(FormRect.Left - ScreenRect.Left) < Integer(FArea) then
      DockOnLeft
    else
    if Abs(ScreenRect.Right - FormRect.Right) < Integer(FArea) then
      DockOnRight;

  // Magnet/UnMagnet Left, Magnet/UnMagnet Right
  if MovingToRight then
    if OkayForRight then
    begin
      if ((ScreenRect.Right - FormRect.Right) in [2..FArea]) or
        (Abs(ScreenRect.Right - FormRect.Right) = 1) then
        DockOnRight
      else
      if Abs(ScreenRect.Right - FormRect.Right) in [2..FArea] then
        UndockOnRightOutside
      else
      if (ScreenRect.Left - FormRect.Left) in [2..FArea] then
        DockOnLeft
      else
      if Abs(ScreenRect.Left - FormRect.Left) in [1..FArea] then
        UndockOnLeftInside;
    end
    else
    if Abs(ScreenRect.Right - FormRect.Right) < Integer(FArea) then
      DockOnRight
    else
    if Abs(ScreenRect.Left - FormRect.Left) < Integer(FArea) then
      DockOnLeft;

  // Magnet/UnMagnet Bottom, Magnet/UnMagnet Top
  if MovingToTop then
    if OkayForTop then
    begin
      if ((FormRect.Top - ScreenRect.Top) in [2..FArea]) or
        (Abs(FormRect.Top - ScreenRect.Top) = 1) then
        DockOnTop
      else
      if Abs(FormRect.Top - ScreenRect.Top) in [2..FArea] then
        UndockOnTopOutside
      else
      if (ScreenRect.Bottom - FormRect.Bottom) in [2..FArea] then
        UndockOnBottomInside
      else
      if Abs(ScreenRect.Bottom - FormRect.Bottom) in [1..FArea] then
        DockOnBottom;
    end
    else
    if Abs(FormRect.Top - ScreenRect.Top) < Integer(FArea) then
      DockOnTop
    else
    if Abs(ScreenRect.Bottom - FormRect.Bottom) < Integer(FArea) then
      DockOnBottom;

  // Magnet/UnMagnet Bottom, Magnet/UnMagnet Top
  if MovingToBottom then
    if OkayForBottom then
    begin
      if (FormRect.Top - ScreenRect.Top) in [2..FArea] then
        UndockOnTopInside
      else
      if Abs(FormRect.Top - ScreenRect.Top) < Integer(FArea) then
        DockOnTop
      else
      if (ScreenRect.Bottom - FormRect.Bottom) in [2..FArea] then
        DockOnBottom
      else
      if Abs(ScreenRect.Bottom - FormRect.Bottom) in [1..FArea] then
        UndockOnBottomOutside;
    end
    else
    if Abs(FormRect.Top - ScreenRect.Top) < Integer(FArea) then
      DockOnTop
    else
    if Abs(ScreenRect.Bottom - FormRect.Bottom) < Integer(FArea) then
      UndockOnBottomOutside;
end;

procedure TJvFormMagnet.GlueForms(var FormRect: TRect);
var
  I: Integer;
begin
  if Assigned(FForm) then
  begin
    for I := 0 to Application.ComponentCount - 1 do
    begin
      if Application.Components[I] is TForm then
      begin
        with Application.Components[I] as TForm do
        begin
          if (Left = FForm.Left + FForm.Width) then
          begin
            // <--main--><--form-->

            if ((FForm.Top >= Top) and (FForm.Top <= (Top + Height))) or
               ((Top >= FForm.Top) and (Top <= (FForm.Top + FForm.Height))) then
            begin
              Left := Left + (FormRect.Left - FForm.Left);
              Top := Top + (FormRect.Top - FForm.Top);
            end;
          end
          else
          begin
            if (Left + Width = FForm.Left) then
            begin
              // <--form--><--main-->
              if ((FForm.Top >= Top) and (FForm.Top <= (Top + Height))) or
                 ((Top >= FForm.Top) and (Top <= (FForm.Top + FForm.Height))) then
              begin
                Left := Left + (FormRect.Left - FForm.Left);
                Top := Top + (FormRect.Top - FForm.Top);
              end;
            end
            else
            begin
              if (Top = FForm.Top + FForm.Height) then
              begin
                // <--main-->
                // <--form-->

                if ((Left >= FForm.Left) and (Left <= (FForm.Left + FForm.Width))) or
                   ((FForm.Left >= Left) and (FForm.Left <= (Left + Width))) then
                begin
                  Left := Left + (FormRect.Left - FForm.Left);
                  Top := Top + (FormRect.Top - FForm.Top);
                end;
              end
              else begin
                if (Top + Height = FForm.Top) then
                begin
                  // <--form-->
                  // <--main-->
                  if ((Left >= FForm.Left) and (Left <= (FForm.Left + FForm.Width))) or
                     ((FForm.Left >= Left) and (FForm.Left <= (Left + Width))) then
                  begin
                    Left := Left + (FormRect.Left - FForm.Left);
                    Top := Top + (FormRect.Top - FForm.Top);
                  end;
                end;
              end;
            end;
          end;
        end;
      end;
    end;
  end;
end;

procedure TJvFormMagnet.MagnetToMain(OldRect: TRect; var FormRect: TRect; MainRect: TRect);
var
  FormWidth, FormHeight: Integer;

  function OkayForAll(var Value: TDateTime): Boolean;
  begin
    Result := Abs(Value - Now) > EncodeTime(0, 0, 0, 250);
  end;

  function OkayForRight: Boolean;
  begin
    Result := OkayForAll(FLastRightDock);
  end;

  function OkayForTop: Boolean;
  begin
    Result := OkayForAll(FLastTopDock);
  end;

  function MovingToLeft: Boolean;
  begin
    Result := OldRect.Left > FormRect.Left;
  end;

  function MovingToRight: Boolean;
  begin
    Result := OldRect.Left < FormRect.Left;
  end;

  function MovingToTop: Boolean;
  begin
    Result := OldRect.Top > FormRect.Top;
  end;

  function MovingToBottom: Boolean;
  begin
    Result := OldRect.Top < FormRect.Top;
  end;

  function InWidth: Boolean;
  begin
    Result := ((FormRect.Left > MainRect.Left) and (FormRect.Left < MainRect.Right)) or
      ((FormRect.Left < MainRect.Left) and (FormRect.Right > MainRect.Left));
  end;

  function InHeight: Boolean;
  begin
    Result := ((FormRect.Top > MainRect.Top) and (FormRect.Top < MainRect.Bottom)) or
      ((FormRect.Top < MainRect.Top) and (FormRect.Bottom > MainRect.Top));
  end;

  procedure DockOnBottom;
  begin
    FormRect.Top := MainRect.Bottom;
    FormRect.Bottom := FormRect.Top + FormHeight;
    FLastTopDock := Now;
  end;

  procedure UndockOnBottomInside;
  begin
    FormRect.Top := MainRect.Bottom - Integer(FArea);
    FormRect.Bottom := FormRect.Top + FormHeight;
    FLastTopDock := Now;
  end;

  procedure UndockOnBottomOutside;
  begin
    FormRect.Top := MainRect.Bottom + Integer(FArea);
    FormRect.Bottom := FormRect.Top + FormHeight;
    FLastTopDock := Now;
  end;

  procedure DockOnTop;
  begin
    FormRect.Top := MainRect.Top - FormHeight;
    FormRect.Bottom := MainRect.Top;
    FLastTopDock := Now;
  end;

  procedure UndockOnTopOutside;
  begin
    FormRect.Top := MainRect.Top - FormHeight - Integer(FArea);
    FormRect.Bottom := MainRect.Top - Integer(FArea);
    FLastTopDock := Now;
  end;

  procedure UndockOnTopInside;
  begin
    FormRect.Top := MainRect.Top - FormHeight + Integer(FArea);
    FormRect.Bottom := MainRect.Top + Integer(FArea);
    FLastTopDock := Now;
  end;

  procedure DockOnRight;
  begin
    FormRect.Left := MainRect.Right;
    FormRect.Right := FormRect.Left + FormWidth;
    FLastRightDock := Now;
  end;

  procedure UndockOnRightInside;
  begin
    FormRect.Left := MainRect.Right - Integer(FArea);
    FormRect.Right := FormRect.Left + FormWidth;
    FLastRightDock := Now;
  end;

  procedure UndockOnRightOutside;
  begin
    FormRect.Left := MainRect.Right + Integer(FArea);
    FormRect.Right := FormRect.Left + FormWidth;
    FLastRightDock := Now;
  end;

  procedure DockOnLeft;
  begin
    FormRect.Left := MainRect.Left - FormWidth;
    FormRect.Right := MainRect.Left;
    FLastRightDock := Now;
  end;

  procedure UndockOnLeftInside;
  begin
    FormRect.Left := MainRect.Left - FormWidth + Integer(FArea);
    FormRect.Right := MainRect.Left + Integer(FArea);
    FLastRightDock := Now;
  end;

  procedure UndockOnLeftOutside;
  begin
    FormRect.Left := MainRect.Left - FormWidth - Integer(FArea);
    FormRect.Right := MainRect.Left - Integer(FArea);
    FLastRightDock := Now;
  end;

begin
  FormWidth := FormRect.Right - FormRect.Left;
  FormHeight := FormRect.Bottom - FormRect.Top;

  // Magnet/UnMagnet Bottom, Magnet/UnMagnet Top
  if MovingToTop and InWidth then
    if OkayForTop then
    begin
      if (FormRect.Top - MainRect.Bottom) in [2..FArea] then
        DockOnBottom
      else
      if -(FormRect.Top - MainRect.Bottom) in [2..FArea] then
        UndockOnBottomInside
      else
      if (FormRect.Bottom - MainRect.Top) in [2..FArea] then
        DockOnTop
      else
      if -(FormRect.Bottom - MainRect.Top) in [2..FArea] then
        UndockOnTopOutside;
    end
    else
    if Abs(FormRect.Top - MainRect.Bottom) < Integer(FArea) then
      DockOnBottom
    else
    if Abs(FormRect.Bottom - MainRect.Top) < Integer(FArea) then
      DockOnTop;

  if MovingToBottom and InWidth then
    if OkayForTop then
    begin
      if (FormRect.Top - MainRect.Bottom) in [2..FArea] then
        UndockOnBottomOutside
      else
      if -(FormRect.Top - MainRect.Bottom) in [2..FArea] then
        DockOnBottom
      else
      if (FormRect.Bottom - MainRect.Top) in [1..FArea] then
        DockOnTop
      else
      if Abs(FormRect.Bottom - MainRect.Top) in [2..FArea] then
        UndockOnTopInside;
    end
    else
    if Abs(FormRect.Top - MainRect.Bottom) < Integer(FArea) then
      DockOnBottom
    else
    if (FormRect.Bottom - MainRect.Top) < Integer(FArea) then
      DockOnTop;

  if MovingToLeft and InHeight then
    if OkayForRight then
    begin
      if (FormRect.Left - MainRect.Right) in [2..FArea] then
        DockOnRight
      else
      if Abs(FormRect.Left - MainRect.Right) in [2..FArea] then
        UndockOnRightInside
      else
      if (FormRect.Right - MainRect.Left) in [2..FArea] then
        DockOnLeft
      else
      if Abs(FormRect.Right - MainRect.Left) in [2..FArea] then
        UndockOnLeftOutside;
    end
    else
    if Abs(FormRect.Left - MainRect.Right) < Integer(FArea) then
      DockOnRight
    else
    if Abs(FormRect.Right - MainRect.Left) < Integer(FArea) then
      DockOnLeft;

  if MovingToRight and InHeight then
    if OkayForRight then
    begin
      if (MainRect.Left - FormRect.Right) in [2..FArea] then
        DockOnLeft
      else
      if Abs(MainRect.Left - FormRect.Right) in [2..FArea] then
        UndockOnLeftInside
      else
      if (MainRect.Right - FormRect.Left) in [2..FArea] then
        DockOnRight
      else
      if Abs(MainRect.Right - FormRect.Left) in [2..FArea] then
        UndockOnRightOutside;
    end
    else
    if Abs(MainRect.Left - FormRect.Right) < Integer(FArea) then
      DockOnLeft
    else
    if Abs(MainRect.Right - FormRect.Left) < Integer(FArea) then
      DockOnRight
end;

function TJvFormMagnet.NewWndProc(var Msg: TMessage): Boolean;
var
  R, R3: TRect;
begin
  Result := False;
  with Msg do
    if FActive then
      case Msg of
        WM_MOVING:
          begin
            R := PRect(LParam)^;
            R3.Left := FForm.Left;
            R3.Top := FForm.Top;
            R3.Right := R3.Left + FForm.Width;
            R3.Bottom := R3.Top + FForm.Height;
            MoveTo(R3, R);
            PRect(LParam)^ := R;
          end;
      end;
end;

procedure TJvFormMagnet.MoveTo(var SrcRect, Rect: TRect);
var
  DesktopWorkRect, PreviousRect: TRect;
  Monitor: HMONITOR;
  MonInfo: TMonitorInfo;
begin
  PreviousRect := SrcRect;

  // Move to a side of the desktop?
  if FScreenMagnet then
  begin
    Monitor := MultiMon.MonitorFromRect(@PreviousRect, MONITOR_DEFAULTTONEAREST);
    if Monitor <> 0 then
    begin
      MonInfo.cbSize := SizeOf(MonInfo);
      GetMonitorInfo(Monitor, @MonInfo);
      DesktopWorkRect := MonInfo.rcWork;
    end
    else
      SystemParametersInfo(SPI_GETWORKAREA, 0, @DesktopWorkRect, 0);
    MagnetScreen(PreviousRect, Rect, DesktopWorkRect);
  end;

  // Move another form too?
  if FFormGlue then
    GlueForms(Rect);

  // Magnet to main form?
  if FMainFormMagnet and (Application.MainForm <> nil) then
  begin
    DesktopWorkRect.Left := Application.MainForm.Left;
    DesktopWorkRect.Top := Application.MainForm.Top;
    DesktopWorkRect.Right := Application.MainForm.Left + Application.MainForm.Width;
    DesktopWorkRect.Bottom := Application.MainForm.Top + Application.MainForm.Height;
    MagnetToMain(PreviousRect, Rect, DesktopWorkRect);
  end;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.