Телефон: +7 (926) 245-03-63

Перемещение формы не за заголовок

Следующая статья: Информация о псевдонимах BDE.

Решение

 TForm1=class(TForm)
 privat
 procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;
 end;
 // реализация обработчика события
 procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);
 begin
 inherited;
 // вызвали унаследованный обработчик сообщения
 if M.Result=htClient then// щелкнув в клиентской области окна?
 M.Result:=htCaption;
 // если так, то мы заставили Windows думать, что щелчок был произведен по заголовку окна.
 end;

Это заставляет Windows думать, что курсор мыши находится в области заголовка окна. Но это может повлечь за собой другую проблему, поскольку предполагается, что мышь будет считаться расположенной в области заголовка при любом ее нахождении в области клиента. Тем не менее, это решение элегантно, поскольку при перетаскивании формы ее границы изменяются на «резиновые». Если описаный способ не помогает, попробуйте работать с другим сообщением, которое может дать тот же результат.

Выключите все BorderIcons формы.

Убедитесь в том, что заголовок является пустой строкой.

BorderStyle=bsNone

Перекройте процедуру формы CreateParams, как показано ниже:

 type TForm1=class(TForm)
 …
 protected
 procedure CreateParams(var Params: TCreateParams); override;
 …
 end;
 implementation
 procedure TForm1.CreateParams(var Params: TCreateParams);
 begin
 inherited CreateParams(Params);
 with Params do Style:=Style or ws_Border or ws_ThickFrame;
 end;
 end.

Использование обработчиков событий мыши:

 var Moving: Boolean; OldX, OldY: Integer;
 …
 procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
 begin
 if Button=mbLeft then
 begin
 // нас интересует только левая кнопка
 OldLeft:=X;
 // сохраняем текущую позицию
 OldTop:=Y;
 Moving:=True;
 end;
 end;
 procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
 begin
 // Если необходимо переместить окно относительно своей оригинальной позиции
 if Moving then Self.SetBounds(Self.Left+X - OldLeft, Self.Top+Y - OldTop, Self.width, Self.height);
 end;
 procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
 begin
 if Button=mbLeft then Moving:=False;
 // Останавливаем перемещение
 end;

Не забудьте назначить эти методы каждому элементу управления вашей формы:

 Self.Panel1.OnMouseDown:=Self.OnMouseDown;