Перемещение формы

 

Code:

type

TyourForm = class(TForm)

private

   { Private declarations }

   procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;

end;

 

procedure TyourForm.WMNCHitTest(var Message: TWMNCHitTest);

begin

inherited;

 

with Message do

   if Result = HTCAPTION then

     Result := HTNOWHERE;

end;

 

 

Взято с Delphi Knowledge Base

Добавить комментарий
Подробности
Родительская категория: TForm
Категория: Перемещение формы

 

Для этого Вам понадобится переопределить процедуру CreateParams у желаемой формы. А в ней установить params.WndParent в дескриптор окна, к которому Вы хотите прикрепить форму.

Подробнее: Как прикрепить свою... Добавить комментарий
Подробности
Родительская категория: TForm
Категория: Перемещение формы

 Из одноимённой статьи с сайта delphi.about.com

 В статье рассматривается приём создания обработчиков сообщений, которые позволяют форме при перетаскивании "прилипать" к краям экранной области.

 Конечно же в Win API такой возможности не предусмотрено, поэтому мы воспользуемся сообщениями Windows. Как нам извесно, Delphi обрабатывает сообщения через события, генерируя его в тот момент, когда Windows посылает сообщений приложению. Однако некоторые сообщения не доходят до нас. Например, при изменении размеров формы, генерируется событие OnResize, соотвествующее сообщению WM_SIZE, но при перетаскивании формы никакой реакции не происходит. Конечно же форма может получить это сообщение, но изначально никаких действий для данного сообщения не предусмотрено.

 

Подробнее: Липкие окошки Добавить комментарий
Подробности
Родительская категория: TForm
Категория: Перемещение формы

 

Code:

//Find windows that may cover another window.

Var

hW: HWnd;

r: TRect;

begin

hw := Handle;

While IsWindow(hw) Do Begin

   hw := GetWindow( hw, GW_HWNDPREV );

   If IsWindowVisible(hw) and not IsIconic( hw ) Then Begin

     ... use GetWindowRect( hw, r ) to get candidate windows

     rect and check if it intersects the forms BoundsRects via

     IntersectRect

   End;

End;

end;

 

Добавить комментарий
Подробности
Родительская категория: TForm
Категория: Перемещение формы

 

For some reason messages.pas declares no message record for this message

Code:

type

TWmMoving = record

   Msg: Cardinal;

   fwSide: Cardinal;

   lpRect: PRect;

   Result: Integer;

end;

 

// Add a handler to your forms private section:

 

procedure WMMoving(var msg: TWMMoving); message WM_MOVING;

 

// Implement it as

 

procedure TFormX.WMMoving(var msg: TWMMoving);

var

   r: TRect;

begin

   r := Screen.WorkareaRect;

  // compare the new form bounds in msg.lpRect^ with r and modify it if

  // necessary

   if msg.lprect^.left < r.left then

     OffsetRect(msg.lprect^, r.left - msg.lprect^.left, 0);

   if msg.lprect^.top < r.top then

     OffsetRect(msg.lprect^, 0, r.top - msg.lprect^.top);

   if msg.lprect^.right > r.right then

     OffsetRect(msg.lprect^, r.right - msg.lprect^.right, 0);

   if msg.lprect^.bottom > r.bottom then

     OffsetRect(msg.lprect^, 0, r.bottom - msg.lprect^.bottom);

   inherited;

end;

 

 

Добавить комментарий
Подробности
Родительская категория: TForm
Категория: Перемещение формы

Code:

Application.OnDeactivate

 

Добавить комментарий
Подробности
Родительская категория: TForm
Категория: Перемещение формы

 

Code:

unit DragMain;

 

interface

 

uses

SysUtils, WinTypes, WinProcs,  Messages,

Classes, Graphics, Controls, Forms, Dialogs, StdCrtls;

 

type

TForm1 = class(TForm)

   Button1: TButton;

   procedure ButtonClick(Sender: TObject);

private        

   procedure WMNCHitTest(var M: TWMNCHitTest);

                message wm_NCCHitTest;

end;

 

var

Form1: TForm1;

 

implementation

 

{$R *.DFM}

 

procedure TForm1. WMNCHitTest(var M: TWMNCHitTest);

 

begin

inherited;

if M.Result = htClient then

   M.Result := htCaption;

end;

 

 

procedure TForm1.Button1Click(Sender: TObject);

 

begin

Close;

end;

 

end.

 

Добавить комментарий
Подробности
Родительская категория: TForm
Категория: Перемещение формы

Code:

type

TfrmMain = class(TForm)

private

   procedure OnMove(var Msg: TWMMove); message WM_MOVE;

end;

 

(...)

 

procedure TfrmMain.OnMove(var Msg: TWMMove);

begin

inherited;

(...)

end;

 

(...)

 

Добавить комментарий
Подробности
Родительская категория: TForm
Категория: Перемещение формы