unit lplSnapToForm;

{$WARN SYMBOL_DEPRECATED OFF}

interface

uses
  SysUtils, Classes, Forms, Messages, Windows;

type
  TlplSnapToForm = class(TComponent)
  private
    FOffSetY: Integer;
    FSnapRange: Integer;
    FOffSetX: Integer;
    FActive: Boolean;
    OldWndProc, NewWndProc: Pointer;
    procedure NewWndMethod(var Msg: TMessage);
    procedure WMWindowPosChanging;
    function OkToSnapY(SelfForm: TForm; SnapTo: TForm): boolean;
    Function OkToSnapX(SelfForm: TForm; SnapTo: TForm): Boolean;
    procedure SetOffSetX(const Value: Integer);
    procedure SetOffSetY(const Value: Integer);
    procedure SetSnapRange(const Value: Integer);
    procedure SetActive(const Value: Boolean);
  protected
  public
    ParentForm: TForm;
    Constructor Create(aOwner: TComponent); override;
    Destructor Destroy; override;
  published
    Property Active: Boolean read FActive write SetActive;
    Property SnapRange: Integer read FSnapRange write SetSnapRange;
    Property OffSetX: Integer read FOffSetX write SetOffSetX default 0;
    Property OffSetY: Integer read FOffSetY write SetOffSetY default 2;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('LPL Tools', [TlplSnapToForm]);
end;

{ TlplSnapToForm }

constructor TlplSnapToForm.Create(aOwner: TComponent);
begin
 inherited;
 If (aOwner is Tform) then ParentForm := (aOwner as TForm)
  else ParentForm := Nil;
 fOffSetX := 0;
 fOffSetY := 2;
 fSnapRange := 15;
 fActive := False; 
end;

destructor TlplSnapToForm.Destroy;
begin
  if Assigned(NewWndProc) then
    FreeObjectInstance(NewWndProc);

 inherited;
end;

procedure TlplSnapToForm.NewWndMethod(var Msg: TMessage);
begin
 Case Msg.Msg of
  WM_MOVE: begin
                         WMWindowPosChanging;
                        end;
 end;
 Msg.Result := CallWindowProc(OldWndProc, TForm(Owner).Handle, Msg.Msg, Msg.WParam, Msg.LParam);
end;

function TlplSnapToForm.OkToSnapX(SelfForm, SnapTo: TForm): Boolean;
begin
 Result := False;
 If SelfForm = nil then exit;
 If ((SelfForm.Left > SnapTo.Left) and (SelfForm.Left < (SnapTo.Left + SnapTo.Width))) or
  (((SelfForm.Left + SelfForm.Width) > SnapTo.Left) and ((SelfForm.Left + SelfForm.Width) < (SnapTo.Left + SnapTo.Width))) Then Result := true;
 If ((SnapTo.Left > SelfForm.Left) and ((SnapTo.Left + SnapTo.Width) < (SelfForm.Left + SelfForm.Width))) Then Result := true;
end;

function TlplSnapToForm.OkToSnapY(SelfForm, SnapTo: TForm): boolean;
begin
 Result := false;
 If SelfForm = nil then exit;
 If ((SelfForm.Top > SnapTo.Top) and (SelfForm.Top < (SnapTo.Top + SnapTo.Height))) or
  (((SelfForm.Top + SelfForm.Height) > SnapTo.Top) and ((SelfForm.Top + SelfForm.Height) < (SnapTo.Top + SnapTo.Height))) then Result := true;
 If ((SnapTo.Top > SelfForm.Top) and ((SnapTo.Top + SnapTo.Height) < (SelfForm.Top + SelfForm.Height))) Then Result := true;
end;

procedure TlplSnapToForm.SetActive(const Value: Boolean);
begin
 If Value then begin
  // Enable
  NewWndProc := MakeObjectInstance(NewWndMethod);
  OldWndProc := Pointer(SetWindowLong(ParentForm.Handle, gwl_WndProc, Longint(NewWndProc)));
 end
  else
 begin
  // Disable
  if Assigned(NewWndProc) then
    FreeObjectInstance(NewWndProc);
 end;
 FActive := Value;
end;

procedure TlplSnapToForm.SetOffSetX(const Value: Integer);
begin
  FOffSetX := Value;
end;

procedure TlplSnapToForm.SetOffSetY(const Value: Integer);
begin
  FOffSetY := Value;
end;

procedure TlplSnapToForm.SetSnapRange(const Value: Integer);
begin
  FSnapRange := Value;
end;

procedure TlplSnapToForm.WMWindowPosChanging;
Var
 I: Integer;
begin
 If not Active then exit;
 For I := 0 to application.ComponentCount - 1 do begin
  If (application.Components[I] is TForm) then begin
   If (Application.Components[I] as TForm) <> ParentForm then begin
    with (application.Components[I] as TForm) do begin
     If visible then begin
      // Snap on right?
      If ((ParentForm.Left < (left + width + SnapRange)) and (ParentForm.Left > (left + width - snaprange)))
       and OkToSnapY(ParentForm, Application.Components[I] as TForm) then ParentForm.Left := Left + Width - OffsetX;
      // Snap on Left?
      If (((ParentForm.Left + ParentForm.width - SnapRange) < left) and ((ParentForm.Left + ParentForm.Width + SnapRange) > left))
       and OkToSnapY(ParentForm, Application.Components[I] as TForm) then ParentForm.Left := Left - ParentForm.Width + OffsetX;
      // Snap on Buttom?
      If ((ParentForm.Top < (top + height + SnapRange)) and (ParentForm.Top > (top + height - snaprange)))
       and OkToSnapX(ParentForm, Application.Components[I] as TForm) then ParentForm.Top := Top + Height - OffsetY;
      // Snap on Top?
      If (((ParentForm.Top + ParentForm.height - SnapRange) < top) and ((ParentForm.Top + ParentForm.height + SnapRange) > top))
       and OkToSnapX(ParentForm, Application.Components[I] as TForm) then ParentForm.Top := Top - ParentForm.Height + OffsetY;
     end;
    end;
   end;
  end;
 end;
end;

end.
