home *** CD-ROM | disk | FTP | other *** search
- {*******************************************************************************
-
- FILE: FormMagnet.pas - FormMagnet component.
-
- Copyright (c) 1998-2001 UtilMind Solutions
- All rights reserved.
- E-Mail: info@utilmind.com
- WWW: http://www.utilmind.com, http://www.appcontrols.com
-
- The entire contents of this file is protected by International Copyright
- Laws. Unauthorized reproduction, reverse-engineering, and distribution of all
- or any portion of the code contained in this file is strictly prohibited and
- may result in severe civil and criminal penalties and will be prosecuted to
- the maximum extent possible under the law.
-
- Restrictions
-
- The source code contained within this file and all related files or any
- portion of its contents shall at no time be copied, transferred, sold,
- distributed, or otherwise made available to other individuals without express
- written consent and permission from the UtilMind Solutions.
-
- Consult the End User License Agreement (EULA) for information on additional
- restrictions.
-
- *******************************************************************************}
-
-
- unit FormMagnet;
-
- interface
-
- uses
- Windows, Messages, Classes, Forms;
-
- type
- TFormMagnet = class;
-
- { *** AppControls classes *** }
- TMagnetFormHookComponent = class(TComponent)
- private
- Hooked: Boolean;
- FParentForm: TForm;
- FParentHandle: THandle;
- FOldWndProc, FNewWndProc: Pointer;
-
- procedure HookWndProc(var Message: TMessage);
- protected
- procedure MessageBefore(var Message: TMessage; var Handled: Boolean); virtual;
- procedure MessageAfter(var Message: TMessage); virtual;
- procedure FormRecreate; virtual;
-
- function GetParentHandle: THandle; virtual;
- public
- constructor Create(aOwner: TComponent); override;
- destructor Destroy; override;
-
- property ParentForm: TForm read FParentForm;
- property ParentHandle: THandle read FParentHandle;
- property OldWndProc: Pointer read FOldWndProc;
- end;
- { *** *** *** *** *** *** *** }
-
- TScreenArea = (saFullScreen, saWorkArea);
- TScreenMagnet = class(TPersistent)
- private
- FArea: TScreenArea;
- FDesktopPower: Byte;
- FTop, FBottom, FLeft, FRight: Boolean;
- public
- constructor Create;
- published
- property Area: TScreenArea read FArea write FArea;
- property DesktopPower: Byte read FDesktopPower write FDesktopPower;
- property Top: Boolean read FTop write FTop;
- property Bottom: Boolean read FBottom write FBottom;
- property Left: Boolean read FLeft write FLeft;
- property Right: Boolean read FRight write FRight;
- end;
-
- TGluedObject = class(TObject)
- private
- Magnet: TFormMagnet;
- Position: TPoint;
- public
- constructor Create(aMagnet: TFormMagnet; aLeft, aTop: Integer);
- end;
-
- TGlueList = class(TList)
- public
- function IsGluedTo(Magnet: TFormMagnet): Boolean;
- function GetFormPositionByMagnet(Magnet: TFormMagnet): TPoint;
- end;
-
- TOnGlue = procedure(Sender: TObject; AnotherForm: TForm; var AllowGlue: Boolean) of object;
- TOnMagnet = procedure(Sender: TObject; AnotherForm: TForm; var AllowMagnet: Boolean) of object;
- TMagnetType = (mkOnMoving, mkAfterMoving);
- TFormMagnet = class(TMagnetFormHookComponent)
- private
- FActive: Boolean;
- FGlue: Boolean;
- FFormDragable: Boolean;
- FMagnetType: TMagnetType;
- FPower: Byte;
- FScreenMagnet: TScreenMagnet;
-
- FOnGlue: TOnGlue;
- FOnMagnet: TOnMagnet;
- FOnDragMove: TNotifyEvent;
-
- { internal variables }
- Suspended: Boolean;
- GluedTo: TGlueList;
- Moving: Boolean;
- BeginMovingPos: TPoint;
-
- procedure SetActive(Value: Boolean);
-
- function AllowGlueTo(AnotherMagnet: TFormMagnet): Boolean;
- function AllowMagnetTo(AnotherMagnet: TFormMagnet): Boolean;
-
- procedure RecalculateGluing;
- procedure MagnetByDraggingRect(var DraggingRect: TRect; CalculateRelativePlacement, GlueOnly: Boolean);
- protected
- procedure MessageBefore(var Message: TMessage; var Handled: Boolean); override;
- procedure MessageAfter(var Message: TMessage); override;
-
- public
- constructor Create(aOwner: TComponent); override;
- destructor Destroy; override;
-
- procedure DoMagnet;
- published
- property Active: Boolean read FActive write SetActive;
- property Glue: Boolean read FGlue write FGlue;
- property FormDragable: Boolean read FFormDragable write FFormDragable;
- property MagnetType: TMagnetType read FMagnetType write FMagnetType;
- property Power: Byte read FPower write FPower;
- property ScreenMagnet: TScreenMagnet read FScreenMagnet write FScreenMagnet;
-
- property OnGlue: TOnGlue read FOnGlue write FOnGlue;
- property OnMagnet: TOnMagnet read FOnMagnet write FOnMagnet;
- property OnDragMove: TNotifyEvent read FOnDragMove write FOnDragMove;
- end;
-
- procedure Register;
-
- implementation
-