jvformmagnet.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
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
http://www.mozilla.org/MPL/MPL-1.1.html

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閎astien Buysse [sbuysse att buypin dott com]
Portions created by S閎astien Buysse are Copyright (C) 2001 S閎astien 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 http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvFormMagnet.pas,v 1.9 2005/02/17 10:20:34 marquardt Exp $

unit JvFormMagnet;

{$I jvcl.inc}

interface

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

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: '$RCSfile: JvFormMagnet.pas,v $';
    Revision: '$Revision: 1.9 $';
    Date: '$Date: 2005/02/17 10:20:34 $';
    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